!***********************************************************************
!*
!* Routine to read unlabelled 1600 BPI magnetic tape files
!*
!* Supplied by ERCC
!*
!* Cleaned up and modified by R.D. Eager
!* University of Kent MCMLXXIX
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTINTEGER MAXBLENGTH = 12288; ! Maximum block length
CONSTSTRING (1) SNL = "
"
CONSTSTRING (13) ILLEGAL = "Illegal reply"
!
!
!***********************************************************************
!*
!* External references
!*
!***********************************************************************
!
EXTERNALROUTINESPEC DEFINE(STRING (255) S)
EXTERNALROUTINESPEC CLEAR(STRING (255) S)
EXTERNALROUTINESPEC PROMPT(STRING (15)S)
EXTERNALROUTINESPEC OPENMT(STRING (7)S)
EXTERNALROUTINESPEC REWINDMT
EXTERNALROUTINESPEC READMT(INTEGER A,INTEGERNAME L,F)
EXTERNALROUTINESPEC SKIPMT(INTEGER I)
EXTERNALROUTINESPEC SKIPTMMT(INTEGER I)
EXTERNALROUTINESPEC UNLOADMT
EXTERNALROUTINESPEC OPENSQ(INTEGER N)
EXTERNALROUTINESPEC WRITESQ(INTEGER N,NAME A,B)
EXTERNALROUTINESPEC CLOSESQ(INTEGER N)
EXTERNALINTEGERFNSPEC UINFI(INTEGER N)
SYSTEMSTRINGFNSPEC ITOS(INTEGER M)
SYSTEMROUTINESPEC ETOI(INTEGER A,L)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
ROUTINE RDIN(STRING (15) PR,STRINGNAME T)
STRING (1) S
!
CYCLE
PROMPT(PR)
SKIPSYMBOL WHILE NEXTSYMBOL = ' ' OR NEXTSYMBOL = NL
T = ""
READITEM(S) AND T = T.S WHILE ' ' # NEXTSYMBOL # NL
EXIT IF LENGTH(S) > 0
REPEAT
END ; ! of RDIN
!
!
ROUTINE SKIP
WHILE NEXTSYMBOL # NL THEN SKIPSYMBOL
END ; ! OF SKIP
!
!
!***********************************************************************
!*
!* U N L A B L D T A P E
!*
!***********************************************************************
!
EXTERNALROUTINE UNLABLDTAPE(STRING (255) TAPE)
STRING (6) RECL
STRING (31) S
STRING (255) TAPERECFM,EMASRECFM,ACCEPTOR,FILENAME
INTEGER A,BLEN,BLENGTH,BLOCKS,EMASRECLEN,FILENO,FILENOW,FLAG
INTEGER FLENGTH,HEADER,I,LRECL,NRECS,RECEND,RECORDS,REMAINDER
INTEGER TRECFM,ERECFM,FTYPE,MAXFSIZE,STATE,COMMENTS
BYTEINTEGERARRAY IN(1:12288)
SWITCH RSW(1:3)
!
INTEGERFN RECORDLENGTH
INTEGER RES,N
!
IF LRECL > 1020 THEN N = 1020 ELSE N = LRECL
NRECS = LRECL//N
REMAINDER = LRECL-NRECS*N
RES = NRECS*(N+6)
UNLESS REMAINDER = 0 THEN START
RES = RES+REMAINDER+6
RES = RES+1 IF REMAINDER & 1 = 1
FINISH
RESULT = RES
END ; ! of RECORDLENGTH
!
!
ROUTINE ENDOFFILE(STRING (4) S,STRING (31) T)
INTEGER N
OWNINTEGER FN = 0
OWNSTRING (1) CN = "A"
STRING (1) ST,STT
!
CLOSESQ(1)
IF S = "EMAS" THEN N = BLOCKS-1 ELSE N = BLOCKS
IF N # 1 THEN STT = "s" ELSE STT = ""
IF RECORDS # 1 THEN ST = "s" ELSE ST = ""
PRINTSTRING(SNL."End of ".S." file ".T." after ". C
ITOS(N)." tape block".STT." - ".ITOS(RECORDS). C
" record".ST." written to ".FILENAME.SNL)
NEWLINES(2)
IF S = "EMAS" THEN START
FN = FN+1
LENGTH(FILENAME) = LENGTH(FILENAME)-1 UNLESS FN = 1 AND C
LENGTH(FILENAME) < 11
CHARNO(CN,1) = CHARNO(CN,1)+1 UNLESS FN = 1
FILENAME = FILENAME.CN
DEFINE("1,".FILENAME.",".ITOS(MAXFSIZE).RECL)
OPENSQ(1)
FLENGTH = HEADER
RECORDS = 0
FINISH ELSE FN = 0 AND CN = "A"
END ; ! of ENDOFFILE
!
!
ON EVENT 4 START ; ! Trap 'SYMBOL IN DATA'
I = EVENT INF & X'FF'; ! Get sub-event number
IF I # 1 THEN START ; ! Pass on other sub-events
SIGNAL EVENT 4,I
FINISH
-> RSW(STATE)
FINISH
!
!
MAXFSIZE = UINFI(6); ! Max file size in kbytes
A = ADDR(IN(1))
DEFINE("1,.OUT"); ! To stop CLEAR failing if there are no files
CYCLE
RDIN("Tape: ", TAPE) IF TAPE = ""
FLAG = 0
CYCLE I = 1,1,LENGTH(TAPE)
UNLESS 'A' <= CHARNO(TAPE,I) <= 'Z' OR C
'0' <= CHARNO(TAPE,I) <= '9' THEN START
FLAG = 1
EXIT
FINISH
REPEAT
FLAG = 1 UNLESS 1 <= LENGTH(TAPE) <= 6
EXIT UNLESS FLAG = 1
PRINTSTRING("Illegal tape name".SNL)
TAPE = ""
REPEAT
OPENMT(TAPE)
REWINDMT
FILENOW = 1
CYCLE
PROMPT("Next file no.: ")
STATE = 1
CYCLE
READ(FILENO)
EXIT
RSW(1):
PRINTSTRING(ILLEGAL.SNL)
SKIP
REPEAT
PRINTSTRING("End of transfers".SNL) AND EXIT UNLESS FILENO > 0
IF FILENO = 1 THEN REWINDMT ELSE START
SKIPTMMT(FILENO-FILENOW) UNLESS FILENO = FILENOW
SKIPTMMT(-1) AND SKIPTMMT(1) IF FILENO < FILENOW
FINISH
FILENOW = FILENO
CYCLE
RDIN("Record format: ",TAPERECFM)
EXIT IF TAPERECFM = "F" OR C
TAPERECFM = "FA" OR C
TAPERECFM = "V" OR C
TAPERECFM = "VA"
PRINTSTRING(ILLEGAL.SNL)
REPEAT
TRECFM = CHARNO(TAPERECFM,1)
IF TRECFM = 'F' THEN START
S = "Record length: "
FINISH ELSE S = "Max blocksize: "
PROMPT(S)
STATE = 2
CYCLE
READ(LRECL)
EXIT
RSW(2):
PRINTSTRING(ILLEGAL.SNL)
SKIP
REPEAT
RECEND = LRECL-1
CYCLE
RDIN("Chars/binary: ",ACCEPTOR)
EXIT IF ACCEPTOR = "C" OR ACCEPTOR = "B"
PRINTSTRING(ILLEGAL.SNL)
REPEAT
FTYPE = CHARNO(ACCEPTOR,1)
CYCLE
RDIN("EMAS filename: ", FILENAME)
FLAG = 0
CYCLE I = 1,1,LENGTH(FILENAME)
UNLESS 'A' <= CHARNO(FILENAME,I) <= 'Z' OR C
'0' <= CHARNO(FILENAME,I) <= '9' THEN START
FLAG = 1
EXIT
FINISH
REPEAT
FLAG = 1 UNLESS 'A' <= CHARNO(FILENAME,1) <= 'Z'
FLAG = 1 UNLESS 1 <= LENGTH(FILENAME) <= 11
EXIT IF FLAG = 0
PRINTSTRING("Illegal filename".SNL)
REPEAT
IF TRECFM = 'F' THEN START
CYCLE
RDIN("EMASfile recfm:",EMASRECFM)
EXIT IF EMASRECFM = "F" OR C
EMASRECFM = "V" OR C
EMASRECFM = "."
PRINTSTRING(ILLEGAL.SNL)
REPEAT
EMASRECFM = TAPERECFM IF EMASRECFM = "."
FINISH ELSE EMASRECFM = "V"
ERECFM = CHARNO(EMASRECFM,1)
IF ERECFM = 'F' THEN START
HEADER = LRECL
RECL = ITOS(LRECL)
FINISH ELSE START
HEADER = 32
RECL = "1024"
EMASRECLEN = RECORDLENGTH IF TRECFM = 'F'
FINISH
RECL = ",".TOSTRING(ERECFM).RECL
PROMPT("Start at block:")
STATE = 3
CYCLE
READ(BLOCKS)
EXIT
RSW(3):
PRINTSTRING(ILLEGAL.SNL)
SKIP
REPEAT
BLOCKS = BLOCKS-1
IF BLOCKS <= 0 THEN BLOCKS = 0 ELSE SKIPMT(BLOCKS)
DEFINE("1,".FILENAME.",".ITOS(MAXFSIZE).RECL)
OPENSQ(1)
FLENGTH = HEADER
RECORDS = 0
COMMENTS = 0
CYCLE
BLENGTH = MAXBLENGTH
READMT(A,BLENGTH,FLAG)
EXIT IF FLAG = 1
BLOCKS = BLOCKS+1
IF FLAG # 0 THEN START
PRINTSTRING("Tape error at block ".ITOS(BLOCKS))
PRINTSTRING(" - block lost".SNL)
BLEN = 0
BLENGTH = 0
FINISH ELSE START
IF TRECFM = 'F' THEN START
IF BLENGTH # BLENGTH//LRECL*LRECL THEN START
IF COMMENTS < 5 THEN START
PRINTSTRING("Warning at block ".ITOS(BLOCKS))
PRINTSTRING(" - block not multiple of record size")
NEWLINE
FINISH
COMMENTS = COMMENTS + 1
BLENGTH = BLENGTH//LRECL*LRECL
FINISH
IF ERECFM = 'F' THEN START
BLEN = BLENGTH
FINISH ELSE BLEN = BLENGTH//LRECL*EMASRECLEN
FINISH ELSE START
LRECL = BLENGTH
RECEND = LRECL-1
BLEN = RECORDLENGTH
FINISH
FINISH
ENDOFFILE("EMAS",FILENAME) IF FLENGTH+BLEN > MAXFSIZE*1024
CONTINUE IF BLEN = 0
CYCLE I = 1,LRECL,BLENGTH-RECEND
ETOI(ADDR(IN(I)),LRECL) IF FTYPE = 'C'
WRITESQ(1,IN(I),IN(I+RECEND))
RECORDS = RECORDS+1
REPEAT
FLENGTH = FLENGTH+BLEN
REPEAT
IF COMMENTS # 0 THEN START
PRINTSTRING(SNL."*** Total of ".ITOS(COMMENTS)." warnings".SNL)
FINISH
ENDOFFILE("tape",ITOS(FILENO))
FILENOW = FILENOW+1
REPEAT
CLEAR("1")
UNLOADMT
END ; ! of UNLABLDTAPE
ENDOFFILE