!***********************************************************************
!
! 2900 TAPE HANDLER
!
!***********************************************************************
!
IF SSERIES=NO START
!..........PSERIES..........PSERIES..........PSERIES..........PSERIES
!
CONSTINTEGER TOP LBE=36
! { CH FN
CONSTINTEGERARRAY LBES(0:TOP LBE)= C
X'00000200', { 1 RF
X'40001200', { 2 RR
X'00000200', { 3 RF
X'44C01200',X'86800D10',X'00006200', { 4 RR,AS,RFEC
X'40001200', { 5 RR
X'04C00200',X'86800D10',X'40007200', { 6 RF,AS,RREC
X'04C00200',X'04805200',X'86800D10',X'00006200', { 7 RF,SR,AS,RFEC
X'44C01200',X'04804200',X'86800D10',X'40007200', { 8 RR,SF,AS,RREC
X'00000200', { 9 RF
X'40001200', { 10 RR
X'80000300', { 11 W
X'80802300', { 12 WT
X'04A05200',X'80C04300', { 13 SR IGN TM,ER....FOR WRITE(TM) RETRY
X'00804200', { 14 SF
X'00805200', { 15 SR
X'00802200', { 16 STF
X'00803200', { 17 STR
X'00803800', { 18 RW
X'80C04300', { 19 ER
X'00A04200', { 20 SF IGN TM....FOR FINAL POSITIONING
X'00A05200', { 21 SR IGN TM....DITTO
X'04A04200',X'00805200', { 22 SF IGN TM,SR....FOR TM LOOK-AHEAD
X'00805800', { 23 UNL....UNLOAD FLASH
X'00000E00', { 24 SEND PROPS
X'00001E00' { 25 QUALIFIED SPC FOR GTS
!
! ALL LBES WHICH DO NOT INVOLVE A XFER REQUIRE IGNORE SHORT.
! ERASES HAVE SHORT/LONG MASKED OFF FOR GTS DECKS WHICH DO A FIXED LENGTH
! AND THEREFORE DO NOT DECREMENT THE BYTE COUNT
!
FINISHELSESTART
!..........SSERIES..........SSERIES..........SSERIES..........SSERIES
!
CONSTINTEGER TOP CW=36
! { CH FN
CONSTINTEGERARRAY CW(0:TOP CW)= C
X'2000C002', { 1 RF
X'2000C012', { 2 RR
X'2000C002', { 3 RF
X'2C40C012',X'2840408D',X'20004062', { 4 RR,AS,RFEC
X'2000C012', { 5 RR
X'2C40C002',X'2840408D',X'20004072', { 6 RF,AS,RREC
X'2C40C002',X'28404052',X'2840408D',X'20004062', { 7 RF,SR,AS,RFEC
X'2C40C012',X'28404042',X'2840408D',X'20004072', { 8 RR,SF,AS,RREC
X'2000C002', { 9 RF
X'2000C012', { 10 RR
X'2000C083', { 11 W
X'2800C0A3', { 12 WT
X'2A40C052',X'2C0040C3', { 13 SR IGN TM,ER
X'2800C042', { 14 SF
X'2800C052', { 15 SR
X'2800C022', { 16 STF
X'2800C032', { 17 STR
X'2800C038', { 18 RW
X'2C00C0C3', { 19 ER
X'2A00C042', { 20 SF IGN TM
X'2A00C052', { 21 SR IGN TM
X'2A40C042',X'28004052', { 22 SF IG TM,SR
X'2800C058', { 23 UNL
X'2000C00E', { 24 SPC
X'2000C01E' { 25 QSPC
!
! DO WE NEED IGNORE SHORT FOR NON-XFER, IF WERE NOT GOING TO GIVE A
! A DUMMY DATA AREA. DCU TELLS FROM LACK OF FIXED BIT IN STE THAT NO
! AREA REQUIRED. LEAVE IGN SHORT IN ABOVE FOR NOW. IT CANT DO ANY HARM.
! SEE NOTE AFTER LBES ABOVE RE ERASE SHORT/LONG MASK
!
FINISH ;!..............................................................
!
CONSTINTEGER MAX CHAINS=25,PRIVATE=MAX CHAINS+1
!
CONSTBYTEINTEGERARRAY STATMASK(1:MAX CHAINS)=C
X'FE'(3),X'EC',X'FE',X'EC'(3),X'FE'(2),X'FC'(13),X'7C'(2)
! TERTIARY STATUS MASKS TO GO WITH EACH CHAIN ABOVE.
! FE=T0-T6. INCLUDES ADVISORY.
! EC=T0-T2,T4-T5. EXCLUDES MEDIA AND ADVISORY.
! 7C=T1-T5. EXCLUDES MANUAL/NA FOR SEND PROPS AT STARTUP
!
CONSTINTEGERARRAY CHAIN START(1:MAX CHAINS+1)= C
0,1,2,3,6,7,10,14,18,19,20,21,22,24,25,26,27,28,29,30,31,32,34,35,36,0
! THESE ARE THE LBE(CW) INDEX FOR CHAIN STARTS.
! CHAIN MAX+1 IS NOT REAL CHAIN.IT ACCOMMODATES PRIVATE CHAINS.
! SEE ROUTINE TERMINATE.
!
CONSTINTEGERARRAY CHAIN LENGTH(1:MAX CHAINS+1)= C
1,1,1,3,1,3,4,4,1,1,1,1,2,1,1,1,1,1,1,1,1,2,1,1,1,0
! THE NUMBER OF LBES(CWS) IN EACH CHAIN
CONSTINTEGER LAST READ CHAIN=10; ! JUST THAT
CONSTINTEGER LAST RETRY CHAIN=12
!
CONSTINTEGER POSMASK=X'5A5A5'; ! READ CHAINS ONLY. BIT 2** INDEX SET
! IF THAT LBE(CW) LEAVES US AFTER THE BLOCK, UNSET IF BEFORE.
CONSTINTEGER REVMASK=X'A424A'; ! READ CHAINS ONLY. BIT 2** INDEX SET
! IF THAT LBE(CW) IS REVERSE READ.
!
IF SSERIES=NO START
!..........PSERIES..........PSERIES..........PSERIES..........PSERIES
!
CONSTINTEGER NODATA=X'20000000', MAX XFER=X'3FFFF'
CONSTINTEGERARRAY IGNSHORTLONG(0:3)= C
0,X'00800000',X'00400000',X'00C00000'
FINISHELSESTART
!..........SSERIES..........SSERIES..........SSERIES..........SSERIES
!
CONSTINTEGER NODATA=X'00000200', MAX XFER=X'FFFF'
CONSTINTEGERARRAY IGNSHORTLONG(0:3)= C
0,X'08000000',X'04000000',X'0C000000'
FINISH ;!..............................................................
!
CONSTLONGINTEGER LONG1=1
!
CONSTINTEGER OK=0, NOTOK=-1
!
CONSTINTEGER NOT AVAILABLE=0, MANUAL=1, LOADING=2, LOADED=3, CLAIMED=4
CONSTINTEGER UNLOADING=5
CONSTSTRING (11)ARRAY STATES(0:5)= C
" na ",
" manual ",
" loading ",
" loaded ",
" claimed ",
" unloading "
! DRIVE STATES.
!
CONSTSTRING (5)ARRAY OFFLINE SW(0:1)="stop","reset"
! THE NAME OF THE SWITCH ON THE DRIVE TO DO IT FOR MTS AND GTS RESPECTIVELY
!
CONSTBYTEINTEGER TERM EXP=1, ATTN EXP=2
!
CONSTINTEGER NRZI=2, PE=3, GCR=8
!*
CONSTINTEGER ME=X'310000'
!
CONSTINTEGER CONTROLLER=X'300000'; ! GPC OR DCU AS APPROPRIATE
CONSTINTEGER ALLOC=11, DEALLOC=5, EXEC=12
!
CONSTINTEGER ON=1, OFF=0
!
CONSTINTEGER REJECT=2,BAD PARAMS=1,NOT CLAIMED=2,SNO NOT FOUND=4,BUSY=8
!
!------------------------------ FORMATS ------------------------------
!
RECORDFORMAT PF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!
RECORDFORMAT SHORTPF(INTEGER DEST,SRCE,P1,P2,P3,P4)
!
RECORDFORMAT CLF(INTEGER DEST,SRCE,IDENT, (HALFINTEGER H1,PERM,
STRING (7) DSN OR INTEGER REPLY,SNO,BYTEINTEGER D1,D2,D3,DEVID),
STRING (3) MNEM,BYTEINTEGER D4,D5,D6,MODE)
!
RECORDFORMAT REQF(INTEGER ADDR,LENGTH,LSL,LSTBA,
BYTEINTEGER STATE,CHAIN,FINAL CHAIN,
(BYTEINTEGER TARGET POS OR BYTEINTEGER TM),
(INTEGER READORS OR INTEGER SKIP TOT),
(INTEGER COUNT OR INTEGER PRIVATE ATTN),
INTEGER RETRIES,RETRY LIMIT,INTEGER COUNT1)
!
IF SSERIES=NO START
!..........PSERIES..........PSERIES..........PSERIES..........PSERIES
!
RECORDFORMAT RCBF(INTEGER LIMFLAGS,LSTBA,LB BYTES,LBA,AL BYTES,
ALA,INITWORD)
!
RECORDFORMAT TF(INTEGER LINK,LAB1,LAB2,STRING (7)DSN,INTEGER LBE1,
LBE2,LBE3,LBE4,ALE1,ALE2,STREAMR0,STREAMR1,STRING (3)MNEM,
RECORD (REQF)REQ,RECORD (RCBF)RCB,INTEGER SNO,RECORD (SHORTPF)REP,
(BYTEINTEGER T0,T1,T2,T3,T4,T5,T6,T7 OR LONGINTEGER T07),
BYTEINTEGER T8,T9,T10,T11,T12,T13,T14,GTS,SSTAT,PROP1,PROP2,PROP3,
INTEGER FAULTS,OPS,BYTEINTEGER STATE,MODE,LOAD STATE,UNLOAD PENDING)
! NOTE THAT TO OBTAIN ALIGNMENT OF RECORD 'REP' AND LONGINTEGER 'T07',
! 'SSTAT' IS FORCED OUT OF ITS NATURAL POSITION PRECEDING 'T0'.
! THE ABOVE RECORD IS MAPPED ONTO THE USER AREA IN THE DEVICE SLOT,
! AND MAY EXTEND UP TO 200 BYTES.
! CURRENT LENGTH OF ABOVE IS - 184
CONSTINTEGER TFSIZE=184
FINISHELSESTART
!..........SSERIES..........SSERIES..........SSERIES..........SSERIES
!
RECORDFORMAT TCBF(INTEGER CW,STE,LENGTH,ADDR,NEXT TCB,
BYTEINTEGER PSTAT,RESPONSE,HALFINTEGER REMBC,
INTEGERARRAY PREAMBLE,POSTAMBLE(1:4))
!
RECORDFORMAT TF(INTEGER LINK,STRING (3) MNEM,INTEGER LAB1,LAB2,
STRING (7)DSN,
RECORD (REQF)REQ,RECORD (SHORTPF)REP,
(BYTEINTEGER T0,T1,T2,T3,T4,T5,T6,T7 OR LONGINTEGER T07),
BYTEINTEGER T8,T9,T10,T11,T12,T13,T14,GTS,SSTAT,PROP1,PROP2,PROP3,
STATE,MODE,LOAD STATE,UNLOAD PENDING,
INTEGER STREAMR0,STREAMR1,
RECORD (TCBF)ARRAY TCBS(1:6),
INTEGER SNO,FAULTS,OPS)
! SEE NOTE RE ALIGNMENT IN PSERIES FORMAT ABOVE.
! ALSO NB THAT TCBS MUST BE DOUBLE WORD ALIGNED. H/W DOESNT CHECK
! THIS MAY EXTEND TO 480 BYTES. CURRENT LENGTH IS 468
! ONLY 4 OF THE 6 TCBS ARE USED HERE. UP TO 6 FOR PRIVATE CHAINS.
CONSTINTEGER TFSIZE=468
FINISH ;!..............................................................
!
RECORDFORMAT DF(INTEGER SER, PTSM, PROPADDR, TICKS SINCE,
CAA, GRCB AD, LBA, ALA, STATE, RESP0, RESP1, SENSE1, SENSE2,
SENSE3, SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, ENTSIZE,
PAW, USAW0, URCB AD, SENSDAT AD, LOGMASK, TRTAB AD, UA SIZE,
UA AD, TIMEOUT, PROPS0, PROPS1)
!
!------------------------- EXTERNAL SPECS ---------------------------
!
IF MULTIOCP=YES START
EXTERNALROUTINESPEC RESERVELOG
EXTERNALROUTINESPEC RELEASELOG
FINISH
EXTERNALROUTINESPEC OPMESS(STRING (23) S)
EXTERNALLONGINTEGERSPEC KMON
EXTERNALROUTINESPEC PKMONREC(STRING (20)TXT,RECORD (PF)NAME P)
EXTERNALROUTINESPEC PON(RECORD (PF)NAME P)
EXTERNALSTRINGFNSPEC HTOS(INTEGER VAL,PLACES)
EXTERNALROUTINESPEC DUMPTABLE(INTEGER TABNO,ADDR,L)
SYSTEMROUTINESPEC MOVE(INTEGER L,F,T)
SYSTEMROUTINESPEC ETOI(INTEGER A,L)
EXTERNALROUTINESPEC PRHEX(INTEGER N)
!
!=====================================================================
!
EXTERNALROUTINE TAPE(RECORD (PF)NAME P)
!
OWNINTEGER FIRSTTP=0, VOLUMS=0, INITIALISED=0
OWNINTEGER READ RETRIES=15,WRITE RETRIES=6
! WRITE RETRIES ARE LIMITED BY THE MAX INTERBLOCK GAP=300 INCHES.
! 6 ASSUMES A MAX BLOCK SIZE OF @64K AT 1600 BPI(IE 40 INCHES).
! P SERIES BLOCKS CAN BE UP TO 256K, BUT WE CANT CATER FOR THAT WHICH
! WOULD GIVE US ONLY ONE RETRY! IT WOULD BE SMARTER TO MAKE THE RETRIES
! A FUNCTION OF THE WRITTEN LENGTH.
OWNINTEGER RLEVEL=0
! REPORTING LEVEL:
! 2**0 - REPORT PARM RECORDS IN
! 2**1 - REPORT PARM RECORDS OUT
! 2**2 - DUMP TABLE AFTER CHAIN FIRED
OWNINTEGERNAME LASTLINK
RECORD (DF)NAME D
RECORD (TF)NAME T
RECORD (REQF)NAME REQ
RECORD (SHORTPF)NAME REP
RECORD (PF)PP
INTEGERNAME PREVLINK
INTEGER I,NDECKS,MODE,ACT,SNO,TMON
STRING (4) M
SWITCH ACTSW(1:13)
!
ROUTINESPEC FIRE CHAIN
ROUTINESPEC TERMINATE(INTEGER N,B)
ROUTINESPEC TELL VOLUMS(INTEGER LOAD TYPE)
!
ROUTINE MON(INTEGER MODE,RECORD (PF)NAME P)
CONSTSTRING (4)ARRAY MODES(1:3)= C
"IN","OUT","IN??"
PKMONREC("
TAPE(".MODES(MODE)."): ",P)
END ; ! ROUTINE MON
!
!
ROUTINE MYPON(RECORD (PF)NAME P)
IF TMON#0 OR RLEVEL&2#0 THEN MON(2,P)
PON(P)
END ; ! ROUTINE MYPON
!
!
ROUTINE REPORT(STRING (255) MESS)
!***********************************************************************
! REPORTS ABNORMAL CONDITIONS TO LOG
!***********************************************************************
CONSTBYTEINTEGERARRAY HX(0:15)= C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
!
ROUTINE PBYTE(BYTEINTEGER N)
PRINTSYMBOL(HX(N>>4))
PRINTSYMBOL(HX(N&X'F'))
END ; ! ROUTINE PBYTE
!
INTEGER I,J,SIZE
T_FAULTS=T_FAULTS+1
RESERVELOG IF MULTIOCP=YES
PRINTSTRING("
TAPE ERROR// ABNORMAL TERMINATION - ".MESS."
DECK ")
PBYTE(T_PROP2)
PRINTSTRING(" FAULTS (DECK/REQ) ")
PRHEX((T_FAULTS<<16)!REQ_RETRIES)
PRINTSTRING(" REQ ID ")
PRHEX(REP_P1)
SPACE
PRINTSTRING(T_DSN) UNLESS 3<=T_LOAD STATE<=4
! IT MIGHT BE JUNK IN THAT CASE.
IF REQ_CHAIN<=10 START
MESS=" READ"
FINISHELSEIF REQ_CHAIN<=12 START
MESS=" WRITE"
FINISHELSE MESS=" OTHER"
PRINTSTRING(MESS)
PRINTSTRING("
SST T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11
")
SPACE
PBYTE(T_SSTAT)
J = ADDR(T_T0)
FOR I=0,1,11 CYCLE
SPACES(2)
PBYTE(BYTEINTEGER(J+I))
REPEAT
SIZE=TFSIZE
DUMP TABLE(61,ADDR(T),SIZE)
RELEASELOG IF MULTIOCP=YES
END ; ! ROUTINE REPORT
!
!
INTEGERFN SEARCH TPS(INTEGER SWIND,IMATCH,STRING (6) SMATCH)
!**********************************************************************
! CALLED TO SCAN T CHAIN MATCHING IMATCH OR SMATCH RETURNING OK
! OR NOTOK,LEAVING T MAPPED TO MATCHING RECORD.
! OR TO SCAN ENTIRE CHAIN WITHOUT MATCHING, WHEN RESULT IS IRRELEVANT
! AND T IS LEFT MAPPED TO LAST RECORD.
! SWIND=1 - SMATCH MNEMONIC
! =2 - SMATCH DSN
! =3 - IMATCH SNO
! =4 - SCAN AND TELL VOLUMS
! =5 - SCAN AND DISPLAY
!**********************************************************************
STRING (7) DSN
SWITCH SW(1:5)
RESULT =NOTOK IF FIRSTTP=0; ! CHAIN EMPTY
T==RECORD(FIRSTTP)
PREVLINK==FIRSTTP
!
CYCLE
->SW(SWIND)
!
SW(1):; ! MATCH MNEM
IF T_MNEM=SMATCH THENRESULT =OK
->NEXT
!
SW(2):; ! MATCH DSN
IF T_DSN=SMATCH THENRESULT =OK
->NEXT
!
SW(3):; ! MATCH SNO
IF T_SNO=IMATCH THENRESULT =OK
->NEXT
!
SW(4):; ! TELL VOLUMS
IF LOADED<=T_STATE<=CLAIMED THEN TELL VOLUMS(1)
! COULD IT BE CLAIMED IF VOLUMS ONLY JUST HERE?
->NEXT
!
SW(5):; ! TELL OPER
IF LOADED<=T_STATE<=CLAIMED THEN DSN=T_DSN ELSE DSN=""
OPMESS(HTOS(T_SNO,4)." ".T_MNEM.STATES(T_STATE).DSN)
->NEXT
!
NEXT:
RESULT =NOTOK IF T_LINK=0
PREVLINK==T_LINK
T==RECORD(T_LINK)
REPEAT
END ; ! FN SEARCH TPS
!*
!*
ROUTINE TELL VOLUMS(INTEGER LOAD TYPE)
!***********************************************************************
! TELLS VOLUMS ABOUT LOAD OR UNLOAD OF DRIVE.
! LOAD TYPE=0(NOT LOADED), 1(LOADED)
! VOLUMS ALSO NEEDS TO KNOW LOADED WITH LABEL(1) OR NO LABEL(2)
!***********************************************************************
RECORDFORMAT VF(INTEGER DEST,SRCE,TYPE,LOAD,STRING (4)MNEM, C
STRING (7) DSN,BYTEINTEGER D1,MODE,PERM)
RECORD (VF) V
IF VOLUMS=0 THENRETURN ; ! VOLUMS NOT THERE
IF LOAD TYPE=1 AND T_DSN="NOLABEL" THEN LOAD TYPE=2
V=0
V_DEST=VOLUMS
V_SRCE=ME
V_TYPE=4
V_LOAD=LOAD TYPE
V_DSN=T_DSN UNLESS LOAD TYPE=0
V_MNEM=T_MNEM
V_PERM=2-((T_PROP3>>6)&1)
V_MODE=T_MODE
MYPON(V)
END ; ! ROUTINE TELL VOLUMS
!
!
ROUTINE LOAD
!***********************************************************************
! ENTERED TO GET PROPS AND, IF APPROPRIATE, LOAD EACH DECK SUCCESSFULLY
! ALLOCATED AT START-UP, AND THEREAFTER FOR ANY DECK GIVING AN AUTO
! ATTENTION, AND
! TO UNLOAD OR RELEASE/REWIND A DECK WHEN USER RELEASES IT OR AT
! DISASTER.
!***********************************************************************
CONSTBYTEINTEGERARRAY GTS MODES(0:3)=3,8,2,8
OWNINTEGER VOL1=X'E5D6D3F1'
INTEGER I,CH
STRING (7) DSN
STRING (40) S
SWITCH LDSW(0:9)
!
->LDSW(T_LOAD STATE)
!
LDSW(0):; ! GET PROP CODE.
REP=0
REQ=0
REQ_ADDR=ADDR(T_PROP1)
REQ_LENGTH=3
REQ_CHAIN=24+T_GTS; ! IE 24 FOR MTS, 25 FOR GTS
T_MODE=PE
FIRE CHAIN
T_LOAD STATE=1
T_STATE=LOADING
RETURN
!
LDSW(1):; ! REPLY FROM SEND PROPS
IF REP_P2#0 START
! SEND PROPS FAILED. INOP MASKED OFF SO SOMETHING ELSE
->LOAD FAIL
FINISH
! AT STARTUP, WE DONT HAVE ANY SENSE BYTES HERE TO TELL WHETHER NOTAVAIL,
! MANUAL OR LOADED.
! WE JUST PLOUGH ON AND DO A REWIND ANYWAY AND SORT IT OUT FROM THAT
! REP_P2=0
REQ=0
REQ_CHAIN=18
REQ_ADDR=X'81000000'
REQ_LENGTH=50; ! STANDARD DUMMY ASL
FIRE CHAIN
T_LOAD STATE=2
RETURN
!
LDSW(2):; ! REPLY FROM INITIAL REWIND
IF REP_P2#0 START
! WE EXPECT IT TO FAIL FOR UNLOADED DECKS AT START-UP
! (THIS COULD BE DONE AFTER SPC ABOVE EXCEPT FOR GTS DECKS WHICH DONT
! GIVE U/S FOR SPC IN MANUAL).
IF T_T0&X'C0'#0 START ; ! UNAVAIL OR MANUAL
IF T_T0&X'40'#0 THEN T_STATE=NOT AVAILABLE ELSE T_STATE=MANUAL
->EXIT
FINISHELSE ->LOAD FAIL
FINISH
! SO ITS LOADED. LETS TRY TO READ SOMETHING LIKE A LABEL.
! FIRST IN PE. GTS DECKS WILL DO THE READ IN THE TAPE MODE AND SAY IF ITS
! DIFFERENT. MTS DECKS WILL FAIL, WHEN IF NRZI IS FITTED, WE'LL TRY THAT.
SET UP READ:
! CAUTION*** COME HERE FROM LDSW(1) AND LDSW(4) ALSO
! REP_P2=0
REQ=0
REQ_ADDR=ADDR(T_LAB1)
REQ_LENGTH=16
REQ_CHAIN=1; ! READ FORWARD
REQ_FINAL CHAIN=9; ! STANDARD
REQ_TARGET POS=1
REQ_READORS=IGNSHORTLONG(2); ! IGNORE LONG SINCE IT SURELY WILL BE
REQ_RETRY LIMIT=4
! THIS ACUALLY ONLY GIVES US 2 GOES AT IT, SINCE REVERSE READS LONG
! ARE INEVITABLY FAILURES (SEE OK(1) IN 'TERMINATE')
FIRE CHAIN
T_LOAD STATE=3
RETURN
!
LDSW(3):; ! REPLY FROM LABEL READ
CH=0
IF REP_P2#0 AND T_GTS#0 AND T_T6&64#0 START
! GTS FAILED 'INCOMPATIBLE MODES'. THIS IS A WARNING ONLY, AND THE READ
! HAS BEEN DONE IN THE MODE OF THE TAPE, THE LATTER BEING ADVISED IN
! T13, BITS 104,105
T_MODE=GTS MODES((T_T13>>6)&3)
REP_P2=0; ! MAKE IT LOOK SUCCESSFUL
FINISH
IF REP_P2#0 START ; ! FAILED
IF T_T4&128#0 START ; ! WRONG MODE
! FOR GTS, THIS MEANS NO RECOGNISABLE MODE. FOR MTS IT MAY MEAN
! A MODE RECOGNISED BUT NOT THE REQUESTED ONE.
IF T_GTS=0 AND T_MODE=PE AND T_PROP3&16#0 START
! MTS. WE HAVE TO TRY EACH POSSIBLE MODE TO SEE IF ANY SUCCEEDS.
! THAT WAS PE, AND NRZI IS FITTED, SO TRY THAT
! FIRST A REWIND
REP=0
REQ_CHAIN=18
! PREV ADDR/LENGTH WILL DO IF REQD
T_LOAD STATE=4
FIRE CHAIN
RETURN
FINISH
! IF GTS, NO MODE ON TAPE.
! IF MTS, EITHER TRIED BOTH, OR NRZI NOT FITTED. SET MODE UNDEFINED.
! THE ONLY THING THAT CAN BE DONE TO THIS TAPE IS A WRITE AT BT,
! AFTER A MODE OVERRIDE IN 'CLAIM VOLUME'.
T_MODE=0
OPMESS(T_MNEM." undefined mode")
FINISH
! SO SOME ERROR OTHER THAN MODE, MAYBE NOISE. RETAIN IT AS 'NOLABEL'.
FINISHELSESTART ; ! READ SUCCEEDED.
! IBM LABELS ARE 80 BYTES STARTING 'VOL1' IN EBCDIC.
! ICL MAY BE 86,96 OR GREATER IF IPL BLOCKS. EACH BEGINS WITH INTEGER
! BLOCK COUNT AND HALFINTEGER BYTE LENGTH.
IF T_LAB1=0 THEN MOVE(10,ADDR(T_LAB1)+6,ADDR(T_LAB1))
! IE IT WAS A BLOCK COUNT, SO MOVE DATA FIELD DOWN.
IF T_LAB1=VOL1 START ; ! FORMAT OK
MOVE(6,ADDR(T_LAB1)+4,ADDR(DSN)+1)
LENGTH(DSN)=6
ETOI(ADDR(DSN)+1,6)
! NOW CHECK FOR VALID CHARS IN DSN
FOR I=1,1,6 CYCLE
CH=CHARNO(DSN,I)
UNLESS '0'<=CH<='9' OR 'A'<=CH<='Z' OR CH=' ' START
OPMESS(T_MNEM." faulty dsn - ".DSN)
CH=0
EXIT
FINISH
REPEAT
FINISH
FINISH
! SO UNDEFINED MODE, OR READ FAILED OTHER THAN IDENTIFIER,
! OR AN INVALID FORMAT READ, OR AN INVALID DSN READ,
! ALL GET HERE WITH CH=0 AND ARE ALL TREATED AS NOLABEL.
! GET HERE WITH CH#0 ONLY IF GOOD DSN READ.
IF CH#0 THEN T_DSN=DSN ELSE T_DSN="NOLABEL"
REP=0
REQ_CHAIN=18
! PREV ADDR AND LENGTH WILL DO FOR DUMMY IF NEEDED
FIRE CHAIN
T_LOAD STATE=5
RETURN
!
LDSW(4):; ! REWIND AFTER FAILED PE READ, FOR A TRY AT NRZI.
IF REP_P2#0 THEN ->LOAD FAIL
T_MODE=NRZI
->SET UP READ; ! WITH REP_P2=0
!
LDSW(5):; ! FINAL REWIND
IF REP_P2#0 THEN ->LOAD FAIL
!
LOAD OK:
T_STATE=LOADED
TELL VOLUMS(1)
OPMESS(T_MNEM." loaded ".T_DSN)
!
EXIT:
T_LOAD STATE=0
RETURN
!
LOAD FAIL:
OPMESS(T_MNEM." load failed")
T_LOAD STATE=6
! AND DROP THRU' TO .......
!
UNLOAD:
LDSW(6):LDSW(8):; ! ENTRY POINT FOR UNLOAD, RELEASE/REWIND
IF LOADED<=T_STATE<=CLAIMED THEN TELL VOLUMS(0)
T_DSN=""; ! JUST TO KEEP 'CLAIM VOLUME' TIDY
REP=0
REQ=0
IF T_LOAD STATE=6 THEN REQ_CHAIN=23 ELSE REQ_CHAIN=18
! DISCONNECT REWIND
REQ_ADDR=X'81000000'
REQ_LENGTH=50
FIRE CHAIN
T_LOAD STATE=T_LOAD STATE+1
T_STATE=UNLOADING
RETURN
!
LDSW(7):; ! REPLY FROM UNLOAD
IF REP_P2#0 AND T_T0&X'C0'=0 THENC
S=" unload fails. Press ".OFFLINE SW(T_GTS)."/unload" ELSE S=" unloaded"
! IT MIGHT ALREADY BE UNLOADED IF PRIVATE CHAIN USER HAS DONE IT.
OPMESS(T_MNEM.S)
T_STATE=MANUAL
->EXIT
!
LDSW(9):; ! REPLY FROM RLSR/RWND
IF REP_P2#0 START
OPMESS(T_MNEM." rlse/rwnd fails")
T_LOAD STATE=6
->UNLOAD
FINISH
! NOW RE-READ LABEL. WE'RE AT BT AND REP_P2=0 SO GO STRAIGHT TO READ
T_MODE=PE
T_LOAD STATE=2
T_STATE=LOADING
->LDSW(2)
!
!
END ; ! ROUTINE LOAD
!*
!*
ROUTINE CLAIM VOLUME(RECORD (CLF)NAME P)
!**********************************************************************
! ALLOCATES VOLUME TO REQUESTING USER.
! P_DSN IS REQUIRED VOLUME, OR P_MNEM IF P_DSN="NOLABEL".
! P_PERM IS REQUIRED PERM, 1=READ, 2=RITE
! P_MODE IS REQUIRED MODE:
! MODE&B'1011'=8(GCR),OR 3(PE),OR 2(NRZI) OVERRIDES MODE ESTABLISHED IN LABEL READ,
! (UNLESS NRZI SPECIFIED AND NOT FITTED, OR GCR AND NOT GTS DECK, WHEN REJECT).
! IF NO OVERRIDE MODE SPECIFIED AND NO MODE ESTABLISHED AT LABEL
! READ (SOME OTHER MODE RECORDED OR BLANK TAPE), THEN REJECT.
! MODE&4 IS COMPRESS EXPAND AND IS ORED INTO TAPE MODE OR OVERRIDE
! AS APPROPRIATE.
! A MODE OF ZERO THUS USES CURRENT TAPE MODE AND NO CE.
!**********************************************************************
INTEGER OVERMODE,I
IF P_DSN="NOLABEL" THEN I=SEARCH TPS(1,0,P_MNEM) C
ELSE I=SEARCH TPS(2,0,P_DSN)
OVERMODE=P_MODE&B'1011'
IF I=NOTOK OR T_STATE#LOADED START
! IF SEARCH FAILS, THEN DSN NOT FOUND, OR MNEMONIC NOT PRESENT
! IF SEARCH SUCCEEDS, T MAPPED. IF STATE#LOADED THEN TAPE ALREADY
! CLAIMED. THIS LATTER CHECK IS DONE BY VOLUMS BEFORE COMING HERE,
! BUT WE DO IT HERE FOR CHOPSUPE (NO VOLUMS AROUND YET).
P_REPLY=1
FINISHELSEIF T_PROP3&X'40'#0 AND P_PERM=2 START
! N0 RING FITTED AND WRITE REQUESTED
P_REPLY=2
FINISHELSEIF OVERMODE=1 OR OVERMODE>8 OR (OVERMODE=0 AND T_MODE=0) ORC
(OVERMODE=GCR AND T_GTS=0) ORC
(OVERMODE=NRZI AND (T_PROP3>>T_GTS)&X'10'=0) START
! NRZI BIT IS AT X20 FOR GTS DECKS!!!!!
! INVALID OVERRIDE MODE, OR
! NO OVERRIDE MODE AND NONE ESTABLISHED AT LABEL READ, OR
! GCR OVERRIDE MODE AND NOT GTS DECK, OR
! NRZI OVERRIDE MODE AND NOT FITTED
P_REPLY=3
FINISHELSESTART ; ! ALL OK
T_STATE=CLAIMED
IF OVERMODE#0 THEN T_MODE=OVERMODE
T_MODE=T_MODE!(P_MODE&4); ! INCLUDE CE BIT IF ANY
T_SNO=(T_SNO+X'100')&X'FFFF'
! BOTTOM BYTE IS SNO PROVIDED BY CONTROLLER. TOP BYTE IS CYCLIC 0-255.
! SO IF WE LOSE A DECK AND DO NOT GET THE EXPECTED RELEASE FROM USER
! WE CAN REALLOCATE THE DECK WITHOUT FEAR OF THE OUTSTANDING SNO COMING.
! BUT CAUTION*** THE SNO (STREAM ACTUALLY) PROVIDED BY CONTROLLER IS NOT
! GUARANTEED TO BE ONLY A BYTE. IF THERE ARE ENOUGH DEVICES IT COULD
! GO OVER.
P_SNO=ME!T_SNO
P_DEVID=T_PROP2; ! CONTROLLER/MECH ADDRESS. CAN BE USED BY USER
! IF WRITING, TO SHOW LAST DECK WRITTEN ON.
P_MODE=T_MODE
P_REPLY=OK
FINISH
END ; ! ROUTINE CLAIM VOLUME
!
!
ROUTINE ATTENTION
!***********************************************************************
! ENTERED TO DEAL WITH ATTENTIONS.
! IT IS REPUTEDLY POSSIBLE FOR MULTIPLE INDEPENDENT BITS TO BE SET
! IF SEVERAL STATE CHANGES OCCURRED IN THE DEVICE WHILE THE SYSTEM
! WAS UNINTERRUPTIBLE (NORMALLY THE ONLY TWO WHICH WOULD BE EXPECTED
! TOGETHER ARE AUTO AND BT). THIS CODE ATTEMPTS TO DEAL WITH SUCH
! MULTIPLE OCCURENCES, BUT LACKING THE TIME SEQUENCE OF THE BITS
! THEY ARE NOT NECESSARILY UNAMBIGUOUS AND WE MAY END UP IN A STATE
! DIFFERENT FROM THE DEVICE. HOWEVER THIS SHOULD BE EXCEEDINGLY RARE
! AND IN MOST CASES REMEDIAL BY OPERATOR ACTION.
!
! MTS BITS:-
! X80=AUTO
! X40=BT
! X20=ALWAYS SET
! X10=TM
! X08=ENGINEER
! X04=AVAILABLE
! X02=NOT AVAILABLE
! X01=MANUAL REQUESTED
!
! GTS BITS:-
! X80=AUTO
! X40=BT
! X20=SECONDARY ATTN
! X10=TM
! X08=ALWAYS ZERO
! X04=AVAILABLE(CLUSTER)
! X02=NOT AVAILABLE(CLUSTER)
! X01=ALWAYS ZERO
!
! THE AVAILABLE/NOT AVAILABLE SWITCH AFFECTS ALL DECKS ON A GTS CLUSTER
! BUT ONLY ONE ATTN IS GENERATED BY THE H/W. THIS CODE RELIES ON DCU
! GENERATING ONE ATTN FOR EACH DECK ALLOCATED IN THAT CASE.
!***********************************************************************
CONSTINTEGER AUTO=X'80',BT=X'40',SEC ATTN=X'20',TM=X'10',ENGINR=8,AVAIL=4,
NOT AVAIL=2,HOLD=1
INTEGER ATTN,I
SWITCH SW(0:2)
!
ROUTINE TELL USER
REQ_STATE=0
IF REP_DEST#0 START ; ! BY USER
REP_P2=3
MYPON(RECORD(ADDR(REP))); ! MUST DO IT THIS WAY SINCE REP'S LENGTH IS < THAN PARAM SPEC
FINISHELSE T_LOAD STATE=0
! IE ABORT LOAD OR UNLOAD
END
!
ROUTINE RELEASE
TELL VOLUMS(0) IF LOADED<=T_STATE<=CLAIMED
TELL USER IF REQ_STATE#0; ! IF TERM OR ATTN EXPECTED
T_DSN=""
T_UNLOAD PENDING=0; ! IN CASE IT ISNT
END ; ! ROUTINE RELEASE
!
ROUTINE REPORT PRIVATE ATTN
IF REQ_PRIVATE ATTN=0 THENRETURN
P_DEST=REQ_PRIVATE ATTN
! THE REST IS AS RECEIVED FROM CONTROLLER. PASS IT ON
MYPON(P)
END ; ! REPORT PRIVATE ATTN
!
ATTN=(T_STREAMR0>>8)&X'FF'
IF T_GTS=0 THEN ATTN=ATTN&X'DF'; ! X20 ALWAYS SET FOR MTS
IF ATTN&ENGINR#0 THEN ATTN=(ATTN&(¬ENGINR))!NOT AVAIL
! WE TREAT ENGINEER STATE AS SYNONYMOUS WITH NOT AVAILABLE?
!
AGAIN:
IF ATTN=0 THENRETURN
IF T_STATE>1 THEN I=2 ELSE I=T_STATE
! THUS LOADING,LOADED,CLAIMED AND UNLOADING=AUTO
->SW(I)
!
SW(0):; ! NOT AVAILABLE
IF ATTN&AVAIL#0 START
T_STATE=MANUAL
ATTN=ATTN&(¬AVAIL)
OPMESS(T_MNEM." available")
->AGAIN
FINISH
->SPURIOUS
!
SW(1):; ! MANUAL
IF ATTN&NOT AVAIL#0 START
T_STATE=NOT AVAILABLE
ATTN=ATTN&(¬NOT AVAIL)
OPMESS(T_MNEM." not available")
->AGAIN
FINISH
IF ATTN&AUTO#0 START
LOAD; ! INITIATE LOAD (SETTING STATE TO LOADING)
ATTN=ATTN&(¬AUTO)
ATTN=ATTN&(¬BT)
! IF MTS, BT MAY BE SET IF PREVIOUS TAPE WAS UNLOADED BY STOP/UNLOAD
! RATHER THAN BY SOFTWARE. TO BE IN MANUAL HERE WE MUST ALSO
! HAVE GONE NOT AVAILABLE, AVAILABLE AS WELL SO NO ACTION IS
! REQUIRED ON THE BT.
->AGAIN
FINISH
IF ATTN&SEC ATTN#0 START
! THIS IS SPURIOUS. GTS DECKS FREQUENTLY FAIL TO DELIVER THE ONLINE ATTN
! IF IT IS PRESSED WHILE LOADING. THE DECK DOES GO TO AUTO HOWEVER.
! OPS THEN DO RESET/ONLINE, AND WE GET THE RESET AS THIS.
ATTN=ATTN&(¬SEC ATTN)
->AGAIN
FINISH
->SPURIOUS
!
SW(2):; ! AUTO
IF ATTN&AUTO#0 START
! THE DECK HAS GONE TO MANUAL BEHIND OUR BACK. EG STOP IF MTS.
! WE MUST ASSUME THAT A NEW TAPE HAS BEEN LOADED.
ATTN=ATTN&(¬AUTO)
ATTN=ATTN&(¬BT); ! MIGHT BE FOR MTS
RELEASE
LOAD; ! AND INITIATE A RELOAD
->AGAIN
FINISHELSEIF ATTN&BT#0 START
! BT WITHOUT AUTO
IF REQ_STATE=ATTN EXP OR REQ_CHAIN=PRIVATE START
ATTN=ATTN&(¬BT)
IF REQ_STATE=ATTN EXP THEN TERMINATE(-1,1) C
ELSE REPORT PRIVATE ATTN
->AGAIN
FINISH
FINISHELSEIF ATTN&SEC ATTN#0 START
! MUST BE GTS. THIS BIT IS KNOCKED OUT ABOVE FOR MTS
! GTS USES THIS TO REPORT
! 1) RESET HAS BEEN PRESSED OR VACUUM LOST AND THE DECK IS NOW IN MANUAL
! 2) THE OFFLINE PART OF A SKIP TM HAS FAILED BACUSE OF BLANK TAPE
! OR AN IDENTIFIER ERROR(IF INITIATED AT BT).
! WE DONT HAVE UPDATED STATUS BYTES AT THIS POINT TO TELL US WHICH IT
! WAS AND IT WOULD BE AN ALMIGHTY HASSLE TO FETCH THEM, SO, IF STATE IS
! CLAIMED AND AN ATTENTION EXPECTED, WE DON'T KNOW
! WHETHER THE DECK IS NOW IN MANUAL(CASE 1) OR STILL IN AUTO(2).
! WE MUST FORCE IT INTO A KNOWN STATE, IE UNLOAD IT. THIS IS PRETTY
! DRASTIC, BUT HOPEFULLY VERY VERY RARE.
ATTN=ATTN&(¬SEC ATTN)
IF T_STATE=CLAIMED START
OPMESS(T_MNEM." manual when in use")
IF REQ_STATE=ATTN EXP START ; ! THIS IS THE DOUBTFUL ONE
TELL USER
T_LOAD STATE=6
LOAD; ! EVEN IF IT IS ALREADY OFF, THIS RESETS THINGS AND TELLS VOLUMS
->AGAIN
FINISH
FINISH
! SO IF WE GET HERE, IT IS GENUINELY OFF LINE, SINCE 'SKIP TM' IS NOT
! DONE IN 'LOAD'.
RELEASE
T_STATE=MANUAL
OPMESS(T_MNEM." unloaded")
->AGAIN
FINISHELSEIF ATTN&TM#0 START
IF REQ_STATE=ATTN EXP OR REQ_CHAIN=PRIVATE START
ATTN=ATTN&(¬TM)
IF REQ_STATE=ATTN EXP THEN TERMINATE(-1,0) C
ELSE REPORT PRIVATE ATTN
->AGAIN
FINISH
FINISHELSEIF ATTN&NOT AVAIL#0 START
ATTN=ATTN&(¬NOT AVAIL)
OPMESS(T_MNEM." not available")
RELEASE
T_STATE=NOT AVAILABLE
->AGAIN
FINISHELSEIF ATTN&HOLD#0 START
IF T_GTS=0 START ; ! MTS ONLY
ATTN=ATTN&(¬HOLD)
OPMESS(T_MNEM." manual when in use") IF T_STATE=CLAIMED
IF REQ_STATE=0 START
! CLAIMED AND IDLE, OR LOADED. NOT LOADING OR UNLOADING.
T_LOADSTATE=6
LOAD; ! UNLOAD ENTRY POINT
FINISHELSESTART
! CLAIMED AND IN USE, OR LOADING OR UNLOADING
T_UNLOAD PENDING=1 UNLESS T_STATE=UNLOADING
FINISH
->AGAIN
FINISH
FINISH
! AND DROP THRU' TO..
!
SPURIOUS:
REPORT("SPURIOUS ATTENTION(S)")
END ; ! ROUTINE ATTENTION
!
!
ROUTINE TERMINATE(INTEGER NORMAL,BT)
!**********************************************************************
! ENTERED ON CHAIN TERMINATION.
! NORMAL=0 FOR NORMAL TERMINATION,
! >0 FOR ABNORMAL TERMINATION,
! =-1 IF WE ENTERED VIA ATTENTION FOR EXPECTED BT OR TM,
! WHEN BT=1 OR 0 RESPECTIVELY.
! THIS ENTRY FOR CHAINS 16,17(SKIP TM FORE AND AFT),18(REWIND)
! AND NOTIONAL CHAIN 0, SEE US(5) BELOW.
!**********************************************************************
CONSTINTEGER ERROR CLASSES=7
!
CONSTSTRING (14)ARRAY USMESS(1:ERROR CLASSES)= C
"LOST DEVICE",
"LOST POSITION",
"REV BT",
"IRRECOVERABLE",
"RECOVERABLE",
"STIE/MTIE/RIPE",
"UNDEFINED"
!
INTEGER PSTAT,FINAL COMMAND,ERROR CLASS,SKIP,REMBC,FLAG
SWITCH OK(0:MAX CHAINS),US(1:ERROR CLASSES),LS,TM(1:MAX CHAINS)
!
INTEGERFN DIAGNOSE
! ENTERED ON ABTERM WITH UNSUCCESSFUL IN PSTAT TO DIAGNOSE ERROR BITS
! IN TERTIARY STATUS T0-T7
! RETURNS ERROR CLASS.
!
! THE INTERPRETATION OF THE TERTIARY STATUS BITS FOLLOWS, TOGETHER WITH
! THEIR ASSIGNMENT TO ONE OF SEVEN CLASSES. THE CLASSES ARE:
!
! 1 - LOST DEVICE
! 2 - EITHER LOST POSITION OR SHOULD NEVER HAPPEN SO WE HAVE A BUG.
! 3 - REVERSED INTO BT
! 4 - COMMAND FAILED AND THEIR IS NO POINT IN RETRYING, BUT POSITION
! IS OK, AND THE USER MAY CONTINUE.
! 5 - COMMAND FAILED AND SHOULD BE RETRIED.
! 6 - ADVISORY (JUST LOG IT FOR ENGINEERS SAKE)
! 7 - UNDEFINED. SHOULD NEVER BE SET.
!
! SOME OF THE BITS INDICATE ERRORS IN THE STRUCTURE OF A BLOCK -
! EG 'NON VALID NRZI BLOCK', 'NO PREAMBLE', ETC.
! IT MIGHT BE THOUGHT THAT SINCE A BLOCK, ALBEIT DEFORMED, WAS DETECTED
! IT IS SAFE TO SKIP BACK OVER IT FOR A RETRY. HOWEVER, THE BLOCK MIGHT
! NOT BE DETECTED IN REVERSE AND POSITION WOULD THUS BE LOST. ALL SUCH
! BITS ARE THEREFORE ASSIGNED TO CLASS 2. THIS MAY BE TOO SEVERE IN THE
! LIGHT OF EXPERIENCE.
! 'NO POSTAMBLE' HAS BEEN RECLASSIFIED FROM 2 TO 5. IT WAS FOUND TO OCCUR
! SPURIOUSLY VERY OFTEN WITH UTIE, AND SO FAR HAS BEEN FOUND SAFE TO RETRY.
! ON THE OTHER HAND, EXPERIENCE HAS SHOWN THAT 'NO PREAMBLE' MUST VERY
! DEFINITELY NOT BE RETRIED.
!
! IN THE FOLLOWING CLASSIFICATIONS THE BITS IN LONGINTEGER T07 ARE
! NUMBERED FROM THE MOST SIGNIFICANT END A LA ICL.
!
! MTS TERTIARY STATUS BITS
! --- -------- ------ ----
! N CLASS MEANING
!
! 0 1 MANUAL
! 1 1 NOT AVAILABLE
! 2-7 7 UNDEFINED
! 8 2 IPE WE DONT KNOW WHETHER THE ERROR
! 9 2 2*RIPE WAS ON THE COMMAND GOING OR DATA
! 10 2 SRNH COMING, SO POSITION IS LOST.
! 11-15 7 UNDEF
! 16 2 ILLEGAL COMMAND A BUG
! 17 2 ILLEGAL MODE DITTO
! 18 4 ILLEGAL DATA CE MODE ONLY
! 19 4 DOUBLE FILLER ONLY WITH A18
! 20 3 REVERSED INTO BT
! 21 2 NO RING FOR WRITE A BUG
! 22 2 DECK BUSY SHOULD NEVER HAPPEN, SO BUG
! 23 7 UNDEF
! 24 5 VRC
! 25 2 NON VALID NRZI BLOCK
! 26 5 UTIE
! 27 5 SKEW
! 28 2 NO PREAMBLE(PE)
! 5 CRC(NRZI)
! 29 5 DATA SHORT(PE) HAPPENS FOR PARTICULAR DATA PATTERN
! AND STIE CORRECTION
! 5 LRC(NRZI)
! 30 5 NO POSTAMBLE(PE)
! 5 TIE(NRZI)
! 31 5 THRESHOLD
! 32 2 IDENTIFIER A BUG(EXCEPT IN LOAD SEQUENCE
! 33 2 NO DATA WRITTEN WHAT DOES THIS MEAN???
! 34 2 INVALID NRZI BLOCK OF A DIFFERENT KIND!!
! 35 7 UNDEF
! 36 2 25 FEET BLANK
! 37 2 RETURN FAILED. DEVICE TIME OUT
! 38 2 POOR ERASURE. NOW YOU SEE IT, NOW YOU DONT
! 39-47 7 UNDEF
! 48 6 RIPE
! 49-50 7 UNDEF
! 51 6 STIE ERROR RECOVERED ON FLY
! 52-63 7 UNDEF
!
! SINCE SOME BITS ARE ASSIGNED TO DIFFERENT CLASSES DEPENDING ON THE MODE
! WE NEED TWO SETS OF MASKS
!
CONSTLONGINTEGERARRAY PE ERROR MASKS(1:ERROR CLASSES)= C
X'C000000000000000',
X'00E0C608CE000000',
X'0000080000000000',
X'0000300000000000',
X'000000B700000000',
X'0000000000009000',
X'3F1F014031FF6FFF'
CONSTLONGINTEGERARRAY NRZI ERROR MASKS(1:ERROR CLASSES)= C
X'C000000000000000',
X'00E0C640EE000000',
X'0000080000000000',
X'0000300000000000',
X'000000BF00000000',
X'0000000000009000',
X'3F1F010011FF6FFF'
!
! GTS TERTIARY STATUS BITS:
! --- -------- ------ ----
!
! N CLASS MEANING
!
! 0 1 MANUAL
! 1 1 NOT AVAILABLE
! 2-7 7 UNDEFINED
! 8 2 IPE
! 9 2 2*IPE
! 10 2 SRNH
! 11 2 BUFFER ERROR
! 12 2 FORMATTER ERROR
! 13 2 BUFFER PE
! 14-15 7 UNDEF
! 16 2 ILLEGAL COMMAND
! 17 2 ILLEGAL MODE
! 18 4 INCOMPLETE CE BURST
! 19 4 DITTO
! 20 3 REVERSED INTO BT
! 21 2 NO RING FOR WRITE
! 22 2 BUSY
! 23 7 UNDEF
! 24 5 ARA ERROR(GCR)
! 25 7 NRZ ERROR THIS SHOULD ALWAYS QUALIFY OTHER BITS
! IN THE MEDIA BYTE, SO WE DONT EXPECT TO
! SEE IT ALONE. IF WE DO, LOG IT.
! 26 5 UNCORRECTABLE ERROR
! 27 7 UNDEF
! 28 5 DATA CHECK THIS IS 'OR' OF 12 OTHER CONDITIONS.
! IE CRC ERROR SOME OF THEM ARE MORE SEVERE THAN CLASS 5
! WTM CHECK AND ARE SET ELSEWHERE AS WELL, SO WONT ARISE
! LRC ERR(NRZ) HERE. THE REMAINDER ARE ALL CLASS 5. SOME
! MULTI TIE OF THEN APPEAR ELSEWHERE AS WELL, BUT FOUR
! (GCR/PE) CONDITIONS APPEAR ONLY IN STATUS BYTES BEYOND
! 7, SO WE USE THIS TO CATCH THEM. THEY ARE AS
! SHOWN AT LEFT.
! 29 5 END DATA CHECK A29 AND A30 GO TOGETHER TO GIVE:-
! 30 2 PARTIAL RECORD 10=NO PREAMBLE AND 11=NO POSTAMBLE.
! (GCR/PE) WE WOULD LIKE TO TREAT THESE AS CLASS 2 AND
! 5 RESPECTIVELY BUT A30 IS THE WRONG WAY ROUND
! FOR THIS TO WORK ON A 1 BIT MASK BASIS. SO
! IF A29 IS SET, WE INVERT A30 BEFORE MASKING
! 31 5 CRC/ACRC ERROR(NRZ/GCR)
! 32 2 IDENTIFIER ERROR(GCR/PE) NOT SAME AS MTS
! 33 2 NO DATA WRITTEN
! 34 2 CHARACTER IN GAP
! 35 2 VELOCITY ERROR
! 36 2 BLANK TAPE 25' PE/NRZ, 15' GCR
! 37 2 STEP TIMEOUT BYTE 10 HAS REJECT CODES
! 38 2 POOR ERASURE
! 39-47 7 UNDEF
! 48 6 RIPE
! 49 2 INCOMPATIBLE MODE THIS IS SAME AS MTS BIT A32. WE KEEP
! CLOSE CONTROL OF THE MODE SO THIS IS A BUG
! 50 7 UNDEF
! 51 6 STIE(GCR/PE)
! 52 6 MTIE(GCR)
! 53-63 7 UNDEF
!
! BYTES 8-14 HAVE ADDITIONAL INFO, BUT THIS IS EITHER DUPLICATED ABOVE OR
! FOR ADVISORY PURPOSES ONLY AND IS NOT USED IN DIAGNOSIS.
!
! ALTHOUGH THE EXACT INTERPRETATION OF SOME BITS IS MODE DEPENDANT, THERE
! ARE NO DIFFERENCES IN THE RESULTING CLASS ASSIGNMENTS.
! WE ONLE NEED ONE SET OF MASKS THEREFORE.
!
CONSTLONGINTEGERARRAY GTS ERROR MASKS(1:ERROR CLASSES)= C
X'C000000000000000',
X'00FCC602FE004000',
X'0000080000000000',
X'0000300000000000',
X'000000AD00000000',
X'0000000000009800',
X'3F03015001FF27FF'
!
! SINCE ALL POSSIBLE CLASS 5 AND 6 ERRORS ARE MASKED OFF AT THE START
! OF EVERY MULTI-COMMAND READ RETRY CHAIN, EACH SUCH CHAIN CAN
! TERMINATE BEFORE THE LAST COMMAND, ONLY FOR CLASSES 1,2,3 AND 4.
! FOR CLASSES 1 AND 2, POSITION IS ALREADY LOST BY VIRTUE OF THE ERROR,
! SO THE POSITION OF THE FAILING LBE(CW) IS IRRELEVANT. IT LOOKS UNLIKELY
! THAT THE CURRENTLY DEFINED CLASS 4 ERRORS (CONCERNING THE DATA COUNT
! IN CE MODE) COULD ARISE OTHER THAN ON THE PRIMARY READ OF A SEQUENCE,
! BUT IT IS POSSIBLE IF SUCH ERRORS ARE MASKED AT THE DEVICE LEVEL BY
! OTHER ERRORS. IN ANY CASE, TO CATER FOR THE RECLASSIFICATION OF SOME
! BITS, WE ARE PREPARED TO DO A FINAL REPOSITIONING FROM A CLASS 4
! ERROR OCCURRING ANYWHERE THRU' A MULTI-COMMAND READ CHAIN. IN ALL
! CASES, HOWEVER, WE ASSUME THAT THE FAILING LBE(CW) WILL HAVE BEEN
! EFFECTIVE IN TRAVERSING ITS BLOCK.
!
! THE SAME PROBLEM DOES NOT ARISE FOR WRITE AND WRITE TM RETRIES
! WHICH ARE MUCH LESS COMPLEX.
!
!
LONGINTEGER T07
INTEGER I
LONGINTEGERARRAYNAME ERROR MASKS
!
T07=T_T07
IF T_GTS=0 START ; ! MTS DECK
IF T_MODE&3=3 THEN ERROR MASKS==PE ERROR MASKS C
ELSE ERROR MASKS==NRZI ERROR MASKS
FINISHELSESTART
ERROR MASKS==GTS ERROR MASKS
! INVERT A30 IF A29 SET TO GET NO PREAMBLE AND NO POSTAMBLE RIGHT. WE DONT
! EXPECT TO SEE A30 ON ITS OWN BUT IF WE DO,THE EFFECT IS TO GIVE THE MORE SEVERE
! ERROR WHICH IS CORRECT.
T07=T07!!((T07&X'0000000400000000')>>1)
FINISH
!
FOR I=1,1,ERROR CLASSES CYCLE
IF T07&ERROR MASKS(I)#0 THENEXIT
REPEAT
! SO I HAS ERROR CLASS.
RESULT =I
END ; ! FN DIAGNOSE
!
!********* TERMINATE STARTS HERE **********
!
IF REQ_STATE=0 START
REPORT("SPURIOUS TERMINATION")
RETURN
FINISH
IF T_STREAMR1=-1 START ; ! TIMEOUT
REPORT("TIME-OUT")
REP_P2=3
->REPLY
FINISHELSESTART ; ! NOT TIMOUT
IF NORMAL=-1 THEN ->OK(REQ_CHAIN)
! IE ENTERED VIA ATTENTION FOR EXPECTED, NON-PRIVATE, TM OR BT
! CHAINS 16,17,18 AND 0 ONLY.
PSTAT=(T_STREAMR0>>8)&X'FF'
REMBC=T_STREAMR1&X'3FFFF'; ! REMAINING BYTE COUNT.
IF NORMAL=0 START
FINAL COMMAND=CHAIN START(REQ_CHAIN)+CHAIN LENGTH(REQ_CHAIN)-1; ! THE LAST
! REP_P2=0
->OK(REQ_CHAIN) UNLESS REQ_CHAIN=PRIVATE
! OTHERWISE DROP THRU' TO 'REPLY'.
FINISHELSESTART ; ! ABTERM
FINAL COMMAND=CHAIN START(REQ_CHAIN)+T_STREAMR0&X'FF'
! GET GPC SENSE DATA.
! IN DCU CASE, THE H/W SENSE INTO POSTAMBLE IS NOT DONE FOR UNMASKED
! L,S,X,Y, BUT WE DONT NEED IT IN THAT CASE.
IF P_P4&X'FF'=X'80' START ; ! SENSE OK
MOVE(15,D_SENSDATAD+1,ADDR(T_T0))
T_SSTAT=BYTEINTEGER(D_SENSDATAD)
FINISHELSESTART
! EITHER GPC SOFTWARE SENSE FAILED, OR DCU H/W SENSE FAILED
REPORT("NONSENSE")
! NO IDEA WHAT DEVICE STATE IS. MAYBE LOST DEVICE OR POSITION.
REP_P2=3
->REPLY
FINISH
! NOW CHECK FOR CONTROLLER ERRORS
FLAG=(T_STREAMR0>>16)&X'FF'
IF FLAG=X'41' START
REPORT("CDE"); ! THIS IS ACTUALLY ACTIVATE FAILS FOR DCU
! PROBABLY HAVEN'T MOVED TAPE IF IT SHOULD HAVE BEEN. BETTER BAIL OUT
REP_P2=3
->REPLY
FINISHELSEIF FLAG=X'42' START
! THIS CASE ONLY ARISES FOR DCU
REPORT("INITIALISE FAILURE")
REP_P2=3
->REPLY
FINISH
! SO IT MUST BE EITHER U/S OR UNMASKED L,S,X,Y
UNLESS REQ_CHAIN=PRIVATE START ; ! NO DIAGNOSES OR RETRYIES FOR PRIVATE
IF PSTAT&128#0 START ; ! UNSUCCESSFUL
ERROR CLASS=DIAGNOSE
REPORT(USMESS(ERROR CLASS)) UNLESSC
(ERROR CLASS=1 AND T_LOAD STATE=2) ORC
(T_LOAD STATE=3 ANDC
((T_GTS=0 AND T_T4&128#0) ORC
(T_GTS#0 AND T_T6&64#0)))
! DONT REPORT NOTAVAIL OR MANUAL FOR INITIAL REWIND IN LOAD.
! WE EXPECT IT FOR DECKS UNLOADED AT START-UP.
! ALSO SUPPRESS REPORT FOR 'ILLEGAL MODE' WHILE ESTABLISHING IT
! DURING LABEL READ.
->US(ERROR CLASS)
FINISHELSEIF PSTAT&3#0 START ; ! TM OR ET
->TM(REQ_CHAIN)
FINISHELSEIF PSTAT&12#0 START ; ! LONG OR SHORT
REP_P2=1
->LS(REQ_CHAIN)
FINISHELSESTART ; ! WHAT CAUSED IT THEN ????
REPORT("SPURIOUS ABTERM")
REP_P2=3
->REPLY
FINISH
FINISH ; ! NOT PRIVATE. PRIVATE DROPS OUT TO 'REPLY'
FINISH ; ! ABTERM
FINISH ; ! NOT TIMEOUT
!
! CAUTION. DROP THRU' HERE FOR PRIVATE CHAINS
!
REPLY:
IF REQ_CHAIN=PRIVATE START
REP_P3=T_STREAMR0
REP_P4=T_STREAMR1
FINISH
! NOTOINAL P5 AND P6 ALWAYS GO BACK WITH T0-T7
REQ_STATE=0
MYPON(RECORD(ADDR(REP))) IF REP_DEST#0; ! REPLY TO USER IF NOT 'LOAD'
IF T_UNLOAD PENDING#0 START
! ONLY IF STATE IS LOADING OR CLAIMED
T_UNLOAD PENDING=0
T_LOAD STATE=6; ! UNLOAD ENTRY. IF WE WERE ABOUT TO REPLY TO LOAD
! THIS TAKES THE PLACE OF THE REPLY.
REP_DEST=0; ! IF IT WAS A USER WE WANT TO GO TO 'LOAD AS WELL
FINISH
LOAD IF REP_DEST=0
RETURN
!
!
!*********** OK *********** OK *********** OK *********** OK ***********
!
OK(0):
! WE COME HERE VIA 'ATTENTION' AFTER GETTING A REVERSE BT FAILURE AT
! US(5) BELOW, AND THE RESULTING ATTENTION HAS COME.
! THE REPLY IS ALL SET UP.
->REPLY
!
!------------------------------------------------------------------
!
OK(1):OK(2):OK(3):OK(4):OK(5):OK(6):OK(7):OK(8):OK(9):OK(10):; ! ALL READS
LS(1):LS(2):LS(3):LS(4):LS(5):LS(6):LS(7):LS(8):LS(9):LS(10):
! LONG/SHORT ONLY ABTERM. GOES BACK TO USER WITH P2=1 AND P4 LONG/SHORT.
! THE LATTER DISTINGUISHING IT FROM MEDIA ERROR.
!
! ARE WE ON THE RIGHT SIDE OF THE BLOCK
SKIP=REQ_TARGET POS-((POSMASK>>FINAL COMMAND)&1)
! TARGET POS SET IN ACCEPT REQUEST. 2**FINAL LBE(CW) IN POSMASK SET IF THAT
! LBE(CW) LEFT US AFTER BLOCK, ELSE BEFORE.
! SO SKIP=1 MEANS A FORWARD SKIP REQUIRED
! =0 MEANS POSITION CORRECT
! =-1 MEANS A REVERSE SKIP REQUIRED
REP_P3=REQ_LENGTH
IF PSTAT&4#0 START ; ! LONG BLOCK
IF SKIP#0 START
! IT WAS READ IN A DIRECTION OTHER THAN THE ORIGINAL REQUEST. THIS
! CANT BE COUNTED A SUCCESS SINCE WEVE FETCHED THE WRONG END.
! SIMULATE A MEDIA ERROR AND CONTINUE WITH RETRIES.
->US(4)
FINISH
! SO WE READ IN THE RIGHT DIRECTION. TELL USER IT WAS LONG
REP_P4=2
! LENGTH IS CORRECT
FINISHELSEIF PSTAT&8#0 START ; ! SHORT BLOCK
REP_P3=REQ_LENGTH-REMBC; ! LATTER IS UNEXPIRED COUNT
IF (REVMASK>>FINAL COMMAND)&1#0 AND REQ_READORS&NODATA=0 START
! NOT READCHECK AND READ IN REVERSE. DATA IS AT TOP OF BUFFER
REP_P3=-REP_P3; ! INDICATE THIS TO USER
FINISH
REP_P4=1; ! SHORT FOR USER
FINISH
IF REQ_READORS&NODATA#0 AND REP_P2=0 THEN REP_P4=REQ_RETRIES
! 'NO DATA' SET, SO IT WAS A READCHECK. TELL RETRIES.
UNLESS REQ_RETRIES=0 START
IF LENGTH(T_DSN)>7 THEN LENGTH(T_DSN)=0
! MIGHT BE IF WERE IN LOAD SEQUENCE OF NON-STANDARD LABEL
PRINTSTRING(T_MNEM." ".T_DSN." ".HTOS(REQ_RETRIES,3)." READ RETRY OK
")
FINISH
!
! THATS THE REPLY ALL SET UP
TEST FINAL SKIP:
! CAUTION. WE COME HERE FROM US(4) ALSO
IF SKIP=0 THEN ->REPLY
!
! SO FINAL SKIP REQUIRED
! THE ORIGINAL USER'S ASL IS STILL SET UP IN REQ_ADDR ETC, SO NO NEED
! FOR A DUMMY.
DO FINAL SKIP:
! CAUTION*** WE COME HERE FROM TM(1) AND TM(2) ALSO.
IF SKIP>0 THEN REQ_CHAIN=20 ELSE REQ_CHAIN=21
! THESE SKIPS IGNORE TMS
FIRE CHAIN
RETURN
!
!------------------------------------------------------------------
!
OK(11):OK(12):; ! WRITE ,WRITE TM
UNLESS REQ_RETRIES=0 START
REP_P4=REQ_RETRIES
PRINTSTRING(T_MNEM." ".T_DSN." ".HTOS(REQ_RETRIES,3)." WRITE RETRY OK
")
FINISH
->REPLY
!
!------------------------------------------------------------------
!
OK(13):; ! REPOSITION AND ERASE FOR WRITE AND WRITE TM RETRY
! COME HERE FROM TM(13) ALSO
REQ_CHAIN=REQ_FINAL CHAIN; ! SET UP IN 'ACCEPT REQUEST'
! EVERYTHING ELSE REMAINS OK
FIRE CHAIN
RETURN
!
!------------------------------------------------------------------
!
OK(14):OK(15):; ! SKIP BLOCKS, FORE AND AFT
TEST SKIP END:; ! CAUTION. ALSO COME HERE FROM SKIP TM FORE AND AFT
IF T_UNLOAD PENDING#0 START ; ! HOLD HAS BEEN KEYED
REP_P2=3
->REPLY
FINISH
REQ_COUNT=REQ_COUNT+1
IF REQ_COUNT<REQ_SKIPTOT START ; ! NOT FINISHED
IF REQ_CHAIN=16 AND REQ_TM#0 THEN REQ_CHAIN=22; ! TM LOOK-AHEAD
FIRE CHAIN; ! THE SAME ONE AGAIN
RETURN
FINISH
! SO FINISHED
IF REQ_CHAIN=16 AND REQ_TM=0 THEN REQ_TM=1; ! IMPLIED
IF REQ_CHAIN<16 THEN REP_P3=REQ_COUNT ELSE REP_P3=REQ_COUNT*REQ_TM
! BLOCKS TMS (COUNT1 MUST BE =0)
->REPLY
!
!------------------------------------------------------------------
!
OK(16):OK(17):; ! SKIP TMS, FORE AND AFT
IF REQ_STATE=TERM EXP THEN REQ_STATE=ATTN EXP ANDRETURN
! THAT WAS THE TAPE MOVEMENT BEGINNING. WE COME BACK HERE VIA
! ROUTINE ATTENTION WHEN WE HIT TM OR BT.
IF BT#0 START ; ! MUST HAVE NEEN REVERSE
REP_P2=4
REP_P3=REQ_COUNT*REQ_TM+REQ_COUNT1
->REPLY
FINISH
! SO IT WAS A TM
IF REQ_TM=0 THEN ->TEST SKIP END
! SPECIAL FOR RESTORES. IMPLIES 1 TM/LOGICAL FILE AND NO TM LOOK-AHEAD
REQ_COUNT1=REQ_COUNT1+1
IF REQ_COUNT1=REQ_TM START ; ! ONE FILES WORTH
REQ_COUNT1=0
->TEST SKIP END
FINISH
FIRE CHAIN
RETURN
!
!------------------------------------------------------------------
!
OK(18):; ! REWIND
IF REQ_STATE=TERM EXP THEN REQ_STATE=ATTN EXP ANDRETURN
! THAT WAS START OF MOVEMENT. COME BACK VIA ATTN AT BT.
->REPLY
!
!------------------------------------------------------------------
!
OK(19):; ! ERASE
->REPLY
!
!------------------------------------------------------------------
!
OK(20):OK(21):; ! FINAL POSITION SKIP. REPLY ALL SET UP
->REPLY
!
!------------------------------------------------------------------
!
OK(22):; ! TEST FOR TM. SUCCESS MEANS TM NOT SEEN ON REVERSE SKIP
REQ_CHAIN=16; ! REPLACE ORIGINAL CHAIN WHICH WAS SKIP FORE TO TM
FIRE CHAIN
RETURN
!
!------------------------------------------------------------------
!
OK(23):OK(24):OK(25):; ! UNLOAD, SPC, QSPC
->REPLY
!
!
!*********** US *********** US *********** US *********** US ***********
!
! ADMINISTRATIVE SKIPS COME HERE ALSO IF THEY FAIL. THEY SHOULD ONLY APPEAR
! AS CLASSES 1 OR 2.
!
US(1):; ! OFFLINE
! WE GET HERE FOR MANUAL/NOTAVAIL DURING A CHAIN. WE COULD DO THE STATE
! CHANGE HERE, BUT FOR CONSISTENCY WE LEAVE IT TO BE DEALT WITH BY
! 'ATTENTION' WHEN THE STATE CHANGE COMES.
! IN THE MEANTIME THE USER WILL CONTINUE TO GET REPLIES OF 3 FROM HERE
! IF HE PERSISTS.
! DROP THRU' TO .....
!
!------------------------------------------------------------------
!
US(2):; ! LOST POSITION
! CAUTION***. COME HERE FROM US(1) ALSO
REP_P2=3; ! DISASTER
->REPLY
!
!------------------------------------------------------------------
!
US(3):; ! REVERSED INTO BT. READ REV OR SKIP REV ONLY
! THERE IS NOW A BT ATTN TO COME IF NOT GTS
IF REQ_CHAIN=2 OR REQ_CHAIN=15 START
! OK. SET UP REPLY COMPLETELY.
REP_P2=4
IF REQ_CHAIN=15 THEN REP_P3=REQ_COUNT; ! NUMBER SKIPPED BEFORE HERE
FINISHELSESTART
PRINTSTRING(T_MNEM."***UNEXPECTED REV BT ***
")
REP_P2=3; ! WE HAVEN'T CATERED FOR THIS. ALL HELL MAY NOW BREAK LOOSE
FINISH
IF T_GTS=0 START ; ! MTS. SET UP TO WAIT FOR ATTN
REQ_CHAIN=0; ! JUST TO WAIT FOR 'NORMAL' TERM FROM 'ATTENTION'
REQ_STATE=ATTN EXP
RETURN
FINISHELSE ->REPLY
!
!------------------------------------------------------------------
!
US(4):; ! STRAIGHT BACK
! CAUTION***. COME HERE FROM US(5) ALSO
REP_P2=1
IF T_T2&X'30'#0 THEN REP_P4=4; ! BAD CE DATA COUNT
! NOW A FINAL REPOSITION MAY BE REQUIRED IF IT WAS A READ
IF REQ_CHAIN<=LAST READ CHAIN START
SKIP=REQ_TARGET POS-((POSMASK>>FINAL COMMAND)&1)
->TEST FINAL SKIP
FINISH
->REPLY
!
!------------------------------------------------------------------
!
US(5):; ! RETRIABLE
! WE DO NOT EXPECT TO GET CLASS 5 ERRORS OM COMMANDS OTHER THAN READS
! WRITE AND WRITE TM, FOR ALL OF WHICH RETRIES ARE DEFINED (AND FOR
! WHICH THE EMBEDDED SKIPS INVOLVED IN MULTIPLE RETRY CHAINS HAVE
! CLASS 5 ERRORS MASKED OFF). IF THIS INTERPRETATION OF THE ERROR
! BITS IS INCORRECT AND A CLASS 5 ERROR OCCURS ON A STRAIGHT SKIP, REWIND,
! ERASE, ETC. WE WILL LOG IT HERE AND GIVE THE USER A DISASTER(3) REPLY,
! SINCE WE MAY HAVE LOST POSITION. IN THE LIGHT OF EXPERIENCE WE MAY
! HAVE TO RECLASSIFY THE BITS TAKING INTO ACCOUNT THE ACTUAL DEVICE
! COMMAND IN EXECUTION AT FAILURE.
!
IF REQ_CHAIN<=LAST RETRY CHAIN START ; ! ALL THE ONES WE EXPECT
REQ_RETRIES=REQ_RETRIES+1
IF REQ_RETRIES>REQ_RETRY LIMIT START
IF LENGTH(T_DSN)>7 THEN LENGTH(T_DSN)=0
! MIGHT BE FOR LOAD OF NON-STANDARD LABELLED
PRINTSTRING(T_MNEM." UNRECOVERED ERROR ".T_DSN."
")
->US(4)
FINISH
! IE, TEST FOR FINAL SKIP IF READ, OTHERWISE STRAIGHT BACK
IF REQ_CHAIN<=LAST READ CHAIN START
IF REQ_CHAIN=REQ_FINAL CHAIN THEN REQ_CHAIN=REQ_CHAIN-7 C
ELSE REQ_CHAIN=REQ_CHAIN+1
! SET BACK TO START+1, ELSE NEXT IN BASIC SEQUENCE
FINISHELSESTART ; ! WRITE OR WRITE TM
REQ_CHAIN=13; ! SKIP REV AND ERASE WRITTEN LENGTH
FINISH
FIRE CHAIN
RETURN
FINISH
!
! SO WE SHOULDN'T BE HERE.
REP_P2=3
PRINTSTRING(T_MNEM."*** UNEXPECTED RECOVERABLE ERROR ***
"); ! ITS 'REPORTED' ABOVE
->REPLY
!
!------------------------------------------------------------------
!
US(6):; ! ADVISORY ONLY(SHOULD ONLY BE READS)
US(7):; ! UNDEFINED
! HAS BEEN 'REPORTED' ABOVE. TREAT AS SUCCESS OTHERWISE
->OK(REQ_CHAIN)
!
!
!
!*********** TM *********** TM *********** TM *********** TM ***********
!
TM(1):TM(2):; ! READ FORE AND AFT
IF REQ_RETRIES=0 START
! JUST TO MAKE SURE WE ARE ON THE PRIMARY READ OF A SEQUENCE
IF REQ_CHAIN=1 THEN SKIP=-1 ELSE SKIP=1
REP_P2=4
->DO FINAL SKIP
FINISH
! ELSE DROP THRU' TO......
!
!------------------------------------------------------------------
!
TM(3):TM(4):TM(5):TM(6):TM(7):TM(8):TM(9):TM(10):
TM(16):TM(17):TM(18):TM(20):TM(21):TM(23):TM(24):TM(25):
! READ RETRIES,SKIP TM FORE AND AFT,REWIND,POSITIONING SKIPS,
! UNLOAD,SEND PROPS, QUALIFIED SPC
REPORT("UNEXPECTED TM")
REP_P2=3
->REPLY
!
!------------------------------------------------------------------
!
TM(11):TM(12):TM(19):; ! MUST BE ET AFTER WRITE, WRITE TM OR ERASE
! THE WRITE WAS OTHERWISE OK.
REP_P2=4
->REPLY
!
!------------------------------------------------------------------
!
TM(13):; ! ET ON ERASE DURING WRITE(TM) RETRY 'SKIPREV,ERASE'
REP_P2=4; ! THIS REMAINS THE REPLY IF IT FINALLY SUCCEEDS
->OK(13)
!
!------------------------------------------------------------------
!
TM(14):TM(15):; ! SKIP FORE AND AFT
IF REQ_TM#0 THEN ->TEST SKIP END
! IE EXACTLY AS SUCCESS IF TMS TO BE TREATED AS BLOCKS
IF REQ_CHAIN=14 THEN SKIP=-1 ELSE SKIP=1
REP_P2=4
REP_P3=REQ_COUNT
->DO FINAL SKIP
!
!------------------------------------------------------------------
!
! TM(16,17,18) DEFINED AT TM(3) ABOVE
!
!------------------------------------------------------------------
!
! TM(19) DEFINED AT TM(11) ABOVE
!
!------------------------------------------------------------------
!
! TM(20,21) DEFINED AT TM(3) ABOVE
!
!------------------------------------------------------------------
!
TM(22):; ! LOOK-AHEAD FOR TM AFTER SKIP TM FORE. FOUND ONE
REP_P2=4
REP_P3=REQ_COUNT*REQ_TM
->REPLY
!
!------------------------------------------------------------------
!
! TM(23,24,25) DEFINED AT TM(3) ABOVE
!
!------------------------------------------------------------------
!
!*********** LS *********** LS *********** LS *********** LS ***********
!
! LS(1-10) DEFINED AT OK(1) ABOVE
!
!------------------------------------------------------------------
!
LS(11):LS(12):LS(13):LS(14):LS(15):LS(16):LS(17):LS(18):LS(19):LS(20):
LS(21):LS(22):LS(23):LS(24):LS(25):
REPORT("SPURIOUS LONG/SHORT")
REP_P3=3; ! FOR NOW TREAT THIS AS DISASTER SINCE IT SHOULD NEVER HAPPEN
->REPLY; ! AND IF IT DOES THERE MAY BE SOMETHING FUNDAMENTALLY WRONG.
!
!
!
END ; ! ROUTINE TERMINATE
!
!
INTEGERFN ACCEPT REQUEST
!**********************************************************************
! CHECKS USER REQUEST AND REFORMATS IT FOR USE BY 'FIRE CHAIN'.
! SINCE WE'VE GOT HERE WITH T AND REQ MAPPED VIA THE SNO FROM THE USER
! WE KNOW THE DECK IS LOADED AND CLAIMED.
!**********************************************************************
! DEFINED REQUESTS (HISTORICALLY QUAINT) ARE:
! 0=ERASE
! 1=READ
! 2=WRITE
! 3=UNDEF
! 4=READ CHECK
! 5=PRIVATE
! 6=READ REV
! 7=UNDEF
! 8=SKIP BLOCKS
! 9=SKIP TMS
! 10=WRITE TM
! 11-16=UNDEF
! 17=REWIND
CONSTINTEGER TOP REQ=17
CONSTBYTEINTEGERARRAY CHAIN(0:TOP REQ)= C
19,1,11,0,1,PRIVATE,2,0,14,16,12,0(6),18
! THESE ARE THE PRIMARY CHAINS TO EFFECT THE REQUEST.(SEE ARRAYS LBE(CW) ABOVE).
CONSTBYTEINTEGERARRAY FINAL CHAIN(0:TOP REQ)= C
0,9,11,0,9,0,10,0,0,0,12,0(6),0
! THESE ARE THE FINAL CHAINS FOR THOSE WHICH CAN BE RETRIED
!
CONSTINTEGER READMASK=X'52'; ! READ,READ REV,READ CHECK
CONSTINTEGER WRITEMASK=X'405';! WRITE,ERASE,WRITETM
CONSTINTEGER XFERMASK=X'57'; ! ALL READS,WRITE,ERASE
CONSTINTEGER SKIPMASK=X'300'; ! SKIP BLOCK,SKIP TM
CONSTINTEGER SPADDRMASK=X'11'; ! ERASE, READ CHECK
!
INTEGER TYPE,TYPE BIT,CTRL
!
IF SSERIES=YES START
!..........SSERIES.........SSERIES..........SSERIES..........SSERIES
!
INTEGER I
INTEGERNAME LINK
RECORD (TCBF)NAME TCB
FINISH ;!..............................................................
!
INTEGERFN COPY CONTROL BLOCK(INTEGER VADDR,LEN,STL,STB,TOADDR)
!
! VADDR IS THE VIRTUAL ADDR OF THE USER CONTROL BLOCK. THIS IS SUPPOSED
! TO BE IN A LOCKED AREA (DLOCK), AND STL,STB ARE SUPPOSED TO CONTAIN
! THE ST DELIVERED BY THAT DLOCK, IE A VM CONSISTING SOLELY OF LOCKED SPACE.
! WE WISH TO COPY THE CONTROL BLOCK INTO THE DEVICE RECORD.
! SINCE THE USERS LST IS NOT LOCKED WE NEED TO ACCESS THE CONTROL BLOCK VIA
! THIS STB.
! IF WE VALIDATE THE CONTROL BLOCK VIA THE STB AND IT SUCCEEDS, THEN THE
! FORMER MUST BE IN LOCKED SPACE, AND WE CAN PROCEED TO COPY IT WITHOUT FEAR
! OF A VS ERROR. HOWEVER IT IS POSSIBLE THAT THE STB ITSELF IS RUBBISH
! SO TO CHECK THE EXISTENCE OF THE ST ENTRY ADDRESS WHICH THE CONTROL BLOCK
! VALIDATE WILL GO FOR, WE FIRST VALIDATE IT AS A PUBLIC ADDRESS. IF
! THIS SUCCEEDS THEN THE STE ALL EXISTS AND IN THE SAME SMAC. WE CAN
! THEREFORE GO AHEAD WITH THE CONTROL BLOCK VALIDATE WITHOUT FEAR OF A STORE
! TIMEOUT.
! THE CONTROL BLOCK VALIDATE MAY FAIL EITHER IF ITS SEGMENT IS OUTSIDE THE
! SUPPLIED STB LIMIT(EITHER ONE OR BOTH RUBBISH), OR IF THE CONTROL BLOCK IS
! NOT CONTAINED IN THE LOCKED SPACE DEFINED BY THE STB.
! NONE OF THIS GUARANTEES THAT WE ACTUALLY COPY THE USERS CONTROL BLOCK. ALL
! THE ABOVE CHECKS COULD SUCCEED ON GARBAGE ADDRESSES. HOWEVER, WE WILL NOT
! FALL OVER SETTING IT UP, AND WHAT HAPPENS AFTER DEPENDS ON WHAT THE DEVICE
! CONTROLLER MAKES OF THE SUPPOSED CONTROL BLOCK.
RECORDFORMAT COMF(INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, C
DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, C
DCODEDA,SUPLVN,KLOKCORRECT,DATE0,DATE1,DATE2, C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,PROCMON,DQADDR, C
SACPORT,OCPPORT,ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C
BLKADDR,DPTADDR,SMACS,TRANS,LONGINTEGER KMON, C
INTEGER SPDRQ,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C
SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C
COMMSRECA,INTEGERARRAY SP(0:13), INTEGER C
LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C
SDR4,SESR,HOFFBIT,S2,S3,S4,END)
CONSTRECORD (COMF)NAME COM=X'80C00000'
INTEGER VSEG,STEA,LSTL,LSTB,RES,I
LONGINTEGER DR
IF VADDR<0 THEN MOVE(LEN,VADDR,TOADDR) ANDRESULT =0
! IE IT WAS IN PUBLIC SO NO HASSLE
!
VSEG=VADDR&X'7FFC0000'
IF STB&X'F0000000'#0 THENRESULT =1
STEA=STB+(VSEG>>15); ! REAL ADDR OF ST ENTRY
DR=X'1800000881000000'+STEA; ! STE, LENGTH 8 VIA PST
*LD_DR; *VAL_(LNB +1); *JCC_14,<VALID>
RESULT =1; ! VAL GAVE 3, IE INVALID
VALID:
! SO STEA EXISTS. NOW VALIDATE CONTROL BLOCK. FIRST SAVE LSTBR
I=COM_LSTL
*LB_I; *LSS_(0+B ); *ST_LSTL; *LSS_STL; *ST_(0+B )
I=COM_LSTB
*LB_I; *LSS_(0+B ); *ST_LSTB; *LSS_STB; *ST_(0+B )
! NOW DO VALIDATE
RES=1
DR=LEN
DR=X'1800000000000000'!(DR<<32)!VADDR; ! LEN BYTES
*LD_DR; *VAL_(LNB +1); *JCC_3,<RESET LSTBR>
! SO OK.
RES=0
MOVE(LEN,VADDR,TOADDR)
RESET LSTBR:
I=COM_LSTL
*LB_I; *LSS_LSTL; *ST_(0+B )
I=COM_LSTB
*LB_I; *LSS_LSTB; *ST_(0+B )
RESULT =RES
END ; ! FN COPY CONTROL BLOCK
!
! ********** ACCEPT REQUEST STARTS HERE **********
REQ=0
REP=0; ! REPLY RECORD
REP_DEST=P_SRCE
REP_SRCE=P_DEST
REP_P1=P_P1; ! IDENT
!
REQ_LSL=P_P5
REQ_LSTBA=P_P6
!
TYPE=P_P2&X'FF'
IF TYPE>TOP REQ THENRESULT =NOTOK; ! NOT DEFINED
REQ_CHAIN=CHAIN(TYPE)
IF REQ_CHAIN=0 THENRESULT =NOTOK; ! DITTO
IF TYPE=5 START ; ! PRIVATE CHAIN
IF SSERIES=NO START
!........PSERIES..........PSERIES..........PSERIES..........PSERIES
!
! P_P3=VADDR RCB, P5-P6=STL-STB. RCB IS 28 LONG
IF COPY CONTROL BLOCK(P_P3,28,P_P5,P_P6,ADDR(T_RCB))#0 THENRESULT =NOTOK
FINISHELSESTART
!........SSERIES..........SSERIES..........SSERIES..........SSERIES
!
! P_P3=VADDR OF FIRST OF UP TO 6 CHAINED TCBS. P5-P6=STL-STB.
! EACH TCB IS 56 LONG
LINK==P_P3
FOR I=1,1,6 CYCLE
TCB==T_TCBS(I)
IF COPY CONTROL BLOCK(LINK,56,P_P5,P_P6,ADDR(TCB))#0 THENRESULT =NOTOK
LINK=ADDR(TCB)!X'80000000'; ! INTO PREVIOUS
LINK==TCB_NEXT TCB; ! THE USERS LINK TO NEXT
IF LINK=0 THENEXIT ; ! END
REPEAT
UNLESS LINK=0 THENRESULT =NOTOK; ! NOT TERMINATED IN 6
FINISH ;!............................................................
REQ_PRIVATE ATTN=P_P4; ! ATTN DEST
RESULT =OK
FINISH
REQ_FINAL CHAIN=FINAL CHAIN(TYPE)
REQ_RETRY LIMIT=WRITE RETRIES
! THIS IS OVERWRITTEN IF IT IS A READ, AND IRRELEVANT FOR OTHERS
TYPE BIT=1<<TYPE
REQ_LENGTH=P_P2>>16
IF REQ_LENGTH&X'8000'#0 THEN REQ_LENGTH=REQ_LENGTH!X'FFFF0000'
IF REQ_LENGTH=0 THEN REQ_LENGTH=P_P4
CTRL=(P_P2>>8)&X'FF'
IF TYPE BIT&WRITEMASK#0 AND T_PROP3&X'40'#0 THENRESULT =NOTOK; ! NO RING
IF TYPE BIT&XFERMASK#0 START ; ! READ,READREV,READCHECK,WRITE,ERASE
IF TYPE BIT&SPADDRMASK#0 THEN REQ_ADDR=X'81000000' ELSEC
REQ_ADDR=P_P3
! ERASE AND READ CHECK NEED A GENUINE FIXED ADDRESS, FOR CONTROLLER
! CHECKS EVEN WHEN NO DATA XFER.THIS IS START OF REAL CORE MAP IN PS 64.
IF TYPE BIT&READMASK#0 START ; ! READ,READREV,READCHECK
REQ_RETRY LIMIT=READ RETRIES
IF TYPE=4 START ; ! READCHECK
REQ_LENGTH=MAX XFER
! MAX. 256K-1 FOR PSERIES, 64K-1 FOR SSERIES.
REQ_READORS=NODATA ! IGNSHORTLONG(1); ! NO DATA, IGNORE SHORT
REQ_TARGET POS=1
FINISHELSESTART ; ! READ OR READREV
REQ_READORS=IGNSHORTLONG((CTRL>>2)&3); ! IGN NEITHER, SHORT, LONG OR BOTH
IF TYPE=1 THEN REQ_TARGET POS=1 ELSE REQ_TARGET POS=0
! READ READREV
FINISH
FINISH ; ! READMASK
IF CTRL&2#0 THEN REQ_RETRY LIMIT=0
! NO ERROR RECOVERY. NOTE THAT WRITE TM RECOVERY IS NOT AFFECTED.
UNLESS 0<REQ_LENGTH<=MAX XFER THENRESULT =NOTOK
FINISHELSESTART ; ! NOT XFERMASK. IE SKIP BLOCK,SKIP TM,WRITETM,REWIND
! PSERIES:
! A DUMMY ASL REQUIRED FOR ALL THESE WITH LENGTH>0 AND GEN FIXED ADDR.
! HOWEVER, FOR WRITE TM RETRY (SKIPREV, ERASE), THE ERASED
! LENGTH SHOULD BE AT LEAST A TMS WORTH - IE 41 IN PE, 8 IN NRZI.
! SSERIES:
! DUMMY DESCRIPTOR NOT REQUIRED, SINCE ABSENCE OF FIXED BIT IN TCB_STE
! TELLS DCU THAT DESCRIPTOR IS NOT VALID. HOWEVER, AS FOR PSERIES,
! THE WRITE TM RETRY 'ERASE' REQUIRES A SUITABLE LENGTH, AND ITS
! SIMPLER JUST TO DO IT FOR THEM ALL. SKIPS AND REWIND WONT USE IT
! IN 'FIRE CHAIN'.
! FIRST SAVE USER SUPPLIED LENGTH AS THIS IS BLOCKS OR LOGICAL FILES
! FOR SKIP AND SKIP TM RESPECTIVELY.
REQ_SKIPTOT=REQ_LENGTH
REQ_LENGTH=50
REQ_ADDR=X'81000000'
IF TYPE BIT&SKIPMASK#0 START ; ! SKIP BLOCKS, SKIP TMS
IF REQ_SKIPTOT=0 THENRESULT =NOTOK
IF REQ_SKIPTOT<0 THEN REQ_CHAIN=REQ_CHAIN+1 ANDC
REQ_SKIPTOT=-REQ_SKIPTOT
IF TYPE=8 START ; ! SKIP BLOCK
REQ_TM=CTRL&1; ! TREAT TM AS BLOCK
FINISHELSESTART ; ! SKIP TMS
! CTRL IS NUMBER OF TMS/LOGICAL FILE
! ZERO IMPLIES 1/LOGICAL FILE WITH NO TM LOOKAHEAD
REQ_TM=CTRL
FINISH
FINISH
FINISH
RESULT =OK
END ; ! FN ACCEPT REQ
!
!
ROUTINE FIRE CHAIN
!**********************************************************************
! ENTERED WITH REQUEST SET UP IN T_REQ. SPECIFICALLY REQ_CHAIN IS TO
! BE FIRED.
! %IF PSERIES, SETS UP LBES, ALE AND RCB AND TELLS GPC.
! %ELSE, SETS UP TCBS AND TELLS DCU.
!**********************************************************************
CONSTINTEGER READMASK=X'E66EF'; ! 2**N SET IF LBE(CW) IS READ
OWNINTEGER DEST=CONTROLLER+EXEC,SRCE=ME+5,P1,P2,P3=X'11',
P4,P5,P6
INTEGERNAME INITWORD
INTEGER MODE
MODE=T_MODE
IF MODE=0 THEN MODE=PE
! EG A BLANK TAPE BEING REWOUND OR UNLOADED WITHOUT HAVING BEEN CLAIMED.
!
IF SSERIES=NO START
!..........PSERIES..........PSERIES..........PSERIES..........PSERIES
!
INTEGER LBEN,CH START,I
INTEGERNAME LBEWORD
RECORD (RCBF)NAME RCB
RCB==T_RCB
INITWORD==RCB_INITWORD
IF REQ_CHAIN=PRIVATE THEN ->FIRE; ! PRIVATE RCB ALL SET UP
RCB=0; ! ******* CAUTION. PARTLY SET UP ONCE AT ALLOCATE ?
CH START=CHAIN START(REQ_CHAIN)
LBEN=CHAIN LENGTH(REQ_CHAIN)
RCB_LB BYTES=LBEN<<2; ! CAN WE SET THIS TO 4 LBES AT ALLOC REGARDLESS ???
MOVE(RCB_LB BYTES,ADDR(LBES(CH START)),ADDR(T_LBE1))
RCB_LBA=ADDR(T_LBE1); !**** DO THIS ONCE AT ALLOCATE
IF REQ_CHAIN<=LAST READ CHAIN START
FOR I=0,1,LBEN-1 CYCLE
IF (1<<(CH START+I)&READMASK)#0 START ; ! LBE IS READ
! OR IN BITS FOR 'NO DATA','IGNORE SHORT/LONG'
! THE FIRST READ IN MULTIPLE CHAINS ALREADY HAS LONG/SHORT
! MASKED OFF. HOWEVER SINCE WERE DOING THE 'NO DATA' HERE AS
! WELL, WE MUST DO THEM ALL.
LBEWORD==INTEGER(ADDR(T_LBE1)+I<<2)
LBEWORD=LBEWORD ! REQ_READORS
FINISH
REPEAT
FINISH
IF REQ_CHAIN<=LAST RETRY CHAIN THEN T_OPS=T_OPS+1
! COUNT OF NON-POSITIONING OPERATIONS FOR JOURNAL
!
T_ALE1=REQ_LENGTH
T_ALE2=REQ_ADDR
RCB_AL BYTES=8
RCB_ALA=ADDR(T_ALE1); !*** DO THIS ONCE AT ALLOCATE
IF T_ALE2>0 START ; ! LOCAL ADDR FOR DATA. PUT IN LSTB
RCB_LIMFLAGS=REQ_LSL
RCB_LSTBA=REQ_LSTBA
FINISH ; ! ELSE ALL IN PUBLIC. DO WE NEED ANYTHING HERE?
RCB_LIMFLAGS=RCB_LIMFLAGS ! X'8000'; ! INITIALISE BIT IN FLAGS
! TELLS GPC TO USE THE FOLLOWING TO INIT THE DEVICE
INITWORD=(STATMASK(REQ_CHAIN)<<8) ! MODE
! TERTIARY STAT MASK MODE
!
FIRE:
INITWORD=INITWORD ! ((T_PROP2&7)<<24); ! MECHANISM
P1=ADDR(RCB)
FINISHELSESTART
!..........SSERIES..........SSERIES..........SSERIES..........SSERIES
!
CONSTLONGINTEGER NOADDRMASK=X'7DF608800'
CONSTINTEGER PAGE BIT=X'40000000'
OWNBYTEINTEGER ASBYTE=X'10'; ! ADD STATUS LITERAL BYTE
RECORD (TCBF)NAME TCB
INTEGER CWS,CWN,CWB,CH START,I,STAD,STEAD,LEN,ADR
INITWORD==T_TCBS(1)_PREAMBLE(1)
IF REQ_CHAIN=PRIVATE THEN ->FIRE; ! TCBS ALL SET UP
IF REQ_CHAIN<=LAST RETRY CHAIN THEN T_OPS=T_OPS+1
CH START=CHAIN START(REQ_CHAIN)
CWS=CHAIN LENGTH(REQ_CHAIN)
FOR I=1,1,CWS CYCLE
TCB==T_TCBS(I)
TCB=0
CWN=CH START+I-1
TCB_CW=CW(CWN); ! COMMAND WORD
IF (LONG1<<CWN)&NOADDRMASK=0 START
! THIS COMMAND NEEDS A DATA DESCRIPTOR.
! IT MAY ALSO NEED READORS AND BACKWARDS BIT IF READ REVERSE.
LEN=REQ_LENGTH
ADR=REQ_ADDR
IF REQ_CHAIN<=LAST READ CHAIN START
! TRY READORS AND BACKWARD
CWB=1<<CWN
IF CWB&READMASK#0 START ; ! A READ COMMAND
TCB_CW=TCB_CW ! REQ_READORS; ! NODATA AND LONG/SHORT
IF CWB&REVMASK#0 START ; ! REVERSE
TCB_LENGTH=X'04000000'; ! BACKWARDS BIT
ADR=ADR+LEN-1
FINISH
FINISHELSESTART
! ITS IN A READ CHAIN, IE CW 0-19, AND ITS NOT A SKIP
! SINCE NOADDRMASK=0. SO IT MUST BE 'ADD STATUS'.
ADR=ADDR(ASBYTE)
LEN=1
FINISH
FINISH ; ! READ CHAIN
! IF ADDR IS LOCAL, WE HAVE THE REAL ADDRESS OF LST IN REQ_LSTBA
IF ADR>0 THEN STAD=X'81000000'+REQ_LSTBA ELSE STAD=PST VA
! PSTVA IS PUBLIC SEG VA. DEFINED IN CTOPT FILE
STEAD=STAD+((ADR>>15)&X'FFF8'); ! ACTUALLY (>>18&X'1FFF')<<3
! TO YIELD BYTE DISPLACEMNT OF ENTRY
TCB_STE=(INTEGER(STEAD+4)&X'0FFFFFF8')!1; ! REAL ADDR+FIXED BIT
IF INTEGER(STEAD)&PAGE BIT#0 THEN TCB_STE=TCB_STE!2
TCB_LENGTH=TCB_LENGTH!LEN; ! REMENBER BACKWARDS BIT MAY BE THERE
TCB_ADDR=ADR&X'3FFFF'
FINISH ; ! THOSE REQUIRING DATA AREA
UNLESS I=CWS THEN TCB_NEXT TCB=ADDR(T_TCBS(I+1))!X'80000000'
! CHAIN ON THE NEXT ONE
REPEAT
INITWORD=(STATMASK(REQ_CHAIN)<<8)!MODE
! SECONDARY STATUS MODE
!
!
FIRE:
INITWORD=INITWORD!((T_PROP2&7)<<24)
P1=ADDR(T_TCBS(1))
FINISH ;!..............................................................
P2=T_SNO&X'FF'
REQ_STATE=TERM EXP
MYPON(RECORD(ADDR(DEST)))
IF RLEVEL&4#0 THEN DUMPTABLE(61,ADDR(T),TFSIZE)
END ; ! ROUTINE FIRE CHAIN
!
!
!******************* TAPE STARTS HERE **********************************
!
IF KMON&(LONG1<<49)#0 THEN TMON=1 ELSE TMON=0
IF TMON#0 OR RLEVEL&1#0 THEN MON(1,P)
!
ACT=P_DEST&X'FFFF'
IF ACT>64 THEN SNO=ACT AND ACT=1
UNLESS (INITIALISED>0 OR ACT=4) AND 1<=ACT<=13 THEN ->FAULTY P
!
->ACTSW(ACT)
!
REPLY:
P_DEST=P_SRCE
P_SRCE=ME!ACT
MYPON(P)
RETURN
!
!
ACTSW(7):; ! USER RELEASE
SNO=P_P2&X'FFFF'
ACTSW(1):; ! USER REQUEST, SNO SET FROM P_DEST ABOVE.
IF SEARCH TPS(3,SNO,"")=OK START ; ! FOUND SNO AND MAPPED T
REQ==T_REQ
REP==T_REP
IF T_STATE=CLAIMED START ; ! THE DECK REMAINS ACCESSIBLE
IF REQ_STATE=0 START ; ! IDLE
IF ACT=1 START ; ! USER REQUEST
IF ACCEPT REQUEST=OK START ; ! CHECKS OK
FIRE CHAIN; ! REPLY WHEN TERM COMES
RETURN
FINISHELSE P_P4=BAD PARAMS
FINISHELSESTART ; ! USER RELEASE, ACT 7
T_LOAD STATE=6+P_P5<<1; ! IE 6 FOR UNLOAD, 8 FOR RLSE/RWND
LOAD
P_P4=OK
FINISH
FINISHELSE P_P4=BUSY
FINISHELSE P_P4=NOT CLAIMED
FINISHELSE P_P4=SNO NOT FOUND
IF P_P4=OK THEN P_P2=OK ELSE P_P2=REJECT
! ONLY SUCCESSFUL RLSE ALL OTHERS
->REPLY
!
!
ACTSW(2):; ! TERMINATION/ATTENTION FROM CONTROLLER
! P_P1=STREAMR0, _P2=STREAMR1
! P_P3=DEVICE ENTRY ADDRESS
! P_P4=RESPONSE ANAL FLAGS FROM CONTROLLER SENSE IF ORIGINAL REQUEST FAILED
D==RECORD(P_P3)
T==RECORD(D_UA AD)
REQ==T_REQ
REP==T_REP
T_STREAMR0=P_P1
T_STREAMR1=P_P2
I=(P_P1>>20)&15
IF I=1 THEN ATTENTION ELSE TERMINATE(I&7,0)
! IE 0 FOR NORMAL, >0 FOR ABTERM
RETURN
!
!
ACTSW(3):; ! CONTROLLER ALLOCATE/DEALLOCATE REPLIES
! P_P1=0 SUCCESS
! P_P2=SNO (ALLOC ONLY)
! P_P3=DEVICE ENTRY ADDRESS
! P_P6=MNEMONIC(ALLOC ONLY)
D==RECORD(P_P3)
IF P_SRCE&X'FF'=ALLOC START
IF P_P1#OK THENRETURN ; ! ALLOC FAILED. SEE COMMENT AT ACTSW(4)
! SO ALLOCATED OK. SET UP DEVICE RECORD
I=P_P6!X'3000000'; ! STRING MNEM
M=STRING(ADDR(I))
IF SEARCH TPS(1,0,M)=OK START
! IT SHOULDNT ALREADY BE THERE
OPMESS(M." allocate twice?")
RETURN
FINISH
LASTLINK=D_UA AD
T==RECORD(D_UA AD)
T=0
T_GTS=(¬(D_PROPS0>>10))&1; ! 1=GTS, 0=MTS
REQ==T_REQ
REP==T_REP
LASTLINK==T_LINK; ! THIS IS NOW LAST
T_MNEM=M
T_PROP2=P_P6&X'FF'-X'30'; ! MECHANISM FROM MNEM TO DO SEND PROPS
T_SNO=P_P2
! T_STATE=0, NOT AVAILABLE
! T_LOAD STATE=0, READY FOR LOAD
LOAD; ! GET PROPS AND SEE IF ANYTHING LOADED
FINISHELSESTART ; ! DEALLOCATE
IF P_P1#OK START
OPMESS(" Deallocate fails ".HTOS(P_P1,8))
RETURN
FINISH
T==RECORD(D_UA AD)
! DEALLOCS COME VIA VOLUMS WHICH DOESNT ALLOW THEM IF IN USE, SO THERE
! SHOULDNT BE ANY REQUEST OUTSTANDING. WE MIGHT BE IN A LOAD OR UNLOAD
! SEQUENCE BUT THATS IRRELEVANT. NOTHING TO DO BUT UNLINK IT.
M=T_MNEM
I=SEARCH TPS(1,0,M); ! REALLY JUST TO SET UP 'PREVLINK'
IF I#OK START ; ! DEAR DEAR. WHATS HAPPENED?
OPMESS(M." dealloc srch fails?")
RETURN
FINISH
PREVLINK=T_LINK; ! UNLINK IT
! AND RESET LAST IF THIS WAS IT
IF T_LINK=0 THEN LASTLINK==PREVLINK
FINISH
RETURN
!
!
ACTSW(4):; ! ONCE/STREAM FROM CONTROLLER AT STARTUP
! P_P1=BASE MNEMONIC. CONTROLLER CREATES STREAMS FOR THE MAX DECKS FOR THE
! STREAM TYPE IE EITHER 8 OR 4. WE DONT KNOW WHICH TYPE, SO WE DO
! ALLOCATE REQUESTS FOR MAX OF THESE. THE EXCESS WILL FAIL FROM CONTROLLER.
! IN FACT, THE DECKS FOR THOSE SUCCESSFULLY ALLOCATED MAY NOT EXIST,
! BUT WE DONT FIND THAT OUT UNTIL WE GET NOT AVAILABLE AT START OF LOAD.
!
! THIS ENTRY ALSO USED BY VOLUMS TO MODE ON/OFF DECK OR CLUSTER.
!P_P1=BASE MNEMONIC, P2=ON/OFF(1/0), P3=NUMBER OF DECKS
!
IF P_SRCE&X'FF0000'=CONTROLLER START
! INITIALISING CALL
IF INITIALISED=0 START
LASTLINK==FIRSTTP
INITIALISED=1
FINISH
NDECKS=8
MODE=ON
FINISHELSESTART
! VOLUMS
NDECKS=P_P3
MODE=P_P2
FINISH
IF MODE=ON THEN PP_DEST=CONTROLLER!ALLOC C
ELSE PP_DEST=CONTROLLER!DEALLOC
PP_SRCE=ME!3; ! WHERE CONTROLLER REPLIES COME
PP_P2=ME!2; ! WHERE EVENTS ARE NOTIFIED
PP_P1=P_P1; ! BASE MNEM
P_P1=0; ! FOR REPLY TO VOLUMS, SEE BELOW
WHILE NDECKS>0 CYCLE
I=PP_P1!X'3000000'
I=SEARCH TPS(1,0,STRING(ADDR(I))); ! IS IT THERE
IF (MODE=ON AND I=OK) OR (MODE=OFF AND I=NOTOK) THENC
P_P1=P_P1+1 ELSE MYPON(PP)
! IE IF ON AND ALREADY THERE, OR OFF AND NOT THERE, THEN INCREMENT
! COUNT OF 'NOT DONE' FOR VOLUMS. OTHERWISE DO IT
PP_P1=PP_P1+1; ! NEXT MNEM UP
NDECKS=NDECKS-1
REPEAT
IF P_SRCE&X'FF0000'=CONTROLLER THENRETURN
! SO IT WAS VOLUMS. REPLY. P1 ALREADY SET
->REPLY
!
!
ACTSW(5):; ! EXECUTE REQUEST FAILS
! FAILURES ARE P1=1 - SNO OUT OF RANGE, IE UNKNOWN TO CONTROLLER
! =2 - DEVICE NOT READY
! P2=SNO
! P3=DEVICE ENTRY ADDRESS UNLESS P1=1
! THE SNO IN P2 IS ONLY THE BOTTOM BYTE OF OUR FULL ONE(SEE FIRE CHAIN)
! SO WE CANNOT USE IT TO SEARCH FOR TP. FURTHER IF P1=1, CONTROLLER CLEARLY
! DOES NOT GIVE A DEVICE ADDR IN P3, SO WE HAVE NO WAY OF TELLING WHICH
! OF OUR ENTRIES WAS USED TO INITIATE THIS REQUEST
OPMESS("Controller rejects request")
PRINTSTRING("EXECUTE REQUEST FAILS - P1=".HTOS(P_P1,1). C
" P2=".HTOS(P_P2,2))
IF P_P1#1 START ; ! WE CAN LOCATE IT
DUMPTABLE(61,P_P3,TFSIZE)
D==RECORD(P_P3)
T==RECORD(D_UA AD)
REQ==T_REQ
REP==T_REP
IF REQ_STATE#0 START ; ! TELL THE USER OR 'LOAD'
REQ_STATE=0
REP_P2=REJECT
REP_P4=NOT CLAIMED
IF REP_DEST#0 THEN MYPON(RECORD(ADDR(REP))) ELSE LOAD
FINISH
FINISH
RETURN
!
!
ACTSW(6):; ! VOLUMS REPORTING IN
VOLUMS=P_SRCE
I=SEARCH TPS(4,0,""); ! REPORT ALL LOADED TO VOLUMS
RETURN
!
!
! ACTSW(7) DEFINED AT ACTSW(1) ABOVE
!
!
ACTSW(8):; ! SET REPORTING LEVEL
IF P_P1<=7 START
RLEVEL=P_P1
FINISHELSEIF 0<=P_P2<=255 START
IF P_P1=16 START
READ RETRIES=P_P2
FINISHELSEIF P_P1=17 START
WRITE RETRIES=P_P2
FINISH
FINISH
RETURN
!
!
ACTSW(9):; ! SEND FAILURE DETAILS
IF SEARCH TPS(3,P_P1&X'FFFF',"")=OK START
P_P1=0
P_P2=T_STREAMR0
P_P3=T_STREAMR1
MOVE(12,ADDR(T_T0),ADDR(P_P4))
FINISHELSESTART
P_P1=REJECT
P_P4=SNO NOT FOUND
FINISH
->REPLY
!
!
ACTSW(10):; ! DUMP TABLE, SNO IN P1
IF SEARCH TPS(3,P_P1&X'FFFF',"")=OK START
DUMPTABLE(61,ADDR(T),TFSIZE)
FINISH
RETURN
! NO REPLY
!
!
ACTSW(11):; ! DUMMY
RETURN
!
!
ACTSW(12):; ! CLAIM VOLUME
CLAIM VOLUME(P)
! REPLY SET UP
->REPLY
!
!
ACTSW(13):; ! DISPLAY TPS STATUS
I=SEARCH TPS(5,0,"")
RETURN
!
!
FAULTY P:
MON(3,P)
END ; ! ROUTINE TAPE
!
!
ENDOFFILE