!*
RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!*
!* Communications record format - extant from CHOPSUPE 22A onwards *
!*
RECORDFORMAT COMF(INTEGER OCPTYPE,SLIPL,SBLKS,SEPGS,NDISCS,DLVNADDR, C
(INTEGER GPCTABSIZE,GPCA OR INTEGER DCUTABSIZE,DCUA), C
INTEGER SFCTABSIZE,SFCA,SFCK,DIRSITE, C
DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, C
BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, C
NOCPS,RESV2,OCPPORT1,OCPPORT0,INTEGER ITINT,CONTYPEA, C
(INTEGER GPCCONFA OR INTEGER DCUCONFA), C
INTEGER FPCCONFA,SFCCONFA,BLKADDR,RATION, C
(INTEGER SMACS OR INTEGER SCUS), C
INTEGER TRANS,LONGINTEGER KMON, C
INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, C
SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, C
COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, C
MAXCBT,PERFORMAD,SP1,SP2,SP3,SP4,SP5,SP6, C
LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, C
SDR4,SESR,HOFFBIT,BLOCKZBIT,BLKSHIFT,BLKSIZE,END)
!*
IF SSERIES=YES START
RECORDFORMAT DDTFORM(INTEGER C
SER, PTSM, PROPADDR, STICK, CAA, GRCB AD, C
BYTE INTEGER LAST ATTN, DACTAD, HALF INTEGER HALFSPARE, C
INTEGER LAST TCB ADDR, C
STATE,IW1,CONCOUNT, SENSE1, SENSE2, SENSE3, SENSE4, C
REPSNO, BASE, ID, DLVN, MNEMONIC, C
STRING (6) LAB, BYTE INTEGER HWCODE, C
INTEGER ENTSIZE, URCB AD, SENSDAT AD, LOGMASK, UASTE, C
UA SIZE, UA AD, TIMEOUT,PROPS,STATS1,STATS2, C
BYTEINTEGER QSTATE,PRIO,SP1,SP2, C
INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,SLOT)
RECORDFORMAT TCBF(INTEGER CMD,STE,DATA LEN,DATA AD,NEXT TCB,RESP, C
(BYTEINTEGER INIT MECH,INIT CMASK,INIT SMASK,INIT MODE,INIT FN,INIT SEG, C
HALFINTEGER INIT CYL,BYTEINTEGER INIT HEAD,INIT HDLIMIT, C
HALFINTEGER INIT SCYL,INIT SHEAD,BYTEINTEGER INIT SECT,INIT OFFSET C
OR INTEGER PRE0,PRE1,PRE2,PRE3), C
INTEGER POST0,POST1,POST2,POST3,POST4,POST5,POST6,POST7)
CONSTINTEGER DCU SNO=X'300000'
CONSTINTEGER HOLD=X'0100'
CONSTINTEGER MAX TRANS=13; ! + 1 for sense
CONSTINTEGER TCB SIZE=4*18
FINISH ELSE START
RECORDFORMAT DDTFORM(INTEGER SER, PTS, PROPADDR, STICK, CAA, RQA, C
LBA, ALA, STATE, IW1, CONCOUNT, SENSE1, SENSE2, SENSE3, C
SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, C
STRING (6) LAB, BYTEINTEGER MECH, C
INTEGER PROPS,STATS1,STATS2, C
BYTEINTEGER QSTATE,PRIO,SP1,SP2, C
INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,CHFISA)
RECORDFORMAT CCAFORM(INTEGER MARK,PAW,PIW1,PIW2,CSAW1,CSAW2,C
CRESP1,CRESP2,LONGLONGREALARRAY STRMS(0:15))
RECORDFORMAT RQBFORM(INTEGER LSEGPROP, LSEGADDR, LBPROP, C
LBADDR, ALPROP, ALADDR, W6, W7, W8)
OWNINTEGER AUTOLD=0
OWNBYTEINTEGERARRAY PTCA(0:31); ! max=port 1, trunk f
OWNBYTEINTEGERARRAY PTBASE(0:31)=255(32)
CONSTINTEGER MAX DFCS=4; ! max DFCs coped with
OWNBYTEINTEGERARRAY SLOTX(0:16*MAXDFCS)=0(*)
CONSTINTEGER HOLD=X'0800'
FINISH
!*
RECORDFORMAT PROPFORM(INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,C
RQBLKSIZE,LBLKSIZE,ALISTSIZE,KEYLEN,SECTINDX)
!*
RECORDFORMAT LABFORM(BYTEINTEGERARRAY VOL(0:5),BYTEINTEGER S1,C
S2,S3,S4,ACCESS,BYTEINTEGERARRAY RES(1:20),BYTEINTEGER C1,C2,C
AC1,AC2,TPC1,TPC2,BF1,BF2,BYTEINTEGERARRAY POINTER(0:3), C
IDENT(1:14))
!
CONSTBYTEINTEGERARRAY HEXDS(0:15)='0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F'
CONSTINTEGER NORMALT=X'800000',C
ERRT=X'400000',ATTNT=X'100000',DISCSNO=X'00200000', C
PDISCSNO=X'210000'
CONSTINTEGER TRANSIZE=EPAGESIZE*1024
CONSTINTEGER PCELLSIZE=36
CONSTRECORD (COMF)NAME COM=X'80C00000'
OWNBYTEINTEGERARRAYNAME LVN
OWNBYTEINTEGERARRAYFORMAT LVNF(0:99)
RECORDFORMAT PARMXF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK)
OWNRECORD (PARMXF)ARRAYNAME PARM
OWNRECORD (PARMXF)ARRAYFORMAT PARMSPF(0:80); ! must be compatible with CHOPSUPE
!*
EXTERNALLONGINTEGERSPEC KMON
EXTERNALINTEGERSPEC PARMASL,PARMAD
CONSTLONGINTEGER LONGONE=1
OWNINTEGER DIT ADDR,NDISCS
EXTERNALROUTINESPEC DUMPTABLE (INTEGER T,A,L)
EXTERNALROUTINESPEC OPMESS(STRING (63) S)
SYSTEMROUTINESPEC ETOI(INTEGER A,L)
EXTERNALSTRING (8)FNSPEC STRHEX(INTEGER N)
EXTERNALSTRING (8)FNSPEC STRINT(INTEGER N)
EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P)
ROUTINESPEC PDISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC INHIBIT(INTEGER SERV)
EXTERNALROUTINESPEC UNINHIBIT(INTEGER SERV)
EXTERNALROUTINESPEC PTREC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC WAIT(INTEGER MSECS)
EXTERNALROUTINESPEC PKMONREC(STRING (20)TEXT,RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC SEMALOOP(INTEGERNAME SEMA,INTEGER PARM)
EXTERNALROUTINESPEC CONTROLLER DUMP(INTEGER CONTYPE,PT)
EXTERNALROUTINESPEC SLAVES ON OFF(INTEGER MASK)
EXTERNALROUTINESPEC MORE PP SPACE
EXTERNALROUTINESPEC FASTPON(INTEGER CELL)
EXTERNALSTRINGFNSPEC HTOS(INTEGER VALUE,PLACES)
EXTERNALINTEGERFNSPEC NEW PP CELL
EXTERNALINTEGERFNSPEC REALISE(INTEGER PUBVIRTADDR)
!*
EXTERNALROUTINE DISC(RECORD (PARMF)NAME P)
!*
IF SSERIES=YES START
ROUTINESPEC FIRE CHAIN(RECORD (DDTFORM)NAME DDT)
RECORD (TCBF)NAME TCB
FINISH ELSE START
ROUTINESPEC SET PAW(RECORD (CCAFORM)NAME CCA,INTEGER CHFISA,SAW,SRTM)
ROUTINESPEC REINIT DFC(INTEGER SLOT,PART)
ROUTINESPEC STREAM LOG(RECORD (DDTFORM)NAME DDT)
RECORD (RQBFORM)NAME RQB
RECORD (CCAFORM)NAME CCA
INTEGER K,STRM,PIW,PT
FINISH
ROUTINESPEC READ DLABEL(RECORD (DDTFORM)NAME DDT)
ROUTINESPEC LABREAD ENDS
ROUTINESPEC UNLOAD(RECORD (DDTFORM)NAME DDT)
STRING (4) FNSPEC MTOS(INTEGER M)
ROUTINESPEC SENSE(RECORD (DDTFORM)NAME DDT, INTEGER VAL)
ROUTINESPEC DREPORT(RECORD (DDTFORM)NAME DDT,RECORD (PARMF)NAME P)
RECORD (DDTFORM)NAME DDT,XDDT
RECORD (LABFORM)NAME LABEL
CONSTINTEGER AUTO=X'8000',AUTOAVAIL=AUTO!X'400';! bits in attn byte
CONSTINTEGER DEAD=0,CONNIS=1,RLABIS=2,DCONNIS=3,AVAIL=4,PAGTIS=5,C
PAGSIS=6,INOP=7,RRLABIS=8,PTISLOGP=9,PAVAIL=10,PCLAIMD=11,C
PTRANIS=12,PSENIS=13,SPTRANIS=14,RLABSIS=15
CONSTINTEGER RESPX=1<<CONNIS!1<<RLABIS!1<<DCONNIS!1<<PAGTIS! C
1<<PAGSIS!1<<RRLABIS!1<<PTISLOGP!1<<PTRANIS! C
1<<PSENIS!1<<SPTRANIS!1<<RLABSIS
CONSTINTEGER ZXDEV=M'ZX'; ! dummy device
CONSTINTEGER PAGIO=1<<PAGTIS!1<<PAGSIS!1<<PTISLOGP
CONSTINTEGER PRIVIO=1<<PTRANIS!1<<PSENIS!1<<SPTRANIS
CONSTINTEGER PROPLEN=40; ! length of property table
OWNINTEGER INITINH, LABREADS, CURRTICK
INTEGER ACT,I,J,SLOT,PTR,SIW1,SIW2,PTS
STRING (40) S
STRING (6) PREVLAB
SWITCH INACT(0:9), AINT, FINT, NINT(0:15)
ACT=P_DEST&X'FFFF'
IF KMON&(LONGONE<<(DISCSNO>>16))#0 THEN C
PKMONREC("DISC:",P)
IF ACT>=64 THEN ->ACT64
->INACT(ACT)
INACT(0): ! initialisation
RETURN UNLESS NDISCS=0; ! in case initialised twice
NDISCS=COM_NDISCS
DITADDR=COM_DITADDR
LVN==ARRAY(COM_DLVNADDR,LVNF)
PARM==ARRAY(PARMAD,PARMSPF)
INITINH=1
INHIBIT(PDISCSNO>>16)
!
! For P series then:-
!
! Set up two arrays to avoid searching the DDT
! PTCA has the commnctns area public seg no for each controller(as p/t)
! PTBASE has a pointer to SLOTX. SLOTX contains 16 entries
! one for each stream and points to the DDT slot. Thus any disc can
! be found without searching
!
! For S series DCU supplies the slot address
!
IF SSERIES=NO START
I=INTEGER(COM_FPCCONFA)
IF I>MAX DFCS THEN I=MAX DFCS AND C
OPMESS("Too many DFCS for DISC")
FOR J=1,1,I CYCLE
PTBASE(INTEGER(COM_FPCCONFA+4*J)>>24)=16*J
REPEAT
FINISH
FOR J=0,1,NDISCS-1 CYCLE
DDT==RECORD(INTEGER(DITADDR+4*J))
IF SSERIES=YES START
DDT_UASTE=INTEGER(PST VA+4+DDT_UA AD<<1>>19<<3)
DDT_SLOT=J
FINISH ELSE START
PT=DDT_PTS>>4
STRM=DDT_PTS&15
PTCA(PT)<-DDT_CAA>>18; ! to associate ints
SLOTX(PTBASE(PT)+STRM)=J
FINISH
SENSE(DDT,0)
DDT_STATE=CONNIS; ! read vol labels
REPEAT
P_DEST=PDISCSNO
PDISC(P)
IF SSERIES=NO START
CURRTICK=0
P_DEST=X'A0001'; P_SRCE=0
P_P1=DISCSNO+5;P_P2=3; ! int on act 5 every 3 secs
PON(P); ! (but ETC inactive in chopsupe!!!)
FINISH
RETURN
!*
! A disc may be in any one of the following states(held in DDT_STATE):-
! DEAD = 0 = not on line or unloaded
! CONNIS = 1 = connect interface & sense issued
! RLABIS = 2 = read label issued
! DCONNIS = 3 = disconnect (ie unload) issued. must reconnect on termntn
!
! If the label was valid the states then go:=
! AVAIL = 4 = available for paged or private use
! PAGTIS = 5 = paged transfer issued
! PAGSIS = 6 = paged transfer has failed & a sense issued
! INOP = 7 = inoperable awaiting operator reload
! RRLABIS = 8 = reread label issued
! PTISLOGP = 9 = as PAGTIS but read stream log pending
!
! Nonexistent or invald labels then go
! PAVAIL = 10 = available for private use
! PCLAIMD = 11 = claimed for private use by ser=DDT_STATUS
! PTRANIS = 12 = private chain issued
! PSENIS = 13 = private chain has failed & a sense isuued
! SPTRANIS = 14 = special private chain issued (no sense on failure)
! RLABSIS = 15 = read label failed & sense issued
!
INACT(1): ! claim for dedicated use
!
! Input request
! P_P1 = returnable
! P_P2 = service no for replies (o=release -1=unload--no reply)
! P_P3 = slot no or mnemonic or %STRING(6) vol label
!
! Replies
! P_P2 = 0 claim fails else service no for private requests
! P_P3 = slot no
! P_P4 = mnemonic
! P_P5& 6 = %STRING(6) vol label
!
PTR=P_P3; I=PTR
UNLESS 0<=PTR<NDISCS START
FOR I=0,1,NDISCS-1 CYCLE
DDT==RECORD(INTEGER(DITADDR+4*I))
->HIT IF PTR=DDT_MNEMONIC OR DDT_LAB=STRING(ADDR(P_P3))
REPEAT
->CLAIM FAILS
FINISH ELSE DDT==RECORD(INTEGER(DITADDR+4*I))
HIT: ! DDT mapped on right slot
IF P_P2>0 START
IF DDT_STATE=PAVAIL OR (DDT_STATE=AVAIL AND DDT_DLVN<0)START
DDT_STATE=PCLAIMD
DDT_REPSNO=P_P2
->REPLY
FINISH ELSE ->CLAIM FAILS
FINISH ELSE START
IF DDT_STATE#PCLAIMD THEN OPMESS("Bum dev returned") C
AND RETURN
DDT_STATE=PAVAIL; DDT_REPSNO=0
OPMESS(MTOS(DDT_MNEMONIC)." unused")
IF P_P2<0 THEN SENSE(DDT,0) AND DDT_STATE=CONNIS
RETURN
FINISH
REPLY: ! reply to claims only
P_P2=DISCSNO+64+I
P_P3=I
P_P4=DDT_MNEMONIC
STRING(ADDR(P_P5))=DDT_LAB
SEND: P_DEST=P_SRCE
P_SRCE=DISCSNO+1
PON(P)
RETURN
CLAIM FAILS:
P_P2=0; ->SEND
INACT(2): ! paged request(_P1=DDTADDR)
DDT==RECORD(P_P1)
IF DDT_STATE#AVAIL OR P_SRCE&X'FFFF0000'#PDISCSNO THEN ->REJECT
DDT_STATE=PAGTIS; DDT_ID=P_P1
DDT_STICK=CURRTICK
IF SSERIES=YES START
FIRE CHAIN(DDT)
FINISH ELSE START
CCA==RECORD(DDT_CAA)
PT=DDT_PTS
STRM=PT&15; ! real stream no
! SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
J=X'07000000'!(X'8000'>>STRM); ! Do batch request
*LXN_CCA+4
*INCT_(XNB +0)
*JCC_8,<GOTS>
SEMALOOP(CCA_MARK,0)
*LXN_CCA+4
GOTS: *LSS_(XNB +1); ! last paw not cleared
*OR_J; *ST_(XNB +1); ! or batch requests together
*LB_STRM; *MYB_16; *ADB_CCA+4; *LXN_B
*LSS_X'10000024'; *ST_(XNB +8)
*LSS_-1; *LXN_CCA+4; *ST_(XNB +0)
*LSS_PT; *USH_-4; *USH_16
*OR_X'40000800';
*ST_B ; *LSS_1; *ST_(0+B )
FINISH
RETURN
ACT64: ! private chains
!
! Private chaining section
! ======= ======== =======
! The users has set up his chain using the area provided at grope time.
! P_P1 has a returnable ident
! P_P2 inhibit sense if <0
! P_P5&6 LSTBR
!
SLOT=ACT&63
DDT==RECORD(INTEGER(DITADDR+4*SLOT))
IF DDT_STATE#PCLAIMD THEN ->REJECT
!
DDT_REPSNO=P_SRCE
DDT_ID=P_P1; ! save private id
IF P_P2<0 THEN DDT_STATE=SPTRANIS ELSE DDT_STATE=PTRANIS
DDT_STICK=CURRTICK
IF SSERIES=YES START
FIRE CHAIN(DDT)
FINISH ELSE START
CCA==RECORD(DDT_CAA)
RQB==RECORD(DDT_RQA)
RQB_LSEGPROP=P_P5&X'FFFF0000'!X'C000'; ! ACR 0 protem
RQB_LSEGADDR=P_P6
STRM=DDT_PTS&15
SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
FINISH
RETURN
REJECT: ! disc requested rejected
IF DDT_STATE=INOP OR DDT_STATE=RRLABIS START
IF SSERIES=NO THEN CCA==RECORD(DDT_CAA)
->REPLY INOP
FINISH
PKMONREC("*** DISC rejects",P)
P_DEST=P_SRCE
P_P2=-1
P_SRCE=DISCSNO+64+SLOT
PON(P)
RETURN
INACT(4): ! note lvn P_P1 now checked
I=P_P1; J=LVN(I)
IF J>=NDISCS THEN RETURN ; ! crap lvn
DDT==RECORD(INTEGER(DITADDR+4*J))
DDT_DLVN=DDT_DLVN&255
DDT_CONCOUNT=1; ! should be 0 after testing!
RETURN
INACT(5): ! clocktick
! no ETC in chopsupe so can only be PONned from the OPER
! (via DCU for S series)
IF SSERIES=NO START
IF AUTOLD#0 START ; ! a DFC being autoloaded
AUTOLD=AUTOLD-1
IF AUTOLD&255=0 THEN REINIT DFC(AUTOLD>>16,2) AND C
AUTOLD=0
RETURN
FINISH
CURRTICK=CURRTICK+1
FOR J=0,1,NDISCS-1 CYCLE
DDT==RECORD(INTEGER(DITADDR+4*J))
IF CURRTICK-DDT_STICK>2 AND RESPX&1<<DDT_STATE#0 C
THEN ->TOUT
REPEAT
RETURN
TOUT: ! device times out
OPMESS(MTOS(DDT_MNEMONIC)." timed out")
CCA==RECORD(DDT_CAA)
STRM=DDT_PTS&15
IF CCA_PIW1&X'80000000'>>STRM#0 THEN START
OPMESS(MTOS(DDT_MNEMONIC)." missing int PONned")
P_DEST=DISCSNO+3; P_SRCE=0
P_P1=DDT_PTS>>4
PON(P)
RETURN
FINISH
CCA_PAW=0; CCA_MARK=-1
IF DDT_STATE=CONNIS THEN DDT_STATE=DEAD AND RETURN ; ! no retry
SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
WAIT(10)
DDT_STICK=CURRTICK
IF CCA_PAW=0 THEN OPMESS("transfer retried") C
ELSE REINIT DFC(J,1)
FINISH
RETURN
INACT(6): ! read stream log P_P1=bitmask
IF SSERIES=YES THEN PKMONREC("DISC act?",P) ELSE START
I=(-1)>>(32-NDISCS)
P_P1=P_P1&I
PRINTSTRING("
Disc logging information
str response bytes trnfrd seeks srnh woff sker ster corrn")
PRINTSTRING(" strbe hdoff media pagemoves pagefails")
FOR J=0,1,NDISCS-1 CYCLE
IF P_P1&1<<J#0 START
DDT==RECORD(INTEGER(DITADDR+4*J))
IF DDT_STATE=AVAIL THEN STREAM LOG(DDT)
IF DDT_STATE=PAGTIS THEN DDT_STATE=PTISLOGP
FINISH
REPEAT
NEWLINE
P_DEST=P_SRCE; P_SRCE=DISCSNO!6
PON(P) IF P_DEST>0
FINISH
RETURN
IF SSERIES=YES START
INACT(7): ! DCU rejects fire chain
PKMONREC("DISC fire fails:",P); ! should not happen!!
DUMP TABLE(0,P_P3,1304)
RETURN
FINISH
INACT(8): ! transfer in progress when ZX dev awoke
IF SSERIES=YES THEN PKMONREC("DISC act?",P) AND RETURN ELSE START
DDT==RECORD(INTEGER(DITADDR+4*P_P1))
CCA==RECORD(DDT_CAA); ! for CHINT
IF PAGIO&1<<P_P2#0 THEN ->REPLY INOP; ! P_P2 is old DDT_STATE
PT=DDT_PTS>>4
IF PRIVIO&1<<P_P2=0 THEN DDT_STATE=DEAD AND RETURN
P_DEST=DDT_REPSNO
P_SRCE=DISCSNO
DDT_SENSE2=X'80800000'; ! inop
INTEGER(DDT_ALA+132)=DDT_SENSE2
->COM2
FINISH
INACT(9): ! for testing facilities
CONTROLLER DUMP(P_P1,P_P2)
RETURN
INACT(3): ! interrupts
!***********************************************************************
!* Disc interrupt handling sequence *
!***********************************************************************
IF SSERIES=YES START
DDT==RECORD(P_P3)
SLOT=DDT_SLOT
PTS=DDT_PTSM>>8; ! really DCU/stream
SIW1=P_P1
SIW2=P_P2
FINISH ELSE START
PT=P_P1; ! extract port & trunk from int
PTR=PTCA(PT)
IF PTR=0 THEN PRINTSTRING("No DFC on PT ".STRHEX(PT)."?
") AND RETURN
CCA==RECORD(X'80000000'+PTR<<18)
MORE INTS: ! see if any more ints
*LXN_CCA+4
*INCT_(XNB +0)
*JCC_8,<SGOT>; ! get semaphore
SEMALOOP(CCA_MARK,0)
*LXN_CCA+4
SGOT: *LSS_(XNB +2); *ST_PIW
*JAT_4,<CONTINT>
*SHZ_STRM; ! find interupting stream
CCA_PIW1=PIW!!X'80000000'>>STRM
! SIW1=INTEGER(ADDR(CCA_STRMS(STRM))+8)
! INTEGER(ADDR(CCA_STRMS(STRM))+8)=0
! SIW2=INTEGER(ADDR(CCA_STRMS(STRM))+12)
*LB_STRM; *MYB_16; *ADB_CCA+4; *LXN_B
*LSD_(XNB +10); *ST_SIW1
*LSS_0; *ST_(XNB +10)
CCA_MARK=-1
SLOT=SLOTX(PTBASE(PT)+STRM)
PTS=PT<<4+STRM
DDT==RECORD(INTEGER(DITADDR+4*SLOT))
IF DDT_PTS#PTS THEN OPMESS("DISC tables ????")
FINISH
IF SIW1&NORMALT#0 THEN ->NINT(DDT_STATE)
IF SIW1&ERRT#0 THEN ->FINT(DDT_STATE)
IF SIW1&ATTNT#0 AND SIW1&X'1000'=0 THEN ->AINT(DDT_STATE)
CHINT:IF SSERIES=NO AND CCA_PIW1#0 THEN ->MORE INTS
RETURN
IF SSERIES=NO START
CONTINT: ! int from controller or spurious
SIW1=CCA_CRESP1; SIW2=CCA_CRESP2
CCA_CRESP1=0; CCA_MARK=-1
IF SIW1#0 THEN PRINTSTRING("Disc controller int (". C
HTOS(PT,2).") :".STRHEX(SIW1)." ".STRHEX(SIW2)."??
")
RETURN
FINISH
!
NINT(AVAIL):FINT(AVAIL):
NINT(PAVAIL):FINT(PAVAIL):
NINT(PCLAIMD):FINT(PCLAIMD):
NINT(DEAD):FINT(DEAD): ! dead disc terminates?
PRINTSTRING("Disc int (".HTOS(PTS,3).") state ". C
STRINT(DDT_STATE)." ?????
")
->CHINT
NINT(CONNIS): ! sense terminates
IF SSERIES=NO AND DDT_MNEMONIC>>16=ZXDEV START ; ! the kraken wakes!
J=DDT_PROPS
K=M'ED'<<16+HEXDS(J>>20&15)<<8+HEXDS(J>>16&15); ! real mnemonic
FOR I=0,1,NDISCS-1 CYCLE ; ! find old slot
XDDT==RECORD(INTEGER(DITADDR+4*I))
IF XDDT_MNEMONIC=K START
XDDT_MNEMONIC=XDDT_MNEMONIC&X'FFFF'!ZXDEV<<16
DDT_PROPADDR=XDDT_PROPADDR
IF RESPX&1<<XDDT_STATE#0 START ; ! transfer in progress
P_DEST=DISCSNO+8
P_P1=I
P_P2=XDDT_STATE
PON(P); ! fail transfer
XDDT_STATE=INOP
FINISH ELSE START
UNLESS XDDT_STATE=DEAD THEN XDDT_STATE=INOP
FINISH
I=-1; ! slot found
EXIT
FINISH
REPEAT
DDT_MNEMONIC=K
IF I>=0 AND J>>24=X'35' START ; ! no old slot & EDS200
DDT_PROPADDR=DDT_PROPADDR+PROPLEN; ! default is EDS100
FINISH
FINISH
IF SSERIES=YES START
TCB==RECORD(DDT_UA AD+MAXTRANS*TCB SIZE)
DDT_SENSE1=TCB_POST0
DDT_SENSE2=TCB_POST1
DDT_SENSE3=TCB_POST2
DDT_SENSE4=TCB_POST6
FINISH ELSE START
I=DDT_ALA+128
DDT_SENSE1=INTEGER(I)
DDT_SENSE2=INTEGER(I+4)
DDT_SENSE3=INTEGER(I+8)
DDT_SENSE4=INTEGER(I+40)
!
! Reset the RQB so that the pointers point above the false floor
! of the logic block and address list. The false floor conceals a
! sense which is always set up
!
RQB==RECORD(DDT_RQA)
RQB_LBADDR=DDT_LBA
RQB_ALADDR=DDT_ALA
FINISH
I=DDT_PROPS>>24
IF I>X'35' THEN I=1 ELSE I=8
IF DDT_SENSE4&I<<28#0 START
! protem - 'till properties table, etc re-vamped
READ DLABEL(DDT)
LABREADS=LABREADS+1
DDT_STATE=RLABIS
FINISH ELSE DDT_STATE=DEAD
->CHINT
NINT(RRLABIS): ! label on remounted disc read
NINT(RLABIS): ! label read successfully
LABREAD ENDS
IF SSERIES=YES THEN LABEL==RECORD(DDT_UA AD+TCB SIZE) ELSE C
LABEL==RECORD(DDT_ALA+72)
ETOI(ADDR(LABEL),6)
PREVLAB=DDT_LAB
FOR I=0,1,5 CYCLE
BYTEINTEGER(ADDR(DDT_LAB)+1+I)=LABEL_VOL(I)
REPEAT
LENGTH(DDT_LAB)=6
! the following label & base code for S series is protem until
! IPL discs are standardised
IF LABEL_ACCESS=X'C5' C
AND '0'<=LABEL_VOL(4)<='9' AND '0'<=LABEL_VOL(5)<='9' START
FOR I=0,1,3 CYCLE
BYTEINTEGER(ADDR(DDT_BASE)+I)=LABEL_POINTER(I)
REPEAT
S=" EMAS"
I=(LABEL_VOL(4)&X'F')*10+LABEL_VOL(5)&X'F'
IF LVN(I)<254 START
UNLESS SLOT=LVN(I) AND DDT_STATE#RRLABIS THEN ->DUPLICATE
FINISH
IF DDT_STATE=RRLABIS THEN DDT_LAB=PREVLAB AND ->REMOUNT
! wrong disc remounted
LVN(I)=SLOT
DDT_DLVN=I!X'80000000'
DDT_STATE=AVAIL
FINISH ELSE START
IF DDT_STATE=RRLABIS THEN ->REMOUNT;! wrong disc remounted
DDT_BASE=0
DDT_STATE=PAVAIL
DDT_DLVN=-1
S=" frgn"
FINISH
DDT_STATS1=0
DDT_STATS2=0
LOAD MESS:
OPMESS(MTOS(DDT_MNEMONIC)." loaded ".DDT_LAB.S)
->CHINT
DUPLICATE: ! disc with same lvn mounted
! may be remount of reqd disc
! on same or different drive
XDDT==RECORD(INTEGER(DITADDR+4*LVN(I)));! on oldmount slot
UNLESS XDDT_STATE=INOP OR XDDT_STATE=RRLABIS START ;! not awaiting remount
OPMESS("Duplicate disc lvn ")
DDT_DLVN=-1; ! dont clear lvn when unloading
IF SSERIES=YES START ; ! no S/W unload
OPMESS("Unload ".MTOS(DDT_MNEMONIC))
DDT_STATE=DEAD
RETURN
FINISH ELSE START
UNLOAD(DDT)
DDT_STATE=DCONNIS; ->CHINT
FINISH
FINISH
!
! Set up P for PONning to PDISC
!
P_DEST=PDISCSNO+11
P_SRCE=DISCSNO
P_P1=SLOT; ! new slot for lvn
P_P2=LVN(I); ! old slot for lvn(may be same!)
IF P_P1#P_P2 START ; ! reloaded on different drive
DDT_DLVN=XDDT_DLVN; ! copy across vital fields
DDT_STATS1=XDDT_STATS1; ! including fchk & closing bits
DDT_STATS2=XDDT_STATS2
DDT_CONCOUNT=XDDT_CONCOUNT
IF SSERIES=NO AND XDDT_PTS=COM_SLIPL THEN COM_SLIPL=DDT_PTS; ! for auto ipl
! not S series protem
XDDT_STATS1=0; XDDT_STATE=DEAD
XDDT_CONCOUNT=0
LVN(I)=SLOT
FINISH
DDT_STATE=AVAIL
PON(P)
->LOADMESS
FINT(CONNIS): ! sense fails
DDT_STATE=DEAD; ->CHINT
FINT(RLABIS): ! read label fails
LABREAD ENDS
DDT_IW1=SIW1
DDT_SENSE1=SIW2
DDT_STATE=RLABSIS
SENSE(DDT,2)
->CHINT
NINT(RLABSIS):FINT(RLABSIS): ! sense after labread
DDT_LAB="nolabl"
DDT_DLVN=-1
DDT_STATE=PAVAIL
OPMESS(MTOS(DDT_MNEMONIC)." loaded NO LABEL")
DDT_BASE=0
P_DEST=0
->COM1
NINT(DCONNIS):FINT(DCONNIS): ! unload complete
SENSE(DDT,0); ! reconnect interface
DDT_STATE=CONNIS
UNLDED:OPMESS(MTOS(DDT_MNEMONIC)." unloaded")
IF DDT_DLVN#-1 THEN LVN(DDT_DLVN&255)=255
->CHINT
AINT(RLABIS):
LABREAD ENDS
AINT(DEAD):AINT(CONNIS): ! attention while initialising
AINT(RLABSIS):
PRINTSTRING("Attntn while initng ".HTOS(PTS,3)." ". C
STRHEX(SIW1)." ".STRHEX(SIW2)."
")
IF SSERIES=NO START
FOR I=1,1,5000 CYCLE
IF CCA_PIW1&(X'80000000'>>STRM)#0 THEN ->CHINT
REPEAT
FINISH
DDT_STATE=CONNIS
SENSE(DDT,1); ! start sequence again
AINT(DCONNIS): ! extra attention caused by unload
->CHINT
AINT(AVAIL):AINT(PAVAIL): ! attention while idle
AINT(PAGTIS):AINT(PAGSIS):AINT(PTISLOGP): ! attention while paging
IF SIW1&HOLD#0 THEN START ; ! hold was pressed
IF DDT_STATE=PAVAIL OR C
(DDT_STATE=AVAIL AND DDT_CONCOUNT=0) START
! not in system use can unload
IF SSERIES=YES START ; ! no S/W unload
OPMESS("Unload ".MTOS(DDT_MNEMONIC))
! leave _STATE 'till disc goes manual
FINISH ELSE START
UNLOAD(DDT)
DDT_STATE=DCONNIS
FINISH
FINISH ELSE START
OPMESS(DDT_LAB." still needed ".STRINT(DDT_STATE))
FINISH
->CHINT
FINISH
IF SIW1&AUTOAVAIL=AUTOAVAIL START ; ! gratuitous 'auto & available'
PRINTSTRING("Surprise attntn on ".HTOS(PTS,3)." ". C
STRHEX(SIW1)." ".STRHEX(SIW2)."
")
->CHINT
FINISH
!
! If attnt wasnt hold,surprise or log overflow(already dealt with) then it
! must have been not auto or not available. Abandon disc if possible
! otherwise demand it back and wait
!
IF DDT_STATE=PAVAIL OR C
(DDT_STATE=AVAIL AND DDT_CONCOUNT=0) START
DDT_STATE=DEAD
->UNLDED
FINISH
REMOUNT: ! demand reload of demounted disc
OPMESS("Reload ".DDT_LAB." NOW!!!".TOSTRING(17))
DDT_STATE=INOP
->CHINT
AINT(INOP): ! attention while waiting remount
IF SIW1&AUTO#0 START ; ! drive now reloaded
READ DLABEL(DDT); ! check its right disc
LABREADS=LABREADS+1
DDT_STATE=RRLABIS
FINISH
->CHINT
AINT(RRLABIS):
FINT(RRLABIS): ! failed to read label
LABREAD ENDS
OPMESS(MTOS(DDT_MNEMONIC)." label read fails")
->REMOUNT
NINT(INOP):FINT(INOP): ! transfers & senses going when
! disc went inop have now finished
REPLY INOP: ! tell PDISC disc is inop
P_P3=ERRT; ! transfer failed
P_P4=0
P_P5=NORMALT; ! sense worked
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO
DDT_ID=ADDR(DDT)
IF SSERIES=YES START
TCB==RECORD(DDT_UA AD)
TCB_POST0=X'80800000'; ! inop in 2ndry & 3ry status
DDT_SENSE1=X'80800000'
FINISH ELSE START
DDT_SENSE2=X'80800000'
INTEGER(DDT_ALA+132)=DDT_SENSE2
PT=DDT_PTS>>4; ! in case more ints incarea
FINISH
->COM2
NINT(PTRANIS): ! private chain ok
NINT(SPTRANIS): ! special private chain ok
FINT(SPTRANIS): ! special privat chain fails
P_DEST=DDT_REPSNO
P_SRCE=DISCSNO+64+SLOT; ! was 64+STRM ! needs to be slot I think
P_P1=DDT_ID
P_P2=0; ! flag for normal termination
P_P3=SIW1; P_P4=SIW2
PON(P)
DDT_STATE=PCLAIMD
->CHINT
FINT(PTISLOGP): ! page request fails
DDT_STATE=PAGTIS; ! abandon pending logging read
FINT(PAGTIS): ! paged request fails
FINT(PTRANIS): ! private chain fails
DDT_IW1=SIW1
DDT_SENSE1=SIW2
DDT_STATE=DDT_STATE+1
SENSE(DDT,1)
->CHINT
NINT(PTISLOGP): ! page tran ok
IF SSERIES=NO THEN STREAM LOG(DDT); ! deal with pending logging
! request before replying
NINT(PAGTIS): ! paged transfer ok
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO+2
P_P1=DDT_ID
P_P2=0
DDT_STATE=AVAIL
PDISC(P); ! CALL not PON for efficiency
->CHINT
NINT(PAGSIS): ! paged sense ok
FINT(PAGSIS): ! paged sense fails
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO+2
DDT_STATE=AVAIL
->COM1
NINT(PSENIS): ! private sense ok
FINT(PSENIS): ! private sense fails (!???)
P_DEST=DDT_REPSNO
P_SRCE=DISCSNO+64+SLOT; ! was + STRM !
DDT_STATE=PCLAIMD
COM1:
P_P3=DDT_IW1
P_P4=DDT_SENSE1
P_P5=SIW1
IF SSERIES=YES START
TCB==RECORD(DDT_UA AD+MAXTRANS*TCB SIZE)
DDT_SENSDAT AD=ADDR(TCB_POST0)
DDT_SENSE1=TCB_POST0
DDT_SENSE2=TCB_POST1
DDT_SENSE3=TCB_POST2
DDT_SENSE4=TCB_POST6
FINISH ELSE START
I=DDT_ALA+128
DDT_SENSE1=INTEGER(I)
DDT_SENSE2=INTEGER(I+4)
DDT_SENSE3=INTEGER(I+8)
DDT_SENSE4=INTEGER(I+40)
FINISH
COM2: ! inoperable replies join here
!
! If P series then:
! reset the RQB so that the pointers point above the false floor
! of the logic block and address list. The false floor conceals a
! sense which is always set up
!
IF SSERIES=NO START
RQB==RECORD(DDT_RQA)
RQB_LBADDR=DDT_LBA
RQB_ALADDR=DDT_ALA
FINISH
P_P1=DDT_ID
P_P2=1; ! transfer fails
IF SSERIES=YES THEN P_P6=ADDR(DDT_SENSE1)-4 ELSE C
P_P6=ADDR(DDT_SENSE1)
DREPORT(DDT,P)
PON(P) UNLESS P_DEST=0
->CHINT
AINT(PCLAIMD):AINT(PTRANIS):AINT(PSENIS): ! private attentions
P_DEST=DDT_REPSNO; P_SRCE=DDT_SER+64
P_P1=0; P_P2=0
P_P3=SIW1; P_P4=SIW2
PON(P) UNLESS P_DEST=0
RETURN
!*
STRING (4)FN MTOS(INTEGER M)
INTEGER I,J
I=4; J=M
RESULT =STRING(ADDR(I)+3)
END
!*
ROUTINE UNLOAD(RECORD (DDTFORM)NAME DDT)
!***********************************************************************
!* Performs a disconnect interface which unloads the disc *
!* (P series only, no S/W unload on S series *
!***********************************************************************
IF SSERIES=YES START
! %RECORD(TCBF)%NAME TCB
! TCB==RECORD(DDT_UA AD)
! TCB_CMD=X'2C004018'; ! unload ignore shrt & long
! TCB_STE=DDT_UASTE
! TCB_NEXT TCB=0
! TCB_RESP=0
! P_DEST=DCU SNO+12
! P_SRCE=DISC SNO+7
! P_P1=ADDR(TCB)
! P_P2=DDT_SER
! P_P4=M'UNLD'
! PON(P)
FINISH ELSE START
RECORD (RQBFORM)NAME RQB
RECORD (CCAFORM)NAME CCA
INTEGER STRM
STRM=DDT_PTS&15
RQB==RECORD(DDT_RQA)
CCA==RECORD(DDT_CAA)
RQB_W7=X'80001300'
RQB_W8=0
SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
FINISH
END
ROUTINE READ DLABEL(RECORD (DDTFORM)NAME DDT)
!***********************************************************************
!* Reads sector 0 head 0 cyl 0 which should be 80 byte vol label *
!***********************************************************************
IF SSERIES=YES START
RECORD (TCBF)NAME TCB
INTEGER I
TCB==RECORD(DDT_UA AD)
TCB=0
TCB_STE=DDT_UASTE
TCB_INIT SMASK=X'FE'; ! mask nowt
TCB_INIT FN=X'20'; ! restore
TCB_CMD=X'2000C012'
TCB_DATA LEN=80
TCB_DATA AD=DDT_UA AD+TCBSIZE
P_DEST=DCU SNO+12
P_SRCE=DISC SNO+7
P_P1=ADDR(TCB)
P_P2=DDT_SER
P_P4=M'RLAB'
PON(P)
FINISH ELSE START
RECORD (RQBFORM)NAME RQB
RECORD (CCAFORM)NAME CCA
INTEGER LBA,ALA,STRM
LBA=DDT_LBA
ALA=DDT_ALA
STRM=DDT_PTS&15
DDT_STICK=CURRTICK
RQB==RECORD(DDT_RQA)
CCA==RECORD(DDT_CAA)
!
INTEGER(LBA)=X'86000000'; ! chain cww,lit and selecthd
INTEGER(LBA+4)=X'00000A00'; ! read S0
INTEGER(ALA)=X'58000058'; ! 88 bytesof key+data
INTEGER(ALA+4)=ALA+64; ! read into address list space
RQB_W7=X'12001300'; ! seek cyl 0 & do chain
RQB_W8=0; ! seek data (hopefully ignored)
SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
FINISH
END
!*
ROUTINE LABREAD ENDS
!***********************************************************************
!* Called at end of read label to unihibit if needed *
!***********************************************************************
LABREADS=LABREADS-1
IF INITINH=1 AND LABREADS=0 THEN C
INITINH=0 AND UNINHIBIT(PDISCSNO>>16)
END
ROUTINE SENSE(RECORD (DDTFORM)NAME DDT,INTEGER VAL)
!***********************************************************************
!* Perform a sense on device whose DDT slot is DDT.VAL=0 for initial*
!* sense. Sense to be preceeded by a connect stream. *
!* If P series then: *
!* preceed sense by read propcodes (into DDT_PROPS) *
!* a sense is always kept below the false floor in lbloack &alist *
!***********************************************************************
IF SSERIES=YES START
RECORD (TCBF)NAME TCB
TCB==RECORD(DDT_UA AD+MAXTRANS*TCB SIZE)
TCB_CMD=X'2C004004'; ! sense ignore shrt & long
TCB_STE=DDT_UASTE
TCB_DATA LEN=32
TCB_DATA AD=ADDR(TCB_POST0)
TCB_NEXT TCB=0
TCB_RESP=0
P_DEST=DCU SNO+12
P_SRCE=DISC SNO+7
P_P1=ADDR(TCB)
P_P2=DDT_SER
P_P4=M'SNSE'
PON(P)
FINISH ELSE START
RECORD (RQBFORM)NAME RQB
RECORD (CCAFORM)NAME CCA
INTEGER LBA,ALA,STRM
LBA=DDT_LBA-12+4*VAL
ALA=DDT_ALA-16
STRM=DDT_PTS&15
DDT_STICK=CURRTICK
CCA==RECORD(DDT_CAA)
RQB==RECORD(DDT_RQA)
RQB_LBADDR=LBA
RQB_ALADDR=ALA
RQB_W7=X'02001300'; ! do chain
SET PAW(CCA,DDT_CHFISA,X'10000024',STRM)
FINISH
END
!*
IF SSERIES=YES START
!*
ROUTINE FIRE CHAIN(RECORD (DDTFORM)NAME DDT)
RECORD (TCBF)NAME TCB
TCB==RECORD(DDT_UA AD)
P_DEST=DCU SNO+12
P_SRCE=DISC SNO+7
P_P1=ADDR(TCB)
P_P2=DDT_SER
P_P4=M'FIRE'
PON(P)
END
!*
FINISH ELSE START
ROUTINE SET PAW(RECORD (CCAFORM)NAME CCA,INTEGER CHFISA,SAW,STRM)
!***********************************************************************
!* Grab sema and set activation words. Then fire io *
!***********************************************************************
INTEGER PAW
PAW=X'07000000'!(x'8000'>>strm); ! do batch request
*LXN_CCA+4
*INCT_(XNB +0)
*JCC_8,<GOTSEMA>
SEMALOOP(CCA_MARK,0)
GOTSEMA:
CCA_PAW=PAW! cca_paw; ! or multiple batchs together
INTEGER(ADDR(CCA)+32+16*STRM)=SAW
CCA_MARK=-1
! FIRE IO(PTS,1)
*LB_CHFISA; *LSS_1; *ST_(0+B )
END
ROUTINE REINIT DFC(INTEGER SLOT,PART)
!***********************************************************************
!* DFC is dead. Masterclear and move its commsarea from 0 to *
!* the place specified in DDT. Then fire the chain again *
!***********************************************************************
RECORD (DDTFORM)NAME DDT
RECORDFORMAT INITFORM(INTEGER W0,W1,W2,W3,W4)
OWNRECORD (INITFORM) INIT
RECORD (CCAFORM)NAME CCA,CCA0
CONSTINTEGER REAL0ADDR=X'81000000'
OWNINTEGER DUMPS=-1
INTEGER ISA,R,PT
R=0; ! mp not loaded in DFC
DDT==RECORD(INTEGER(DITADDR+4*SLOT))
PT=DDT_PTS>>4
ISA=DDT_CHFISA; ! for channel flags
->PART2 IF PART=2
DUMPS=DUMPS+1
IF DUMPS<=1 START
CONTROLLER DUMP(2,DDT_PTS>>4)
DUMPTABLE(60,DDT_CAA,288);! comms area
DUMPTABLE(61,DDT_LBA,600); ! LBs & address lists
FINISH ELSE START
*LB_ISA; *LSS_2; *ST_(0+B ); ! master clear
FINISH
IF R#X'0080' START ; ! mclear will have started ald
AUTOLD=SLOT<<16!25; ! allow 3*25=75 secs
OPMESS("Trying to AUTOLD DFC")
RETURN
FINISH
WAIT(1000); ! a sec to settle down
PART2:
SLAVESONOFF(0); ! turn off slaves
INIT_W0=((INTEGER(PST VA+PST SEG*8)&X'FFFC'+X'80')//8-1)<<18!X'80000000'
INIT_W1=INTEGER(PST VA+PST SEG*8+4)&X'0FFFFF80'
INIT_W2=DDT_CAA; ! W2 to comms area address
!
! Init W0&W1 have size&base 0f PST. Now set up real0 as commarea
!
CCA0==RECORD(REAL0ADDR)
CCA0_MARK=-1
CCA0_PAW=X'04000000'; ! do controller req
CCA0_CSAW1=X'12000014'; ! 20 bytes of init info
CCA0_CSAW2=REALISE(ADDR(INIT))
*LB_ISA; *LSS_1; *ST_(0+B )
WAIT(5)
IF DUMPS=0 THEN START
DUMPTABLE(64,REAL0ADDR,127)
DUMPTABLE(65,DDT_CAA,127)
FINISH
IF CCA0_PAW=0 THEN OPMESS("DFC reinitialised") AND DUMPS=-1 C
ELSE OPMESS("Failed to AUTOLOAD DFC")
CCA==RECORD(DDT_CAA)
CCA_CRESP1=0; ! delete initialise response
CCA_PAW=0
FOR I=1,1,NDISCS-1 CYCLE
DDT==RECORD(INTEGER(DITADDR+4*I))
IF DDT_PTS>>4=PT AND RESPX&1<<DDT_STATE#0 START
SET PAW(CCA,DDT_CHFISA,X'10000024',DDT_PTS&15)
DDT_STICK=CURRTICK
FINISH
REPEAT
SLAVESONOFF(-1); ! slaves back on
END
ROUTINE STREAM LOG(RECORD (DDTFORM)NAME DDT)
!***********************************************************************
!* Read the stream log for each stream in turn. Waits for response *
!***********************************************************************
RECORD (RQBFORM)NAME RQB
RECORD (CCAFORM)NAME CCA
INTEGER LBA,ALA,STRM,I,J
LBA=DDT_LBA; ALA=DDT_ALA
STRM=DDT_PTS&15
CCA==RECORD(DDT_CAA)
RQB==RECORD(DDT_RQA)
!
INTEGER(LBA)=X'00410200'; ! read stream log
INTEGER(ALA)=X'5800000C'; ! 12 bytes
INTEGER(ALA+4)=ALA+16; ! data into address list
RQB_W7=X'02001300'; ! do stream request
SET PAW(CCA,DDT_CHFISA,X'01000024',STRM)
!
J=ADDR(CCA_STRMS(STRM))+8
I=0
WHILE I<500 CYCLE
WAIT(1)
*LXN_CCA+4
*INCT_(XNB +0)
*JCC_8,<GOTS>
SEMALOOP(CCA_MARK,0)
GOTS:
EXIT IF INTEGER(J)#0
I=I+1
CCA_MARK=-1
REPEAT ; ! until response
!
CCA_MARK=-1
I=INTEGER(J)
INTEGER(J)=0; ! clear response word
NEWLINE; WRITE(STRM,2)
PRINTSTRING(" ".STRHEX(I))
ALA=ALA+16; ! to stream data
WRITE(INTEGER(ALA),10); ! bytes transfered
WRITE(BYTEINTEGER(ALA+4)<<8!byteinteger(ala+5),7);! seeks
J=BYTEINTEGER(ALA+6)
WRITE(J>>4,4); ! SRNHs
WRITE(J&15,4); ! WOFFs
J=BYTEINTEGER(ALA+7)
WRITE(J>>4,4); ! seek errors
WRITE(J&15,4); ! SMAC errs
WRITE(BYTEINTEGER(ALA+8),5); ! data corrns
WRITE(BYTEINTEGER(ALA+9),5); ! strobe offsets
WRITE(BYTEINTEGER(ALA+10),5); ! hd offsets
WRITE(BYTEINTEGER(ALA+11),5); ! media errors
WRITE(DDT_STATS1,9); ! pages transferred
WRITE(DDT_STATS2,9); ! pages that failed to transfer
PRINTSTRING(" ".DDT_LAB)
IF DDT_BASE=X'800' THEN PRINTSTRING(" (IPL VOL)")
DDT_STATS1=0; ! clear out with logging inf
DDT_STATS2=0
END
FINISH
ROUTINE DREPORT(RECORD (DDTFORM)NAME DDT,RECORD (PARMF)NAME P)
!***********************************************************************
!* Prints out a failure report in a readable form *
!***********************************************************************
IF SSERIES=YES START
CONSTINTEGER TCBPSIZE=40; ! bytes of TCB to be dumped
CONSTSTRING (8)ARRAY SENSEM(0:7)="S0T1T2T3","T4T5T6T7",
"T8T9TAC0","C1C2C3C4","C5C6M0M1",
"M2M3M4M5","M6M7M8M9","MAXXXXXX";
RECORD (TCBF)NAME FTCB
INTEGER I,J,N
UNLESS DDT_LAST TCB ADDR=0 THEN FTCB==RECORD(DDT_LAST TCB ADDR) C
ELSE FTCB==RECORD(DDT_UA AD); ! protem?
PRINTSTRING("Disc transfer ".DDT_LAB." on ". C
MTOS(DDT_MNEMONIC)." (".HTOS(DDT_PTSM>>8,6).") fails "C
.STRING(ADDR(COM_DATE0)+3)." ".STRING(ADDR(COM_TIME0)+3))
PRINTSTRING("
TCB response =".HTOS(FTCB_RESP,8)."
sense data
")
FOR I=0,1,7 CYCLE
PRINTSTRING(SENSEM(I)." ".STRHEX(INTEGER(DDT_SENSDAT AD+4*I)))
NEWLINE
REPEAT
PRINTSTRING("
complete chain of TCBs before failure
")
N=(ADDR(FTCB)-DDT_UA AD)//TCBSIZE
FOR J=0,4,TCBPSIZE-4 CYCLE
FOR I=0,1,N CYCLE
PRINTSTRING(HTOS(INTEGER(DDT_UAAD+I*TCBSIZE+J),8))
IF J=0 AND I#N THEN PRINTSTRING("->") ELSE SPACES(2)
REPEAT
NEWLINE
REPEAT
NEWLINE
FINISH ELSE START
CONSTSTRING (3)ARRAY SENSEM(0:11)=" C0"," S0"," T3"," T7",
"T11","T15","T19","T23",
"T27","T31"," M0"," M4";
RECORD (PROPFORM)NAME PROP
INTEGER I,J,K,A0,A1,FLB,AAL,LBE
PROP==RECORD(DDT_PROPADDR)
PRINTSTRING("
&& Disc transfer ".DDT_LAB." on ".MTOS(DDT_MNEMONIC). C
" (".HTOS(DDT_PTS,3).") fails ".STRING(ADDR(COM_DATE0)+3). C
" ".STRING(ADDR(COM_TIME0)+3)."
RESPONSE0 RESPONSE1 FAILURES TRANSFERS
")
PRINTSTRING(" ".STRHEX(P_P3)." ".STRHEX(P_P4))
WRITE(DDT_STATS1>>22,8)
WRITE(DDT_STATS2,9)
PRINTSTRING("
Sense data (RESP=".STRHEX(P_P5).")
")
K=DDT_ALA+128
FOR I=0,1,11 CYCLE
PRINTSTRING(SENSEM(I)." ".STRHEX(INTEGER(K+4*I))."
")
REPEAT
PRINTSTRING("
RQB LBLOCK ADDRESS LIST ID
")
FLB=P_P3&255
I=FLB+2
IF I<8 THEN I=8
FOR J=0,4,4*I CYCLE
IF J<=32 THEN PRINTSTRING(STRHEX(INTEGER(DDT_RQA+J))." ") C
ELSE PRINTSTRING(" ")
LBE=INTEGER(DDT_LBA+J)
PRINTSTRING(STRHEX(LBE))
IF 4*FLB=J THEN PRINTSYMBOL('*') ELSE SPACE
AAL=(LBE&255)*4; ! bytes from start of AL
PRINTSTRING("-> ")
IF AAL<PROP_ALISTSIZE THEN START
A0=INTEGER(DDT_ALA+AAL)
A1=INTEGER(DDT_ALA+AAL+4)
PRINTSTRING(STRHEX(A0).STRHEX(A1)." ")
IF LBE>>8&255=X'69' AND A0=5 AND A1<0 START ;! print id if public
FOR K=0,1,4 CYCLE
PRINTSTRING(HTOS(BYTEINTEGER(A1+K),2))
REPEAT
FINISH
FINISH ELSE PRINTSTRING("not valid")
NEWLINE
REPEAT
NEWLINE
FINISH
END
END
EXTERNALROUTINE PDISC(RECORD (PARMF)NAME P)
!***********************************************************************
!* Receives paged disc transfers. Organises all queuing and *
!* generates the ccws which are the passed to disc for execuition *
!***********************************************************************
IF SSERIES=YES START
RECORD (TCBF)NAME TCB
CONSTINTEGERARRAY CMD(1:4)=X'20408022',X'20408023'(2),X'20408222';
!
! Error recovery consists of making retries with strobe normal,early
! and late and the following head offsets:-
! 0,+12,-12,+24,-24,+36,-36
! this gives 21 additional reads. The first retry in normal as advised
! the array corrn contains mode,function&offset bytes in btm 24 bits
!
CONSTINTEGERARRAY CORRN(0:22)=0,
X'001C00',X'204C00',X'104C00',
X'004C0C',X'204C0C',X'104C0C',
X'004C8C',X'204C8C',X'104C8C',
X'004C18',X'204C18',X'104C18',
X'004C98',X'204C98',X'104C98',
X'004C24',X'204C24',X'104C24',
X'004CA4',X'204CA4',X'104CA4',
X'008C00';
CONSTINTEGER FDS160=X'39'
FINISH ELSE START
RECORD (RQBFORM)NAME RQB
CONSTINTEGERARRAY CCW(1:6)=X'04002202',
X'84002302',X'84002302',X'24002202',X'04002202',
X'84002302';
CONSTINTEGER IGNORELB=X'400000'
FINISH
RECORDFORMAT REQFORM(INTEGER DEST, BYTEINTEGER FAULTS, FLB, C
LLBP1, REQTYPE, INTEGER IDENT, CYLINK, COREADDR, CYL, C
TRKSECT, STOREX, REQLINK)
RECORD (DDTFORM)NAME DDT,XDDT
RECORD (PROPFORM)NAME PROP
RECORD (REQFORM)NAME REQ,ENTRY,NEXTREQ
CONSTINTEGER TRANOK=0, TRANWITHERR=1, TRANREJECT=2, C
NOTTRANNED=3, ABORTED=4
!%ROUTINESPEC QUEUE(%INTEGERNAME QHEAD, %INTEGER REQ,CYL)
SWITCH PDA(0:11)
OWNINTEGER INIT
INTEGERNAME LINK
IF SSERIES=YES START
INTEGER NEXT SEEK,TCBA,SECTINDX,STEAD
CONSTINTEGER RETRIES=21,PAGED=X'40000000',CYCLIC CHECK=X'40'
FINISH ELSE START
INTEGER LBA,ALA,XTRA,CURRHEAD,FIRSTHEAD,FIRST SECT,LBA0,ALA0
CONSTINTEGER RETRIES=7,MAXTRANS=12,CYCLIC CHECK=X'80'
FINISH
INTEGER I,J,K,ACT,UNIT,LUNIT,CYL,TRACK,SECT,CELL,SECSTAT
INTEGER ERRLBE,UNRECOVERED,NEXTCELL,SRCE,FAIL,FLB
!*
ACT=P_DEST&X'FFFF'
IF KMON&(LONGONE<<(PDISCSNO>>16))#0 THEN C
PKMONREC("PDISC:",P)
->PDA(ACT)
PDA(0): ! initialise
IF INIT#0 THEN RETURN ; ! in case!
! no longer anything to do
INIT=1
RETURN
PDA(1): ! read request
PDA(2): ! write request
PDA(3): ! write + check(treated as write)
PDA(4): ! check read
! all have _P2=discaddr and
! _P3 =coreaddr
SRCE=P_SRCE&X'7FFFFFFF'
UNIT=P_P2>>24
J=P_P2&X'FFFFFF'; ! fsys relative page
LUNIT=LVN(UNIT)
->REJECT IF LUNIT>=NDISCS
DDT==RECORD(INTEGER(DITADDR+4*LUNIT))
IF SSERIES=YES START
! _PPERTRK for FDS devices is pages*2/TRACK so double the page no.
! to get correct CYL/TRACK then recalculate SECT from real page no.
K=J
IF DDT_PROPS>>24>=FDS160 THEN J=J*2
FINISH
! PROP==RECORD(DDT_PROPADDR)
! I=J//PROP_PPERTRK
! SECT=J-I*PROP_PPERTRK+1
! CYL=I//PROP_TRACKS
! TRACK=I-CYL*PROP_TRACKS
! %IF CYL>PROP_CYLS %THEN ->REJECT
*LCT_DDT+4
*LXN_(CTB +2); ! XNB to props record
*LSS_J
*IMDV_(XNB +2); ! _PPERTRK
*IMDV_(XNB +0); ! PROP_TRACKS
*ST_CYL
*LB_TOS ; *STB_TRACK;
*LB_TOS ; *ADB_1; *STB_SECT
*ICP_(XNB +1); ! PROP_CYLS
*JCC_2,<REJECT>
IF SSERIES=YES START
! %UNLESS K=J %START; ! recalculate SECT
! SECT=K-K//PROP_PPERTRK*PROP_PPERTRK+1
! %IF SECT>PROP_PPERTRK//2+1 %THEN SECT=SECT-PROP_PPERTRK//2
! %FINISH
*LSS_K; *ICP_J; *JCC_8,<SECTOK>
*IMDV_(XNB +2); *LSS_TOS ; *IAD_1; *ST_SECT
*LSS_(XNB +2); *USH_-1; *ST_J
*IAD_1; *ICP_SECT; *JCC_10,<SECTOK>
*LSS_SECT; *ISB_J; *ST_SECT
SECTOK:
FINISH
!
IF PARMASL=0 THEN MORE PPSPACE
CELL=NEW PPCELL
REQ==PARM(CELL)
P_SRCE=ACT; ! set 3 bytes to 0 also !
REQ<-P
REQ_DEST=SRCE
REQ_CYLINK=0
REQ_CYL=CYL
REQ_TRKSECT=(TRACK<<8!SECT)<<8
REQ_REQLINK=0
IF DDT_QSTATE=0 OR CYL>=DDT_CURCYL THEN START
! QUEUE(DDT_UQLINK,CELL,CYL)
LINK==DDT_UQLINK; *JLK_<QUEUE>
FINISH ELSE START
! QUEUE(DDT_LQLINK,CELL,CYL)
LINK==DDT_LQLINK; *JLK_<QUEUE>
FINISH
->INIT TRANSFER IF DDT_QSTATE=0; ! unit idle
RETURN
REJECT: ! request invalid
PKMONREC("*** PDISC rejects",P)
P_DEST=SRCE
P_SRCE=PDISCSNO+ACT
P_P2=TRANREJECT; ! rejected
PON(P)
RETURN
INIT TRANSFER: ! set up chain and hand to disc
CELL=DDT_UQLINK
REQ==PARM(CELL)
!
! assume all transfers on this cyl will be carried out and arrange
! linking accordingly. Correct linking at repeat if not so
!
DDT_UQLINK=REQ_REQLINK
CYL=REQ_CYL
IF SSERIES=YES START
IF CYL=DDT_CURCYL#0 THEN NEXT SEEK=X'C' ELSE NEXT SEEK=X'1C'
! X'10' = seek cyl
TCBA=DDT_UA AD
PROP==RECORD(DDT_PROPADDR)
SECTINDX=PROP_SECTINDX
FINISH ELSE START
IF CYL=0 THEN XTRA=IGNORELB ELSE XTRA=0
ALA=DDT_ALA
ALA0=ALA
LBA=DDT_LBA
LBA0=LBA
RQB==RECORD(DDT_RQA)
FINISH
!
! The IPL cyl (0) is nonstandard in 2 ways
! firstly it has overflow formats and secondly track 0 has no keys
! disc tries to hide this so that the bulkmover etc can be used
! to move chopsupe to the worksite
!
FLB=0; I=0
CYCLE
NEXTCELL=REQ_CYLINK
IF SSERIES=YES START
TCB==RECORD(TCBA)
TCBA=TCBA+TCBSIZE
TCB=0
TCB_INIT SMASK=X'FE'; ! mask no 2ndry status
TCB_INIT FN=NEXT SEEK; ! seek cyl hd &seg
J=REQ_TRKSECT>>8&255
TCB_INIT SECT=J
TCB_INIT SEG=SECTINDX*EPAGESIZE*(J-1)
J=REQ_TRKSECT>>16
TCB_INIT HEAD=J
TCB_INIT SHEAD=J
TCB_INIT HDLIMIT=1
TCB_INIT CYL=CYL
TCB_INIT SCYL=CYL
IF REQ_FAULTS#0 START ; ! are retrying not transfering
J=CORRN(REQ_FAULTS)
TCB_INIT MODE<-J>>16
TCB_INIT FN<-J>>8
TCB_INIT OFFSET<-J
NEXT SEEK=X'8C'; ! clear offset
FINISH ELSE NEXT SEEK=X'C'; ! is this necessary?
TCB_CMD=CMD(REQ_REQTYPE&255)
STEAD=PST VA+REQ_COREADDR<<1>>19<<3
TCB_STE=INTEGER(STEAD+4)
IF INTEGER(STEAD)&PAGED#0 THEN TCB_STE=TCB_STE!2
TCB_NEXT TCB=TCBA
TCB_DATA AD=REQ_CORE ADDR
TCB_DATA LEN=TRANSIZE
FINISH ELSE START
IF I=0 THEN START
FIRST HEAD=REQ_TRKSECT>>16
CURR HEAD=FIRST HEAD
FIRST SECT=REQ_TRKSECT>>8&255
FINISH ELSE START ; ! select hd§or
J=REQ_TRKSECT>>16; ! head for this transfer
IF J#CURR HEAD OR CYL=0 START
CURR HEAD=J
INTEGER(LBA)=X'86000000'+J; ! select head
LBA=LBA+4
FINISH
K=REQ_TRKSECT>>8&255; ! rotational sector
INTEGER(LBA)=X'86001000'+20*EPAGESIZE*(K-1); ! set sector for k
LBA=LBA+4
FINISH
REQ_FLB=FLB
J=(LBA-LBA0)>>2; ! logic block no for tic
K=(ALA-ALA0)>>2; ! start of relevant bit of alist
INTEGER(LBA)=X'84106900'+K; ! search id =
INTEGER(LBA+4)=X'01000000'+J;! tic to search id
INTEGER(LBA+8)=CCW(REQ_REQTYPE)!XTRA+K
INTEGER(ALA)=5
INTEGER(ALA+4)=ADDR(REQ)+22;! ADDR(REQ_CYL)+2
INTEGER(ALA+8)=TRANSIZE
INTEGER(ALA+12)=REQ_COREADDR
LBA=LBA+12
ALA=ALA+16
FINISH
I=I+1
!
! Move the cell from the request queu to transferinprogress queu
!
REQ_REQLINK=DDT_TRLINK
DDT_TRLINK=CELL
IF SSERIES=YES THEN FLB=(TCBA-DDT_UA AD)>>2 ELSE C
FLB=(LBA-LBA0)>>2
REQ_LLBP1=FLB
CELL=NEXT CELL
!
! See if there any more transfers and if the are on the same cyl
!
IF CELL=0 THEN ->DECHAIN
REQ==PARM(CELL)
EXIT IF I=MAXTRANS
REPEAT
REQ_REQLINK=DDT_UQLINK
DDT_UQLINK=CELL
DECHAIN:
IF I=0 THEN ->DOMORE; ! all aborted choose next cyl
IF SSERIES=YES START
TCB_NEXT TCB=0; ! unchain TCBs
TCB_CMD=TCB_CMD&X'FFBFFFFF'
FINISH ELSE START
! INTEGER(LBA-4)=INTEGER(LBA-4)&X'FBFFFFFF'
*LD_X'18000001FFFFFFFC'; ! one byte/-4
*INCA_LBA; ! to LBA-4
*MVL_L =1,251,0; ! X'FB',0 clear chain bit
RQB_W7=X'1E001300'
RQB_W8=CYL<<16!(20*EPAGESIZE*(FIRST SECT-1))<<8!FIRST HEAD
FINISH
DDT_STATS2=DDT_STATS2+I; ! update transfer count
P_DEST=DISCSNO+2
P_SRCE=PDISCSNO+10
P_P1=ADDR(DDT)
DDT_QSTATE=1
DDT_CURCYL=CYL
DISC(P)
RETURN
PDA(10): ! reply from DISC
DDT==RECORD(P_P1)
CELL=DDT_TRLINK
IF P_P2=0 THEN START ; ! duplicate code for speed
WHILE CELL#0 CYCLE
REQ==PARM(CELL)
J=REQ_REQLINK
INTEGER(ADDR(REQ)+4)=PDISCSNO
REQ_CYLINK=0
FASTPON(CELL)
CELL=J
REPEAT
DDT_TRLINK=0; ! no transfers in progress
DOMORE:
IF DDT_UQLINK=0 THEN DDT_UQLINK=DDT_LQLINK C
AND DDT_LQLINK=0
->INIT TRANSFER IF DDT_UQLINK#0
DDT_QSTATE=0
RETURN
FINISH
DDT_STATS1=DDT_STATS1+1
! update failure count
! whilst avoiding overflow
! see if the following error code works for DCU discs protem
ERRLBE=P_P3&255
SEC STAT=INTEGER(P_P6+4)
UNRECOVERED=1
IF SEC STAT&X'08000000'#0 THEN UNRECOVERED=SEC STAT&X'F7000000'
IF UNRECOVERED=0 THEN ERRLBE=ERRLBE+1
FAIL=NOT TRANNED
IF SEC STAT=X'10000000' AND BYTEINTEGER(P_P6+8)=CYCLIC CHECK C
THEN FAIL=TRANWITH ERR; ! cyclic check only
CYL=DDT_CURCYL
!
! Note recovered errors stop the chain on the non-failing LBE which
! is normally the page transfer LBE. This block has transfered ok
! the next transfers have not been started. Therefore up the LBE count
! by one and refrain from tagging any transfer as having failed
! thus all necessary requeing should be done including the case when
! the recovery is on the search
!
WHILE CELL#0 CYCLE
REQ==PARM(CELL)
DDT_TRLINK=REQ_REQLINK
IF REQ_LLBP1<=ERRLBE OR REQ_FAULTS>RETRIES START
IF REQ_LLBP1<=ERRLBE THEN REQ_CYLINK=TRAN OK ELSE C
REQ_CYLINK=FAIL
IF REQ_CYLINK#0 THEN START
PKMONREC("PDISC transfer fails",P)
FINISH
INTEGER(ADDR(REQ)+4)=PDISCSNO
FASTPON(CELL)
FINISH ELSE START
REQ_CYLINK=0; ! obliterate old cyl link
IF REQ_FLB<=ERRLBE<REQ_LLBP1 AND UNRECOVERED#0 START
REQ_FAULTS=REQ_FAULTS+1
FINISH
! QUEUE(DDT_UQLINK,CELL,CYL)
LINK==DDT_UQLINK; *JLK_<QUEUE>
FINISH
CELL=DDT_TRLINK
REPEAT
IF SEC STAT<0 THEN DDT_QSTATE=2 AND RETURN ;! disc inop
->DOMORE
PDA(11): ! inop disc now operable
DDT==RECORD(INTEGER(DITADDR+4*P_P1))
! current drive
IF P_P1#P_P2 START ; ! is on a different drive
XDDT==RECORD(INTEGER(DITADDR+4*P_P2));! previous drive
DDT_LQLINK=XDDT_LQLINK
DDT_UQLINK=XDDT_UQLINK
XDDT_LQLINK=0
XDDT_UQLINK=0
XDDT_QSTATE=0
FINISH
DDT_TRLINK=0
DDT_CURCYL=0
->DOMORE
!%ROUTINE QUEUE(%INTEGERNAME LINK,%INTEGER CELL,CYL)
!***********************************************************************
!* Queues request in ascending page(ie cyl) order so seek times *
!* are minimised. Prio=0 transfers always go to front however *
!* apart from demand pages at head this is the optimal algorithm *
!* for queues up to 32 in CACM.15.3 mar 1972 pp177 et seq *
!***********************************************************************
!%RECORD(REQFORM)%NAME REQ,ENTRY,NEXTREQ
!%INTEGER NEXTCELL,AD
! REQ==PARM(CELL)
QUEUE:
NEXTCELL=LINK
ENTRY==PARM(NEXTCELL)
!
! Put this transfer at head of the queue if:-
! A) the queue is empty
! B) this transfer lies between current cyl and first transfer.
! this case includes all transfers arriving on current cyl since
! current head posn is kept as trck 0 page 0 of current cyl
IF NEXTCELL=0 OR CYL<ENTRY_CYL START
LINK=CELL
REQ_REQLINK=NEXTCELL; ! prio transfer to front
! %RETURN
*J_TOS
FINISH
CYCLE
->QONCYL IF CYL=ENTRY_CYL
NEXTCELL=ENTRY_REQLINK
EXIT IF NEXTCELL=0
NEXTREQ==PARM(NEXTCELL)
EXIT IF NEXTREQ_CYL>CYL
ENTRY==NEXTREQ
REPEAT
REQ_REQLINK=NEXTCELL
ENTRY_REQLINK=CELL
! %RETURN
*J_TOS
QONCYL:
*LSS_(XNB +3); *LB_CELL
*STB_(XNB +3); *LCT_REQ+4
*ST_(CTB +3)
! REQ_CYLINK=ENTRY_CYLINK
! ENTRY_CYLINK=CELL
*J_TOS
!%END
END
! Bulk mover written by PDS 18th nov 76
!
EXTERNALROUTINE MOVE(RECORD (PARMF)NAME P)
!***********************************************************************
!* Called on service 36 to transfers groups of pages between *
!* fast devices. Replies are on service 37. *
!* Fast device types are:- *
!* dev=1 drum (specified as service & page in amem ) *
!* dev=2 discfile (specified as [mnemonic or lvn] & page) *
!* dev=3 archtape (specified as service(preposnd by VOLUMS)) *
!* dev=4 tape (specified as string(6)lab,byte chap no) *
!* dev=5 funny (reads give zero page,writes in hex to lp) *
!* *
!* Can handle up to four moves at a time. Each move uses *
!* one buffer and apart from clears only has one transfer *
!* outstanding at any one time time. *
!* All writes are checked by re-reading *
!***********************************************************************
INTEGERFNSPEC CHECK(INTEGERNAME MNEM,PAGE,INTEGER RTYEP)
RECORDFORMAT BME(INTEGER DEST,SRCE,STEP,COUNT,FDEV,TODEV,L,C
FDINF1,FDINF2,TODINF1,TODINF2,IDENT,CORE,CDEX,UFAIL,WTRANS, C
FVL1,FVL2,TVL1,TVL2)
!
OWNRECORD (BME)ARRAY BMS(1:4)
RECORD (BME)NAME BM
OWNINTEGER MASK
CONSTINTEGER TAPE POSN=9,FILE POSN=8,WRITE=2,READ PAGE=1
CONSTINTEGER WRITETM=10,MAX TRANS=16,REWIND=17
CONSTINTEGER REQSNO=X'240000',PRIVSNO=X'250000',MAXMASK=X'1E', C
GETPAGE=X'50000',RETURNPAGE=X'60000', C
CLAIM TAPE=X'31000C',RELEASE TAPE=X'310007', C
COMREP=X'3E0001'
!
INTEGER I,INDEX,FILE,SNO,FAIL
SWITCH STEP(1:12)
!
IF KMON&(LONGONE<<(P_DEST>>16))#0 THEN PKMONREC("MOVE:",P)
IF P_DEST>>16=PRIVSNO>>16 START ; !name mnem,pagereply
INDEX=P_DEST&255
IF 1<<INDEX&MASK=0 THEN START ; ! this slot not in use!
PRINTSTRING("Move rejects :- ")
PTREC(P); RETURN
FINISH
BM==BMS(INDEX)
FAIL=P_P2
->STEP(BM_STEP)
FINISH
!
! This the the entry for a new request
!
FOR INDEX=1,1,4 CYCLE
IF MASK&1<<INDEX=0 THEN EXIT
REPEAT
BM==BMS(INDEX)
MASK=MASK!1<<INDEX
IF MASK=MAXMASK THEN INHIBIT(REQSNO>>16);! all buffers in use
BM_DEST=P_DEST
BM_SRCE=P_SRCE
BM_FDEV=P_P1>>24
BM_TODEV=P_P1>>16&255
BM_L=P_P1&X'FFFF'
BM_FDINF1=P_P2
BM_FDINF2=P_P3
BM_TODINF1=P_P4
BM_TODINF2=P_P5
BM_IDENT=P_P6
BM_COUNT=0; BM_STEP=0
BM_UFAIL=0; BM_FVL1=0; BM_FVL2=0
BM_WTRANS=0; BM_TVL1=0; BM_TVL2=0
IF BM_FDEV=2 AND CHECK(BM_FDINF1,BM_FDINF2,READPAGE)#0 C
THEN ->REQFAIL
IF BM_TODEV=2 AND CHECK(BM_TODINF1,BM_TODINF2,WRITE)#0C
THEN ->REQFAIL
IF BM_TODEV=3 AND (BM_TODINF2>2 OR BM_TODINF2<0) C
THEN ->REQFAIL; ! 0,1,or 2 tmarks only allowed
P_DEST=GETPAGE; ! request one (extended) page
BM_STEP=0
PONIT:P_SRCE=PRIVSNO!INDEX
BM_STEP=BM_STEP+1
PON(P)
RETURN
STEP(1): ! core page from core allot
BM_CDEX=P_P2; ! core index no(for returning)
BM_CORE=P_P4
IF BM_FDEV=5 THEN START
FOR I=BM_CORE,8,BM_CORE+TRANSIZE-8 CYCLE
LONGINTEGER(I)=0
REPEAT
FINISH
! core got by hook or by crook
->FDEVPOSD UNLESS BM_FDEV=4; ! unless a mag tape
!
! Code here to claim the input tape and put its service no in INF1
!
IF BM_FDINF1>>24#0 START ; ! tape label not service no
P_DEST=CLAIM TAPE
P_P2=X'00040001'; ! tape for reading
P_P3=BM_FDINF1; P_P4=BM_FDINF2; P_P6=0
BM_FVL1=BM_FDINF1; BM_FVL2=BM_FDINF2;! remember for release
BM_STEP=1; ->PONIT
STEP(2): ! reply from claim tape
IF P_P2#0 THEN ->POSFAIL
BM_FDINF1=P_P3; ! service no for tape
BM_FDINF2=BM_FDINF2&255; ! chapter no of file
FINISH
SNO=BM_FDINF1
BM_STEP=2
FILE=BM_FDINF2&255
TAPEPOS: ! tape position to 'FILE'
P_DEST=SNO
P_P1=FILE; ! ident for later
P_P2=REWIND
->PONIT; ! skip back to BT
STEP(3): ! from tape at BT
STEP(6): ! to tape at BT
->POSFAIL UNLESS FAIL=4 OR FAIL=0
P_DEST=P_SRCE
P_P2=P_P1<<16!1<<8!TAPE POSN
->PONIT; ! skip forward n files
STEP(4): ! fromtape at right file
->POSFAIL UNLESS FAIL=0
!
! This bulk mover moves tape chapters only
!
FDEVPOSD:
->POSCOMPLETE UNLESS BM_TODEV=4; ! oput tape needs positioning
!
! Code here to claim the output tape
!
IF BM_TODINF1>>24#0 START ; ! tape given as label not sno
P_DEST=CLAIM TAPE
P_P2=X'00040002'; ! tape for writing
P_P3=BM_TODINF1; P_P4=BM_TODINF2; P_P6=0
BM_TVL1=BM_TODINF1; BM_TVL2=BM_TODINF2
BM_STEP=4; ->PONIT
STEP(5): ! reply from claim output tape
IF P_P2#0 THEN ->POSFAIL
BM_TODINF1=P_P3
BM_TODINF2=BM_TODINF2&255; ! chapter no
FINISH
SNO=BM_TODINF1
FILE=BM_TODINF2&255
BM_STEP=5
->TAPEPOS
STEP(7): ! both devices positoned
->POSFAIL UNLESS FAIL=0
POSCOMPLETE:
READ PG:
BM_COUNT=BM_COUNT+1
IF BM_FDEV#5 THEN START ; ! not from a zero page
P_DEST=BM_FDINF1
P_P3=BM_CORE
IF BM_FDEV=3 OR BM_FDEV=4 THEN START
P_P2=TRANSIZE<<16!READ PAGE
FINISH ELSE START
P_P2=BM_FDINF2-1+BM_COUNT
FINISH
BM_STEP=7
P_P1=BM_COUNT
->PONIT
FINISH ELSE FAIL=0
STEP(8): ! page read
->READ FAIL UNLESS FAIL=0
IF BM_TODEV#5 THEN START
CYCLE
P_DEST=BM_TODINF1
P_SRCE=PRIVSNO!INDEX
BM_STEP=8
P_P3=BM_CORE
IF BM_TODEV=4 OR BM_TODEV=3 THEN START
P_P2=TRANSIZE<<16!WRITE
FINISH ELSE START
P_P2=BM_TODINF2-1+BM_COUNT
FINISH
P_P1=BM_COUNT
PON(P)
BM_STEP=9
BM_WTRANS=BM_WTRANS+1
RETURN IF BM_FDEV#5 OR BM_WTRANS>=MAX TRANS OR C
BM_COUNT>=BM_L
BM_COUNT=BM_COUNT+1
REPEAT
FINISH ELSE DUMPTABLE(34,BM_CORE,TRANSIZE)
STEP(9): ! page written
BM_WTRANS=BM_WTRANS-1 UNLESS BM_TODEV=5
->WRITEFAIL UNLESS FAIL=0
->READ PG IF BM_COUNT<BM_L AND BM_UFAIL=0
RETURN UNLESS BM_WTRANS=0
!
STEP(10): !first TM write
P_DEST=BM_TODINF1
P_P1=M'BMTM'
P_P2=WRITE TM
IF BM_TODEV=3 AND BM_TODINF2#0 START ;! arch tape needs TM?
BM_STEP=BM_STEP+2-BM_TODINF2; ! one or two TMs
->PONIT
FINISH
->PONIT IF BM_TODEV=4
STEP(11): !both TMs written
WAYOUT: !deallocate core
RETURN UNLESS BM_WTRANS=0
P_DEST=RETURN PAGE
P_SRCE=0; ! reply not wanted
P_P2=BM_CDEX
PON(P); !return core
P_DEST=RELEASE TAPE
P_SRCE=COMREP
IF BM_FDEV=4 AND BM_FVL1#0 START
P_P2=X'00040000'!BM_FDINF1&X'FFFF'
P_P3=BM_FVL1; P_P4=BM_FVL2; P_P5=1
PON(P); ! release from tape
FINISH
IF BM_TODEV=4 AND BM_TVL1#0 START
P_P2=X'00040000'!BM_TODINF1&X'FFFF'
P_P3=BM_TVL1; P_P4=BM_TVL2; P_P5=1
PON(P); ! release output tape
FINISH
REPLY: !set up reply
P_DEST=BM_SRCE
P_SRCE=REQSNO
P_P1=BM_UFAIL
P_P2=BM_IDENT
PON(P); !reply to request
IF MASK=MAXMASK THEN UNINHIBIT(REQSNO>>16)
MASK=MASK!!1<<INDEX
RETURN
REQFAIL: ! fault with request
BM_UFAIL=-2
->REPLY
POSFAIL: ! unable to pos tape
BM_UFAIL=-3
->WAYOUT
READFAIL: ! unable to read
IF BM_UFAIL=0 THEN C
BM_UFAIL=READPAGE<<24!P_P1!FAIL<<16
->WAYOUT
WRITEFAIL: ! unable to write page
IF BM_UFAIL=0 THEN C
BM_UFAIL=WRITE<<24!P_P1!FAIL<<16
->WAYOUT
!
INTEGERFN CHECK(INTEGERNAME MNEM,PAGE,INTEGER RTYPE)
!***********************************************************************
!* Checks a disc id vor validity & availability *
!***********************************************************************
RECORD (DDTFORM)NAME DDT
INTEGER I,L,V1,V2
L=6; V1=MNEM; V2=PAGE
FOR I=0,1,NDISCS-1 CYCLE
DDT==RECORD(INTEGER(DITADDR+4*I))
IF (DDT_MNEMONIC=MNEM OR STRING(ADDR(L)+3)=DDT_LABOR C
MNEM=DDT_DLVN) AND 4<=DDT_STATE<=7 THEN START
MNEM=PDISCSNO!RTYPE
PAGE=PAGE&X'FFFF'!DDT_DLVN<<24
RESULT =0
FINISH
REPEAT
RESULT =1
END
END
ENDOFFILE