!*****************************************************************! !* *! !* 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