!*MAGNETIC TAPE INTERFACE ROUTINES
!THESE ROUTINES ARE USED FOR HIGH LEVEL PROGRAMMING LANGUAGE ACCESS
!TO MAGNETIC TAPE. THEY ARE ACCESSED BY NEWFILEOP FOR FORTRAN
!AND BY THE IMP SQ ROUTINES DIRECTLY. THEY IN TURN CALL ROUTINE MAGIO
!WHICH CONTAINS THE MAIN MAG TAPE DRIVER ROUTINES.
CONSTINTEGER CLOSED = 0
CONSTINTEGER AFTERREAD = 2
CONSTINTEGER AFTERWRITE = 3
CONSTINTEGER AFTERENDFILE = 6
CONSTINTEGER EBCDICBIT = X'20'
CONSTINTEGER RINGNEEDED = X'40'
RECORDFORMAT MTFDF(INTEGER LEVEL, DSNUM, C
BYTEINTEGER STATUS, ACCESS ROUTE, VALID ACTION, CUR STATE, C
MODE OF USE, MODE, FILE ORG, DEV CODE, REC TYPE, FLAGS, C
CHANNEL, BCF, INTEGER REL FILE NUM, AREC, REC SIZE, MINREC, C
MAXREC, REL BLOCK NO, RECPTR, SOB, EOB, SOD, EOD, TRANSFERS C
, BLOCK XFERS, BLOCK LENGTH, RTLEN, RECLEN, C
BYTEINTEGER BLOCKING, DATA FORMAT, BWF, C
STRING (17) DSN, STRING (6) VOLUME, C
INTEGER BLOCKPTR, INTEGER FIRST TIME, C
INTEGER RTRACE, RTCHAN)
EXTERNALINTEGERFNSPEC UINFI(INTEGER N)
SYSTEMINTEGERFNSPEC OPEN(INTEGER AFD, MODE)
SYSTEMROUTINESPEC PSYSMES(INTEGER ROOT, FLAG)
SYSTEMINTEGERFNSPEC PSTOI(STRING (63) S)
SYSTEMROUTINESPEC SETFNAME(STRING (40) NAME)
SYSTEMROUTINESPEC SETPAR(STRING (255) S)
SYSTEMINTEGERFNSPEC PARMAP
SYSTEMSTRINGFNSPEC SPAR(INTEGER N)
SYSTEMINTEGERFNSPEC FDMAP(INTEGER CHAN)
SYSTEMROUTINESPEC DEFINE(INTEGER CHAN, C
STRING (31) IDEN, INTEGERNAME AFD, FLAG)
SYSTEMROUTINESPEC MAGIO(INTEGER FD ADDR, OPERATION, C
INTEGERNAME FLAG)
EXTERNALROUTINE DEFINEMT(STRING (255) S)
CONSTINTEGER MINBLOCKSIZE = 18
CONSTINTEGER MAXBLOCKSIZE = 32767
CONSTINTEGER OPTBLOCKSIZE = 4096
SWITCH BLOCKCHECK(1 : 6)
CONSTINTEGER MAXRECFMS = 14
CONSTSTRING (4)ARRAY RECFMS(1:MAXRECFMS)=C
"F","FA","FB","FBA",
"V","VA","VB","VBA","VS","VSA","VBS","VBSA",
"U",""
CONSTINTEGERARRAY ASA(1:MAXRECFMS)=C
0,16,0,16,0,16,0,16,0,16,0,16,0,0
CONSTBYTEINTEGERARRAY MINREC(1:MAXRECFMS)=18(4),1(8),18,0
CONSTBYTEINTEGERARRAY BLOCKAT(1:MAXRECFMS)=C
1(2),2(2),1(2),2(2),3(2),4(2),1,0
CONSTBYTEINTEGERARRAY RECTYPE(1:MAXRECFMS)=1(4),2(8),0,255
CONSTINTEGERARRAY MAXREC(1:MAXRECFMS)=C
32760(4),32752(4),32767(4),32760,0
CONSTBYTEINTEGERARRAY BCCODE(1:MAXRECFMS)=1(2),2(2),3(2),4(2),5(4),6(2)
STRING (31) DSN, VOL, SRECSIZE
STRING (8) SCHAN, SLABEL, RECFM, SREC, SBLOCKSIZE
INTEGER CHAN, LABEL, LREC, BLOCKSIZE, AFD, FLAG, I, CHAR, C
RING, RECFMCODE
INTEGER RECSIZE
RECORDNAME F(MTFDF)
INTEGER ACR, LNB
! *STLN_LNB; !TO FIND ACR LEVEL
! ACR = (INTEGER(LNB+4)>>20)&X'F'; !PRIV IF 9 OR LESS
! %IF ACR > 9 %AND UINFI(2)&1 = 1 %START; !UN-PRIV ATTEMT TO USE TAPE
!FROM INTERACTIVE TERMINAL
! PRINTSTRING( %C
"DEFINEMT fails - No tape access allowed from interactive terminal")
! %STOP
! %FINISH
RING = 0; !NO RING BY DEFAULT
SETPAR(S)
IF PARMAP&7 # 7 OR PARMAP > X'3F' C
THEN FLAG = 263 AND -> ERR
!WRONG NUMBER OF PARAMETERS
CHAN = PSTOI(SPAR(1)); !CHANNEL NUMBER
UNLESS 1 <= CHAN <= 80 THEN FLAG = 223 AND -> ERR
!INVALID CHANNEL NUMBER
DSN = SPAR(2)
UNLESS 1 <= LENGTH(DSN) <= 17 C
THEN SETFNAME(DSN) AND -> BADPARAM
VOL = SPAR(3); !VOLUME LABEL
IF CHARNO(VOL,LENGTH(VOL)) = '*' START
LENGTH(VOL) = LENGTH(VOL)-1
RING = RINGNEEDED
FINISH
!WITH OR WITHOUT WRITE
UNLESS 1 <= LENGTH(VOL) <= 6 C
THEN SETFNAME(VOL) AND -> BADPARAM
SLABEL = SPAR(4)
LABEL = 1; !DEFAULT
IF SLABEL # 0 THEN LABEL = PSTOI(SLABEL)
UNLESS 1 <= LABEL THEN SETFNAME(SLABEL) AND -> BADPARAM
!INVALID LABEL PARAMETER
SREC = SPAR(5)
IF SREC # "" START ; !USER PROVIDES FORMAT INFORMATION
RECFM = ""
CYCLE I = 1,1,LENGTH(SREC)
CHAR = CHARNO(SREC,I)
UNLESS 'A' <= CHAR <= 'Z' THEN EXIT
RECFM = RECFM.TOSTRING(CHAR)
REPEAT
IF RECFM = SREC THEN SETFNAME(SREC) AND -> BADPARAM
!NO RECORD SIZE SPECIFIED
SRECSIZE = FROMSTRING(SREC,LENGTH(RECFM)+1,LENGTH(SREC))
RECSIZE = PSTOI(SRECSIZE)
CYCLE RECFMCODE = 1,1,MAXRECFMS
IF RECFM = RECFMS(RECFMCODE) START ; !RECFM FOUND
UNLESS MINREC(RECFMCODE) <= RECSIZE <= MAXREC( C
RECFMCODE) THEN SETFNAME(SREC) AND -> BADPARAM
EXIT
FINISH
IF RECFMCODE = MAXRECFMS C
THEN SETFNAME(SREC) AND -> BADPARAM
REPEAT
SBLOCKSIZE = SPAR(6)
IF SBLOCKSIZE # "" THEN BLOCKSIZE = PSTOI(SBLOCKSIZE) C
ELSE BLOCKSIZE = 0
-> BLOCKCHECK(BCCODE(RECFMCODE))
BLOCKCHECK(1): !FIXED
IF BLOCKSIZE # 0 THEN START
IF BLOCKSIZE # RECSIZE THEN -> BADBLOCKSIZE
FINISH ELSE BLOCKSIZE = RECSIZE
-> ENDBLOCK
BLOCKCHECK(2): !FIXED BLOCKED
IF BLOCKSIZE # 0 START
UNLESS (BLOCKSIZE//RECSIZE)*RECSIZE = BLOCKSIZE C
THEN -> BADBLOCKSIZE
FINISH ELSE START
BLOCKSIZE = RECSIZE
WHILE BLOCKSIZE < OPTBLOCKSIZE C
THEN BLOCKSIZE = BLOCKSIZE+RECSIZE
FINISH
!CHOOSE A SUITABLE SIZE
-> ENDBLOCK
BLOCKCHECK(3): !VARIABLE UN-BLOCKED
IF BLOCKSIZE # 0 START
IF BLOCKSIZE < RECSIZE+8 THEN -> BADBLOCKSIZE
FINISH ELSE BLOCKSIZE = RECSIZE+8
-> ENDBLOCK
BLOCKCHECK(4): !VARIABLE BLOCKED
IF BLOCKSIZE # 0 START
IF BLOCKSIZE < RECSIZE+8 THEN -> BADBLOCKSIZE
FINISH ELSE START
IF RECSIZE < OPTBLOCKSIZE-8 C
THEN BLOCKSIZE = OPTBLOCKSIZE C
ELSE BLOCKSIZE = RECSIZE+8
FINISH
-> ENDBLOCK
BLOCKCHECK(5): !SPANNED
IF BLOCKSIZE = 0 THEN BLOCKSIZE = OPTBLOCKSIZE
-> ENDBLOCK
BLOCKCHECK(6): !UNSTRUCTURED
IF BLOCKSIZE # 0 START
IF BLOCKSIZE < RECSIZE THEN -> BADBLOCKSIZE
FINISH ELSE START
IF BLOCKSIZE = 0 THEN BLOCKSIZE = RECSIZE
FINISH
ENDBLOCK:
UNLESS MINBLOCKSIZE <= BLOCKSIZE <= MAXBLOCKSIZE C
THEN -> BADBLOCKSIZE
FINISH ELSE RECSIZE = 0 AND BLOCKSIZE = 0 AND RECFMCODE = 14
!FORMAT INFO NOT SUPPLIED
FILLREC:
DEFINE(CHAN,".NULL",AFD,FLAG); !GET EMPTY DESCRIPTOR
IF FLAG # 0 THEN -> ERR
F == RECORD(AFD)
F_ACCESSROUTE = 5; !MAGNETIC TAPE
F_MODEOFUSE = 2; !SEQUENTIAL
F_MODE = 11; !FOR FORTRAN I/O
F_RECTYPE = RECTYPE(RECFMCODE)
F_FLAGS = F_FLAGS!ASA(RECFMCODE)!RING!EBCDICBIT
F_RELFILENUM = LABEL; !FILE ON TAPE
IF F_RECTYPE = 1 THEN F_MINREC = RECSIZE C
ELSE F_MINREC = MINREC(RECFMCODE)
F_MAXREC = RECSIZE
F_BLOCKLENGTH = BLOCKSIZE
F_BLOCKING = BLOCKAT(RECFMCODE)
F_DSN = DSN
F_VOLUME = VOL
FLAG = 0
-> ERR
BADBLOCKSIZE:
SETFNAME(SBLOCKSIZE)
BADPARAM:
FLAG = 202
-> ERR
ERR:
IF FLAG # 0 THEN PSYSMES(100,FLAG)
END ; !OF DEFINEMT
SYSTEMINTEGERFN NEWMTFILEOP(INTEGER AFD, ACT)
RECORDNAME F(MTFDF)
INTEGER FLAG
BYTEINTEGERNAME CURSTATE
F == RECORD(AFD)
CURSTATE == F_CURSTATE
IF ACT = 1 START ; !READ
IF CURSTATE = AFTERREAD THEN -> OK; !AFTER READ
IF CURSTATE = CLOSED START
FLAG = OPEN(AFD,1); !OPEN FOR READING
CURSTATE = AFTERREAD
RESULT = FLAG
FINISH
IF CURSTATE = AFTERWRITE THEN RESULT = 156
!FAILURE READ AFTER WRITE
IF CURSTATE = AFTERENDFILE THEN RESULT = 153
!END OF FILE
FINISH
!*
!* WRITE
!*
IF ACT = 2 START
IF CURSTATE = AFTERWRITE THEN -> OK
IF CURSTATE = CLOSED START
FLAG = OPEN(AFD,2); !OPEN FOR WRITING
IF FLAG # 0 THEN RESULT = FLAG
CURSTATE = AFTERWRITE
-> OK
FINISH
IF CURSTATE = AFTERREAD START
IF F_FLAGS&RINGNEEDED = 0 THEN RESULT = 319
!NO RING
F_VALIDACTION = F_VALIDACTION!2; !OR IN WRITE BIT
MAGIO(AFD,1,FLAG); !PREPARE FOR WRITE
CURSTATE = AFTERWRITE
IF FLAG # 0 THEN RESULT = FLAG
-> OK
FINISH
FINISH
!*
!* REWIND
!*
IF ACT = 4 START
IF CURSTATE = CLOSED THEN -> OK
IF CURSTATE = AFTERWRITE START ; !AFTER WRITE - NEED TO DO AN ENDFILE
MAGIO(AFD,6,FLAG); !ENDFILE
IF FLAG # 0 THEN RESULT = FLAG
CURSTATE = AFTERREAD
FINISH
IF CURSTATE = AFTERENDFILE THEN CURSTATE = AFTERREAD
IF CURSTATE = AFTERREAD START
MAGIO(AFD,4,FLAG); !THE REWIND ITSELF
RESULT = FLAG
FINISH
FINISH
!*
!* BACKSPACE
!*
IF ACT = 8 START
IF CURSTATE = AFTERREAD START
MAGIO(AFD,5,FLAG)
RESULT = FLAG
FINISH
IF CURSTATE = AFTERWRITE START
MAGIO(AFD,6,FLAG); !DO AN ENDFILE FIRST
IF FLAG # 0 THEN RESULT = FLAG
MAGIO(AFD,5,FLAG); !THE BACKSPACE ITSELF
CURSTATE = AFTERREAD
RESULT = FLAG
FINISH
IF CURSTATE = AFTERENDFILE C
THEN CURSTATE = AFTERREAD AND -> OK
FINISH
!*
!* ENDFILE
!*
IF ACT = 16 START
IF CURSTATE = AFTERWRITE START
MAGIO(AFD,6,FLAG)
RESULT = FLAG
FINISH
FINISH
!*
RESULT = 171; !INVALID OPERATION
!*
OK: RESULT = 0
END ; !OF NEWMTFILEOP
ENDOFFILE