!*****************************************************************!
!* *!
!* 2900 MAGNETIC TAPE ROUTINES FOR USE IN ENGINR *!
!* ---- -------- ---- -------- --- --- -- ------ *!
!* *!
!* *!
!* BILL LAING. *!
!* 28-SEP-78 *!
!* *!
!* *!
!* MODIFIED BY CDM 22-MAR-79 TO INCLUDE EXTERNALS BULK MOVE AND *!
!* SKIP TM REVERSE *!
!*****************************************************************!
!CONSTANTS
CONSTSTRING (1) SNL = "
"
CONSTINTEGER PAGE SIZE = 4096; !PAGE SIZE IN BYTES
CONSTINTEGER NTAPU = 16; !NUMBER OF TAPE UNITS
CONSTINTEGER READ PGE = 1
CONSTINTEGER WRITE PGE = 2
CONSTINTEGER READ REVERSE PGE = 6
CONSTINTEGER FILE POSN = 8
CONSTINTEGER TAPE POSN = 9
CONSTINTEGER WRITE TM = 10
CONSTINTEGER REQUEST REJECT = 2; !TAPE REJECTS REQUEST
CONSTINTEGER POSITION LOST = 3; !POSITION LOST ON TAPE.
CONSTINTEGER EOT = 4
CONSTINTEGER READING = 1
CONSTINTEGER WRITING = 2
CONSTINTEGER BOTH = 3
CONSTINTEGER NOT IN USE = 0
CONSTINTEGER BULK MOVER=X'240000'; ! BULK MOVE SERVICE
!*
!EXTERNALS
EXTERNALINTEGERFNSPEC DPON2(STRING (6) USER, C
RECORDNAME P, INTEGER MSGTYPE, OUTNO)
EXTERNALROUTINESPEC DOUT(RECORDNAME P)
EXTERNALROUTINESPEC DOUT11(RECORDNAME P)
EXTERNALROUTINESPEC DOUT18(RECORDNAME P)
!FORMATS
RECORDFORMAT PE(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
RECORDFORMAT PF(INTEGER DEST, SRCE, IDENT, TYPE, PERM, C
STRING (7) DSN, INTEGER P6)
RECORDFORMAT PRF(INTEGER DEST, SRCE, IDENT, FAIL, SNO, C
STRING (7) TAPENAME, INTEGER P6)
RECORDFORMAT TSF(INTEGER DEST, SRCE, IDENT, LCT, ADDRESS, P4, C
LENGTH, A)
RECORDFORMAT TRF(INTEGER DEST, SRCE, IDENT, FAIL, P3, P4, P5, C
P6)
RECORDFORMAT TF(STRING (6) TAPE, C
INTEGER MODE, CURR CHAP, SNO, RLEV)
!OWNS
OWNRECORDARRAY T(1 : 16)(TF)
!LOCAL ROUTINES
ROUTINESPEC CLOSE TAPE(INTEGER NO, INTEGERNAME FLAG)
ROUTINE ABORT(INTEGER I)
!**********************************************************************
!* PRINTS A MESSAGE AND MONITOR USUALLY IMPOSSIBLE PARAMS *
!**********************************************************************
INTEGER J, FLAG
CONSTSTRING (59) ARRAY MESS(1 : 10) = C
"ILLEGAL TAPE NO.",
"NOT READING OR WRITING",
"READING/WRITING OTHER THAN FROM/TO PAGE 1 OF A NEW CHAPTER",
"WRITING OTHER THAN TO CURRENT CHAPTER OR NEXT CHAPTER",
"ALREADY IN USE",
"CLOSING A TAPE NOT IN USE",
"WRITING TO AN INPUT TAPE OR TAPE NOT IN USE",
"READING FROM AN OUTPUT TAPE OR TAPE NOT IN USE",
"READING/WRITING OTHER THAN TO NEXT PAGE IN CURRENT CHAPTER",
" NOT AN EMAS TAPE NAME"
PRINT STRING(MESS(I).SNL)
CYCLE J = 1,1,NTAPU
CLOSE TAPE(J,FLAG) IF T(I)_MODE # NOT IN USE
REPEAT
MONITOR ; STOP
END ; !OF ROUTINE ABORT
!*
!*
STRING (15) FN I TO S(INTEGER N)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A STRING USES MACHINE CODE *
!* *
!**********************************************************************
STRING (16) S
INTEGER D0, D1, D2, D3
*LSS_N; *CDEC_0
*LD_S; *INCA_1; ! PAST LENGTH BYTE
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK 15 DIGITS SPACE FILL
*STD_D2; ! FINAL DR FOR LENGTH CALCS
*JCC_8,<WASZERO>; ! N=0 CASE
*LSD_TOS ; *ST_D0; ! SIGN DESCRIPTOR STKED BY SUPK
*LD_S; *INCA_1
*MVL_L =15,15,48; ! FORCE IN ISO ZONE CODES
IF N < 0 THEN BYTEINTEGER(D1) = '-' AND D1 = D1-1
BYTEINTEGER(D1) = D3-D1-1
RESULT = STRING(D1)
WASZERO:
RESULT = "0"
END ; !OF STRINGFN I TO S
!*
!*
ROUTINE F READ(INTEGER NO, ADDRESS, INTEGERNAME FLAG)
!**********************************************************************
!* READS NEXT PAGE *
!**********************************************************************
RECORD P(TSF)
RECORDNAME PP(TRF)
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'RDPG'
P_LCT = PAGE SIZE<<16!READ PGE
P_ADDRESS = ADDRESS
P_A = ADDRESS
P_LENGTH = PAGE SIZE!X'80000000'
DOUT18(P); !READ A PAGE
PP == P
FLAG = PP_FAIL
FLAG = PP_DEST IF PP_DEST = -1; !FAILURE TO LOCK AREA DOWN
END ; !OF ROUTINE F READ
!*
!*
ROUTINE F SKIP(INTEGER NO)
!**********************************************************************
!* SKIP NEXT PAGE *
!**********************************************************************
RECORD P(TSF)
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'FPOS'
P_LCT = 1<<16!FILE POSN; !1 BLOCK
DOUT11(P); ! SKIP A PAGE
END ; !OF ROUTINE F SKIP
!*
!*
ROUTINE B READ(INTEGER NO, ADDRESS, INTEGERNAME FLAG)
!**********************************************************************
!* READ PREVIOUS PAGE BACKWARDS *
!* NOTE: IF SUCCESSFUL SKIPS PAGE TO POSITION BEFORE CALL *
!**********************************************************************
RECORD P(TSF)
RECORDNAME PP(TRF)
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'RPGB'
P_LCT = PAGE SIZE<<16!READ REVERSE PGE
P_ADDRESS = ADDRESS
P_A = ADDRESS
P_LENGTH = PAGE SIZE!X'80000000'
DOUT18(P); ! READ PAGE BACK WARDS
PP == P
FLAG = PP_FAIL
FLAG = PP_DEST IF PP_DEST = -1; !FAILURE TO LOCK AREA DOWN
IF FLAG = 0 START
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'FPOS'
P_LCT = 1<<16!FILE POSN; !1 BLOCK
DOUT11(P); ! SKIP A PAGE
FINISH
END ; !OF ROUTINE B READ
!*
!*
ROUTINE B SKIP(INTEGER NO)
!**********************************************************************
!* SKIP BACK PAST LAST PAGE *
!**********************************************************************
RECORD P(TSF)
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'FPOS'
P_LCT = (-1)<<16!FILE POSN; !1 BLOCK
DOUT11(P); ! SKIP BACK A PAGE
END ; !OF ROUTINE B SKIP
!*
!*
ROUTINE CHAP POSN(INTEGER NO, CHAP, INTEGERNAME FLAG)
!*******************************************************************
!* POSITIONS TAPE AT A NEW CHAPTER *
!*******************************************************************
INTEGER DIFF, FAIL
RECORD P(TSF)
RECORDNAME PP(TRF)
DIFF = CHAP-T(NO)_CURR CHAP; !NO CHECKED BEFORE CALL
DIFF = DIFF-1 IF DIFF < 0; !ONE MORE IF BACKWARDS
P = 0
P_DEST = T(NO)_SNO; !GET TAPE SERVICE NUMBER
P_IDENT = M'TPOS'
P_LCT = DIFF<<16!1<<8!TAPE POSN
DOUT(P); !POSITION THE TAPE
PP == P
FAIL = PP_FAIL
IF DIFF < 0 START ; !AT BACK OF CHAPTER
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'TPOS'
P_LCT = 1<<16!1<<8!TAPE POSN
!TO FRONT OF NEXT CHAPTER
DOUT(P); !TO START OF CHAPTER
PP == P
FLAG = PP_FAIL
FAIL = FAIL!FLAG UNLESS FLAG = EOT
!BT
FINISH
FLAG = FAIL
PRINT STRING("CHAP POSN FAILS ".ITOS(FLAG).SNL) IF FLAG # 0
T(NO)_CURR CHAP = CHAP
END ; !OF ROUTINE CHAP POSN
!*
!*
ROUTINE TAPE MARK(INTEGER NO, INTEGERNAME FLAG)
!**********************************************************************
!* WRITES A TAPE MARK ON TAPE *
!**********************************************************************
RECORD P(TSF)
RECORDNAME PP(TRF)
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'WRTM'
P_LCT = WRITE TM
DOUT11(P)
PP == P
FLAG = PP_FAIL
END ; !OF ROUTINE TAPE MARK
!*
!*
!* EXTERNAL ROUTINES
!*
!*
!*
!*
EXTERNALROUTINE OPEN TAPE(INTEGER NO, MODE, RLEV, C
STRING (6) TAPE, INTEGERNAME FLAG)
!**********************************************************************
!* OPENS TAPE (TAPE) AS NUMBER (NO) IN MODE (MODE) WITH RECOVER (RLEV)*
!* MODE = 1 READING, MODE = 2 WRITING *
!**********************************************************************
INTEGER SNO
RECORD P(PF)
RECORDNAME PR(PRF)
PRINT STRING(TAPE) AND ABORT(10) UNLESS LENGTH(TAPE) = 6
ABORT(2) UNLESS READING <= MODE <= BOTH
!CHECK ACCESS MODE
ABORT(1) UNLESS 0 < NO <= NTAPU
!CHECK TAPE UNIT NUMBER
ABORT(5) UNLESS T(NO)_MODE = NOT IN USE
! UNIT ALREADY IN USE
P = 0
P_TYPE = 4
P_PERM = MODE
P_DSN = TAPE
P_DEST = X'FFFF0044'; !REQUEST A TAPE FROM VOLUMES
FLAG = DPON2("VOLUMS",P,1,7)
IF FLAG = 0 START
PR == P
FLAG = PR_FAIL
SNO = PR_SNO
FINISH
IF FLAG = 0 START
MODE = READING IF MODE = BOTH
T(NO)_MODE = MODE; !STORE FOR LATER USE
T(NO)_TAPE = TAPE; ! DITTO
T(NO)_SNO = SNO; ! DITTO
T(NO)_RLEV = RLEV; ! DITTO
T(NO)_CURR CHAP = 0; !AT BT
CHAP POSN(NO,1,FLAG); !AFTER LABEL
FINISH
END ; !OF ROUTINE OPEN TAPE
!*
!*
EXTERNALROUTINE CLOSE TAPE(INTEGER NO, INTEGERNAME FLAG)
!********************************************************************
!* CLOSES TAPE NUMBER (NO) AND SETS IT NOT IN USE *
!********************************************************************
RECORD P(PF)
RECORDNAME PR(PRF)
ABORT(1) UNLESS 0 < NO <= NTAPU
!CHECK NUMBER
ABORT(6) IF T(NO)_MODE = NOT IN USE
!CHECK TAPE WAS IN USE
P = 0
P_TYPE = 4
P_PERM = T(NO)_SNO
P_DSN = T(NO)_TAPE
P_DEST = X'FFFF0045'; !RELEASE TAPE BACK TO VOLUMES
FLAG = DPON2("VOLUMS",P,1,7)
IF FLAG = 0 START
PR == P
FLAG = PR_FAIL
FINISH
T(NO)_MODE = NOT IN USE; !MARK NOT IN USE
END ; !OF ROUTINE CLOSE TAPE
!*
!*
EXTERNALROUTINE READ PAGE(INTEGER NO, CHAP, ADDRESS, C
INTEGERNAME FLAG)
!**********************************************************************
!* CAN READ NEXT PAGE IN CURRENT CHAPTER OR 1ST PAGE IN NEW CHAPTER *
!* DEPENDING ON VALUE OF RLEV FOR PARTICULAR TAPE UNIT A NUMBER OF *
!* BACKWARDS READS ARE TRIED *
!* NOTE: NO ERROR MESSAGE ON A FAILURE THIS IS LEFT TO THE USER *
!**********************************************************************
INTEGER I
ABORT(1) UNLESS 0 < NO < NTAPU
ABORT(7) UNLESS T(NO)_MODE = READING
IF CHAP # T(NO)_CURR CHAP START
!NEW CHAPTER ?
CHAP POSN(NO,CHAP,FLAG); !POSITION TAPE
RETURN IF FLAG # 0
FINISH
F READ(NO,ADDRESS,FLAG); !READ THE PAGE FORWARD
RETURN IF FLAG = 0 OR FLAG = REQUEST REJECT C
OR T(NO)_RLEV = 0 OR FLAG = EOT OR FLAG = -1
!SUCCESS OR REQUEST REJECT OR NO RETRIES OR END
! OF TAPE OR ADDRESS VALIDATION FAILS
IF FLAG = POSITION LOST START
F READ(NO, ADDRESS, FLAG)
IF FLAG=POSITION LOST START
! STILL AT START OF FAULTY BLOCK.
F SKIP(NO)
FINISHELSESTART
! NOW ONE BLOCK BEYOND FAULTY BLOCK.
B SKIP(NO)
FINISH
RETURN
FINISH
!*
CYCLE I = 1,1,T(NO)_RLEV
B READ(NO,ADDRESS,FLAG); ! TRY TO READ IT BACKWARDS
RETURN IF FLAG = 0 OR FLAG = REQUEST REJECT
!SUCCESS OR REQUEST REJECT?
F READ(NO,ADDRESS,FLAG); ! TRY TO READ IT FORWARDS
RETURN IF FLAG = 0 OR FLAG = REQUEST REJECT
!SUCCESS OR REQUEST REJECT?
REPEAT
END ; !OF ROUTINE READ PAGE
!*
!*
EXTERNALROUTINE WRITE PAGE( C
INTEGER NO, CHAP, ADDRESS, INTEGERNAME FLAG)
!*********************************************************************
!* CAN WRITE NEXT PAGE IN CURRENT CHAPTER OR 1ST PAGE IN NEXT CHAPTER*
!* NOTE: NO ERROR MESSAGE ON FAILURE LEFT UP TO USER *
!*********************************************************************
RECORD P(TSF)
RECORDNAME PP(TRF)
ABORT(1) UNLESS 0 < NO <= NTAPU
ABORT(8) UNLESS T(NO)_MODE = WRITING
IF CHAP = T(NO)_CURR CHAP+1 START
!NEW CHAPTER?
TAPE MARK(NO,FLAG)
RETURN IF FLAG # 0
T(NO)_CURR CHAP = CHAP
FINISH
IF CHAP = T(NO)_CURR CHAP START
P = 0
P_DEST = T(NO)_SNO
P_IDENT = M'WRPG'
P_LCT = PAGE SIZE<<16!WRITE PGE
P_ADDRESS = ADDRESS
P_A = ADDRESS
P_LENGTH = PAGE SIZE
DOUT18(P); !WRITE A PAGE
PP == P
FLAG = PP_FAIL
FLAG = PP_DEST IF PP_DEST = -1
FINISH ELSE ABORT(4)
END ; !OF ROUTINE WRITE PAGE
!*
!*
EXTERNALROUTINE WRITE TRAILER(INTEGER NO, INTEGERNAME FLAG)
!********************************************************************
!* A TRAILER CONSISTS OF TWO TAPE MARKS *
!********************************************************************
INTEGER I
ABORT(1) UNLESS 0 < NO <= NTAPU
ABORT(7) UNLESS T(NO)_MODE = WRITING
CYCLE I = 1,1,2
TAPE MARK(NO,FLAG)
EXIT IF FLAG # 0
REPEAT
END ; !OF ROUTINE WRITE TRAILER
!*
!*
EXTERNALROUTINE BULK MOVE(INTEGER FROM,TO,PAGES,INTEGERNAME FLAG)
!*********************************************************************
!* BUL MOVES PAGES PAGES FROM FROM TO TO *
!* IN REVERSE IF PAGES<0 *
!* IF TO=-1 THEN TO SINK *
!*********************************************************************
RECORD P(PE)
INTEGER DIRECTION
ABORT(1) UNLESS 0<FROM<=NTAPU AND (TO=-1 OR 0<TO<=NTAPU)
ABORT(7) UNLESS T(FROM)_MODE=READING
ABORT(8) UNLESS TO=-1 OR T(TO)_MODE=WRITING
IF PAGES<0 START
DIRECTION=X'8000'
PAGES=-PAGES
FINISHELSE DIRECTION=0
PAGES=PAGES&X'7FFF'
P=0
P_DEST=BULK MOVER
IF TO=-1 START ; ! TO SINK
P_P1=X'03060000'!DIRECTION!PAGES
! P_P4,P_P5=0
FINISHELSESTART
P_P1=X'03030000'!DIRECTION!PAGES
P_P4=T(TO)_SNO
! P_P5=0 IE NO TRAILING TM
FINISH
P_P2=T(FROM)_SNO
! P_P3=0
P_P6=M'BMVE'
DOUT(P)
FLAG=P_P1
END ; ! ROUTINE BULK MOVE
!*
!*
EXTERNALROUTINE SKIP TM REVERSE(INTEGER NO, INTEGERNAME FLAG)
!**********************************************************************
!* SKIPS A SINGLE TAPE MARK IN REVERSE LEAVING TAPE BEHIND LAST BLOCK *
!**********************************************************************
RECORD P(PE)
ABORT(1) UNLESS 0<NO<=NTAPU
P=0
P_DEST=T(NO)_SNO
P_P1=M'STMR'
P_P2=(-1)<<16 ! (1<<8) ! TAPE POSN
DOUT(P)
FLAG=P_P2
T(NO)_CURR CHAP=T(NO)_CURR CHAP-1
END ; ! ROUTINE SKIP TM REVERSE
!*
!*
!*
!*
ENDOFFILE