!*
!* GPC/DCU driver
!*
CONSTSTRING (26) VSN=".GDC03 - 3rd April 1985"
OWNINTEGER IVSN=M'GDC3'
!*
RECORDFORMAT PARMF(INTEGER DEST,SRCE,(INTEGER P1,P2,P3,P4,P5,P6 OR C
STRING (23)TEXT))
!*
!*
!* 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)
CONSTRECORD (COMF)NAME COM=X'80000000'!48<<18
!*
EXTERNALINTEGERFNSPEC REALISE(INTEGER VAD)
EXTERNALROUTINESPEC PON(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC SLAVESONOFF(INTEGER I)
EXTERNALROUTINESPEC GET PSTB(INTEGERNAME PSTL,PSTB)
EXTERNALROUTINESPEC SEMALOOP(INTEGERNAME SEMA,INTEGER PARM)
EXTERNALROUTINESPEC WAIT(INTEGER MILLSECS)
EXTERNALROUTINESPEC DUMPTABLE(INTEGER T,A,L)
EXTERNALROUTINESPEC PKMONREC(STRING (20)TXT,RECORD (PARMF)NAME P)
EXTERNALSTRINGFNSPEC HTOS(INTEGER I,PL)
EXTERNALSTRINGFNSPEC STRINT(INTEGER N)
EXTERNALROUTINESPEC OPMESS(STRING (63)S)
SYSTEMROUTINESPEC MOVE(INTEGER L,F,T)
IF MULTI OCP=YES START
EXTERNALROUTINESPEC RESERVE LOG
EXTERNALROUTINESPEC RELEASE LOG
FINISH
IF SSERIES=NO START
INTEGERFNSPEC GPC INIT(INTEGER CAA,PT,FLAG)
RECORDFORMAT CASEF(INTEGER SAW0,SAW1,RESP0,RESP1)
RECORDFORMAT CAF(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1,CRESP0,CRESP1, C
RECORD (CASEF)ARRAY STREAM(0:14))
CONSTINTEGER DO CONTROLLER REQUEST=X'04000000'
FINISH
!*
CONSTINTEGER ABNORMAL TERMINATION=X'00400000'
CONSTINTEGER ATTENTION=X'00100000'
CONSTINTEGER CONTROLLER DETECTED ERROR=X'00410000'
CONSTINTEGER DISCONNECTED=5
CONSTINTEGER ENDLIST=255
CONSTINTEGER FE=14
CONSTINTEGER LOID=X'6E'
CONSTINTEGER LP=6
CONSTINTEGER MT=5
CONSTINTEGER MNMASK=X'FFFF30'
CONSTINTEGER NORMAL TERMINATION=X'00800000'
CONSTINTEGER NOT ALLOCATED=0
CONSTINTEGER OK=0
CONSTINTEGER OP=8
CONSTINTEGER QUEUED=4
CONSTINTEGER READY=1
CONSTINTEGER REQUEST FIRED=2
CONSTINTEGER SLOT SIZE=32
CONSTINTEGER SU=13
CONSTINTEGER TICK INTERVAL=2
constinteger timed out=6
CONSTINTEGER ZX=11
!*
OWNBYTEINTEGERARRAYFORMAT BIFT(0:1023)
OWNINTEGERARRAYFORMAT IFT(0:1023)
!*
OWNINTEGER SETUP=NO
OWNINTEGER GDCT BASE
OWNINTEGER LAST SLOT
OWNINTEGER LOCNO
OWNINTEGER NO OF GDCS
OWNBYTEINTEGERARRAYNAME MECHSLOTS
OWNBYTEINTEGERARRAYNAME CSTRM TO SLOT
OWNBYTEINTEGERARRAYNAME CNO TO GDC
OWNBYTEINTEGERARRAYNAME STRM Q
OWNINTEGERARRAYNAME CAAS
OWNINTEGERARRAYNAME TABLE
OWNINTEGERARRAYNAME STRM SEMAPHORE
OWNSTRINGNAME DATE,TIME
!*
CONSTINTEGER KMONNING=2
IF MONLEVEL&KMONNING#0 START
EXTERNALLONGINTEGERSPEC KMON
FINISH
!*
CONSTINTEGER GDC DEST=X'300000'
CONSTINTEGER GDC SNO=GDC DEST>>16
IF CSU FITTED=YES START
CONSTINTEGER CSU DEST=X'290000'
FINISH
!*
EXTERNALROUTINE GDC(RECORD (PARMF)NAME P)
!*
IF SSERIES=YES START ; ! DCU specific declarations
EXTERNALROUTINESPEC DISC(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC DCU1 RECOVERY(INTEGER PARM)
EXTERNALINTEGERSPEC DCU RFLAG; ! reconnect DCU1 streams if non-zero
ROUTINESPEC FIRE IDENTIFY
RECORDFORMAT DEVICE ENTRY F(INTEGER C
SER, DSSMM, PROPADDR, SECS SINCE, CAA, MYCCBA, C
BYTEINTEGER MECH,ATTN,SP1,SP2,INTEGER LAST TCB ADDR, C
X2, RESP0, X3, SENSE1, SENSE2, SENSE3, SENSE4, C
REPSNO, BASE, ID, DLVN, MNEMONIC, C
STRING (6) LABEL, BYTE INTEGER HWCODE, C
INTEGER ENTSIZE, UCCBA, SENSDAT AD, LOGMASK, TRTAB AD, C
UA SIZE, UA AD, TIMEOUT,PROPS0,PROPS1)
RECORDFORMAT CCBF(INTEGER COMMAND,STE,LEN,DATA,NTCB,RESP, C
INTEGERARRAY PREAMBLE,POSTAMBLE(0:3))
RECORDFORMAT CAF(INTEGER IAWA,SEMA)
OWNBYTEINTEGERARRAYFORMAT LBIFT(0:2047)
CONSTINTEGER CONNECT TERM=X'00201000'
CONSTINTEGER DISCONNECT TERM=X'00202000'
CONSTINTEGER DISC DEST=X'200000'
CONSTINTEGER EDS100=X'33',FDS640=X'3B'
CONSTINTEGER IDENTIFY FIRED=3
CONSTINTEGER INIT FAIL=X'00200000'
CONSTINTEGER INVALID ACTIVATE=X'00400000'
CONSTINTEGER MSPC=256; ! max streams/DCU
CONSTINTEGER POST AMBLE VALID=X'00004000'
CONSTINTEGER PRIMITIVE=X'00800000'
CONSTINTEGER RESET STREAM=6
CONSTINTEGER SENSE FAIL=X'00100000'
CONSTINTEGER START STREAM=2
CONSTINTEGER STOP STREAM=4
CONSTINTEGER STREAM ABTERM=X'00000400'
CONSTINTEGER STREAM ATTENTION=X'00004000'
CONSTINTEGER STREAM INT=X'00200000'
CONSTINTEGER STREAM TTERM=X'00008000'
CONSTINTEGER STREAM CTERM=CONNECT TERM!DISCONNECT TERM
CONSTINTEGER STREAM IA=STREAM INT!STREAM ATTENTION
CONSTINTEGER STREAM ITA=STREAM IA!STREAM TTERM
CONSTINTEGER TCB ATTN=X'20000000'
CONSTINTEGER TCB CONT=X'00800000'
CONSTINTEGER TCB FAIL=X'C0000000'
CONSTINTEGER TCB LENGTH=14*4
INTEGER INTWD
LONGINTEGER L
!* I/O control declarations
ROUTINESPEC ACTIVATE(INTEGER ACTWD,TCBAD,ISAD)
ROUTINESPEC FIRE DCU2(INTEGER UTAD,TCBAD,ACT)
EXTERNALINTEGERFNSPEC NEW PP CELL
EXTERNALROUTINESPEC RETURN PP CELL(INTEGER CELL)
EXTERNALLONGINTEGERSPEC PARMDES
RECORDFORMAT QACT F(INTEGER ACTWD,TCBAD,ISAD,P2,P3,P4,P5,P6,LINK)
RECORD (QACT F)NAME QACT
RECORD (QACT F)ARRAYFORMAT PARMAF(0:65535)
OWNRECORD (QACT F)ARRAYNAME PARM
OWNINTEGER QHEAD=0
OWNINTEGER ACTS QD=0,MAX Q=0,ACT CYCLES=0
IF MULTI OCP=YES START
OWNINTEGER DCU1 SEMA=-1,DCU2 SEMA=-1
OWNINTEGER RECOVER DCU1S=0
FINISH
INTEGER ISAD,SINK
!*
FINISH ELSE START ; ! GPC specific declarations
EXTERNALROUTINESPEC CONTROLLER DUMP(INTEGER CONTYPE,PT)
ROUTINESPEC PAW WAIT(RECORD (CAF)NAME CA)
ROUTINESPEC CONNECT STREAM(INTEGER PT,CAA,STREAM,CONNECT)
INTEGERFNSPEC READ STREAM DATA(INTEGER PT,STRM,CNTR)
RECORDFORMAT DEVICE ENTRY F(INTEGER SER, GPTSM, PROPADDR, C
SECS SINCE, CA A, MYCCBA, LB A, AL A, X2, RESP0, C
RESP1, SENSE1, SENSE2, SENSE3, SENSE4, X3, X4, IDENT C
, X5, MNEMONIC, DEVICE ENTRY S, PAW, U SAW 0, C
U CCB A, SENSE DATA A, LOG MASK, TRTAB AD, UA SIZE, C
UA AD, TIMEOUT, PROPS0, PROPS1)
RECORDFORMAT CCBF(INTEGER LIMFLAGS,LSTA,LBS,LBA,ALS,ALA,INIT,X1)
RECORDFORMAT ALEF(INTEGER S,A)
RECORD (CASEF)NAME STREAM
OWNBYTEINTEGERARRAYFORMAT LBIFT(0:511)
CONSTINTEGER DO STREAM REQUEST=X'01000000'
CONSTINTEGER GET STRM DATA=16
CONSTINTEGER MSPC=16; ! max streams/GPC
CONSTINTEGER PRIV ONLY=X'4000'
CONSTINTEGER RCB BOUND=32
CONSTINTEGER SENSE FIRED=3
STRING (23)WK
INTEGER PAW FN,USAW0,PT,PIW0
!*
FINISH
!*
RECORDFORMAT GDCT F(BYTEINTEGER FLAGS,DEVTYPE,ATTN,LINK, C
(INTEGER Q OR INTEGER X4), C
INTEGER RESPONSE DEST,DEVICE ENTRY A, C
(INTEGER CSTATUS,PTSM OR INTEGER UTAD,DSSMM), INTEGER MNEMONIC, C
BYTEINTEGER MECHINDEX,PROPS03,SERVRT,STATE)
!*
RECORD (DEVICE ENTRY F)NAME DEV
RECORD (GDCT F)NAME GDCT,GE
RECORD (CCBF)NAME CCB
RECORD (PARMF) Q
RECORD (CAF)NAME CA
!*
ROUTINESPEC FAIL TRANSFER(RECORD (GDCTF)NAME G,INTEGER SLOT)
INTEGERFNSPEC FIND(INTEGER MNEMONIC)
STRINGFNSPEC MTOS(INTEGER MNEMONIC)
ROUTINESPEC REPLY(INTEGER SRCE,STRING (30)TEXT)
INTEGERFNSPEC STATE CHECK(INTEGER MNEMONIC,STATE)
ROUTINESPEC STATUS(INTEGER SLOT)
INTEGERFNSPEC TRANS MNEMONIC(STRINGNAME S)
!*
CONSTINTEGER LIMIT=3
CONSTSTRING (4)ARRAY COMMAND(1:LIMIT)="QS ","CDS ","CDM "
CONSTSTRING (9)ARRAY STATES(0:6) = "not alloc",
"ready", "req fired", "sns fired", "queued", "discncted","timed out"
!*
!* Declarations for CDM
!*
CONSTINTEGER CDMDEVLIMIT=7
CONSTINTEGERARRAY CDMDEV(0:CDMDEVLIMIT)=C
M'FE',M'LP',M'CR',M'CP',M'PR',M'PT',M'SU',M'CT'
CONSTBYTEINTEGERARRAY CDMDEVTYPE(0:CDMDEVLIMIT)=14,6,4,3,2,1,13,12
CONSTINTEGERARRAY CDMDEVTIMEOUT(0:CDMDEVLIMIT)=C
X'01FF0003',60,300,600,60,60,10,10; ! top of FEP word is logmask
!*
EXTERNALINTEGER LP ILLCHAR=X'07'; ! ERCC value (also used by GROPE)
!*
!* LP repertoire addresses and lengths for each of 16 cartidge settings
!*
OWNINTEGERARRAY REPERTOIRE A(0:15)
OWNINTEGERARRAY REPERTOIRE S(0:15)
!*
!%CONSTINTEGERARRAY LP96REP(0:23)=c
!%CONSTINTEGERARRAY LP384REP(0:95)=c
!%CONSTBYTEINTEGERARRAY LCLETTS(1:26)=c
ENDOFLIST
CONSTINTEGERARRAY LP96REP(0:23)=C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0'
!*
CONSTINTEGERARRAY LP384REP(0:95)= C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B9C',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AE05F5A',X'4C6D3F6E',X'5B7A7C4F',
X'81828384',X'85868788',X'89919293',X'F0F1F2F3',
X'F4F5F6F7',X'F8F94B60',X'94959697',X'9899A2A3',
X'A4A5A6A7',X'A8A979F0',X'9EADEFCA',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AB7A05A',X'F0F1F2F3',X'F4F5F6F7',
X'F8F94B60',X'4CF08B6E',X'5B7A7C4F',X'C06AA1D0',
X'9A6D749B',X'FCEAAFED',X'ACAB8F8E',X'8DB5B4B3',
X'787776DC',X'DDDEDFB8',X'B9BABBB0',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',
X'D1D2D85C',X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5E7F6F',
X'4AE05F5A',X'4CF08B6E',X'5B7A7C4F',X'A8A979F0',
X'81828384',X'85868788',X'89919293',X'94959697',
X'9899A2A3',X'A4A5A6A7',X'B1B2FAFB',X'C1C2C3E9',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',
X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',X'D1D2D85C',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5EDBCB',
X'4AB7A05A',X'4CF08B6E',X'5B7A7C4F',X'EBBCA1BD',
X'8CAEBFBE',X'B6AAFDFE',X'9DEE80DA',X'C06D6AD0'
!*
CONSTBYTEINTEGERARRAY LCLETTS(1:26)= C
X'81',X'82',X'83',X'84',X'85',X'86',X'87',X'88',X'89',
X'91',X'92',X'93',X'94',X'95',X'96',X'97',X'98',X'99',
X'A2',X'A3',X'A4',X'A5',X'A6',X'A7',X'A8',X'A9'
LIST
!*
SWITCH GDC COMMAND(1:LIMIT)
SWITCH ACT(1:12)
!*
STRING (23)TEXT
STRING (15)MNEMOS
!*
BYTEINTEGERNAME QHD
BYTEINTEGERARRAYNAME REP,TRTAB
!*
INTEGER DACT,SRCE,FLAG
INTEGER SLOT,STATE,GDCNO,FLAGS
INTEGER MNEMONIC,MNEMONIC1,MNEMONIC2
INTEGER STRM,CAA,UCCBA,CNO,SEMA
INTEGER RESP0,RESP1
INTEGER MECH
INTEGER I,J
!*
IF MONLEVEL&KMONNING#0 AND KMON>>GDC SNO&1#0 START
IF SSERIES=YES THEN PKMONREC("DCU :",P) ELSE PKMONREC("GPC :",P)
FINISH
DACT=P_DEST&X'FFFF'
->ACT(DACT)
!*
ACT(2): ! initialise
RETURN UNLESS SETUP=NO
SETUP=YES
IF SSERIES=YES THEN PARM==ARRAY(INTEGER(ADDR(PARMDES)+4),PARMAF)
J=P_P1; ! GDC table address
TABLE==ARRAY(J,IFT); ! 1024 words
TABLE(42)=P_P2; ! process picture
IF SSERIES=NO THEN STRM SEMAPHORE==ARRAY(J+TABLE(40)<<2,IFT)
!*
! protem for S series use CA_SEMA - need extra fields in ENTFORM
!*
GDCT BASE=J+TABLE(1)<<2; ! slot table address
LASTSLOT=TABLE(2)
NO OF GDCS=TABLE(3)
!* reminders
!
! STRMQ addressed as 1) GDCNO<<4!STRM (was GPCNO<<4!STRM)
! or 2) GDCNO<<8!STRM (was DCUNO<<8!STRM)
! where GDCNO is logical GPC/DCU no.
! and got from:-
!
! CNO TO GDC as 1) CNO-LOCNO (was PT TO GPC(PT-LOPT))
! or 2) CNO-LOCNO (was PT TO GPC(h/w DCU no.-LOPT))
!
! CSTRM TO SLOT as 1) (PT-LOCNO)<<4!STRM (was PTS TO SLOT((PT-LOPT)<<4!STRM))
! or 2) ((CNO-LOCNO)<<8!STRM) (was h/w/DCU no.-LOPT)<<8!STRM)
!*
STRMQ==ARRAY(J+TABLE(4)<<2,LBIFT); ! 1 byte per stream
CSTRM TO SLOT==ARRAY(J+TABLE(5)<<2,LBIFT); ! ditto
CNO TO GDC==ARRAY(J+TABLE(6)<<2,BIFT); ! CNO is pt for GPC, H/W DCU no. for DCU
MECHSLOTS==ARRAY(J+TABLE(7)<<2,BIFT)
CAAS==ARRAY(ADDR(TABLE(8)),IFT)
LOCNO=255
FOR J=0,1,NO OF GDCS-1 CYCLE
I=TABLE(16+J)
IF I<LOCNO THEN LOCNO=I
REPEAT
J=0; ! re-initialise STRMQ heads
WHILE J<NO OF GDCS*MSPC CYCLE
LONGINTEGER(ADDR(STRMQ(J)))=-1
J=J+8
REPEAT
FOR J=0,1,15 CYCLE
REPERTOIRE A(J)=ADDR(LP96REP(0))
REPERTOIRE S(J)=96
REPEAT
REPERTOIRE A(3)=ADDR(LP384REP(0))
REPERTOIRE S(2)=48
REPERTOIRE S(3)=384
REPERTOIRE S(4)=64
DATE==STRING(ADDR(COM_DATE0)+3)
TIME==STRING(ADDR(COM_TIME0)+3)
! re-initialise slots
FOR J=0,1,LASTSLOT CYCLE
GDCT==RECORD(GDCT BASE+J*SLOT SIZE)
GDCT_FLAGS=0
GDCT_LINK=ENDLIST
IF GDCT_DEVTYPE=ZX THEN GDCT_STATE=DISCONNECTED C
ELSE GDCT_STATE=NOT ALLOCATED
GDCT_ATTN=0
GDCT_X4=0
GDCT_RESPONSE DEST=0
IF SSERIES=NO THEN GDCT_CSTATUS=0
GDCT_SERVRT=0
DEV==RECORD(GDCT_DEVICE ENTRY A)
DEV_RESP0=0
IF SSERIES=YES AND EDS100<=GDCT_DEVTYPE<=FDS640 START
GDCT_STATE=READY
GDCT_RESPONSE DEST=DISC DEST!3
DEV_SER=J+LOID
FINISH ELSE IF GDCT_DEVTYPE=OP START
I=GDCT_MECHINDEX>>4; ! logical OPER no
P=0
P_P1=GDCT_MNEMONIC
P_P2=X'320005'!(I<<8); ! where we want OPER interrupts
P_DEST=X'30000B'; ! allocate
P_SRCE=X'320002'!(I<<8); ! allocate response to OPER
PON(P)
FINISH ELSE IF GDCT_DEVTYPE=FE START
P=0
P_P1=GDCT_MNEMONIC
P_P2=X'390005'; ! where we want FE interrupts
P_DEST=X'30000B'; ! allocate
P_SRCE=X'390002'; ! allocate response to FE adaptor
PON(P)
FINISH ELSE IF GDCT_DEVTYPE=MT START
IF GDCT_PTSM&15=0 START ; ! 1 call per cluster
P=0
P_DEST=X'00310004'
P_SRCE=X'00300000'
P_P1=GDCT_MNEMONIC
PON(P)
FINISH
FINISH ELSE IF CSU FITTED=YES AND GDCT_DEVTYPE=SU START
P=0
P_DEST=CSU DEST; ! CSU initialise
P_P1=GDCT_MNEMONIC
PON(P)
FINISH
REPEAT
IF SSERIES=YES AND COM_NDISCS>0 START
P=0
P_DEST=DISC DEST; ! initialise DISC
PON(P)
FINISH
!*
PRINTSTRING(VSN)
NEWLINE
PRINTSTRING("GDC's tables:-")
DUMPTABLE(0,ADDR(TABLE(0)),TABLE(0)<<2+4)
!*
P_DEST=X'A0001'; ! interval timer
P_SRCE=0
P_P1=GDC DEST!6
P_P2=TICK INTERVAL
PON(P)
RETURN
!*
!*
ACT(11): ! allocate device
UNLESS FIND(P_P1)<0 START
IF GDCT_STATE=NOT ALLOCATED START
FLAG=0
DEV==RECORD(GDCT_DEVICE ENTRY A)
IF GDCT_DEVTYPE=OP START ; ! extra info for OPERs
I=GDCT_MECHINDEX>>4
DEV_SER=TABLE(I+32)&X'FFFF'; ! buffer size
DEV_X2=DEV_CAA+TABLE(I+32)>>16; ! buffer address
DEV_RESP0=GDCT_MECHINDEX&15; ! screens
FINISH ELSE IF GDCT_DEVTYPE=LP THEN DEV_SER=GDCT_RESPONSE DEST; ! & LPs
GDCT_STATE=READY
GDCT_RESPONSE DEST=P_P2
P_P2=LOID+SLOT
P_P3=ADDR(DEV)
P_P6=GDCT_MNEMONIC
FINISH ELSE FLAG=2
FINISH ELSE FLAG=1
->ACKNOWLEDGE
!*
ACT(8): ! special forced allocate (CALL not PON)
UNLESS FIND(P_P1)<0 START
UNLESS P_P1=M'LP' AND GDCT_STATE=DISCONNECTED START
FLAG=0
GDCT_STATE=READY
GDCT_RESPONSE DEST=P_P2
P_P2=LOID+SLOT
P_P3=GDCT_DEVICE ENTRY A
P_P6=GDCT_MNEMONIC
FINISH ELSE FLAG=2
FINISH ELSE FLAG=1
P_P1=FLAG
RETURN
ACT(5): ! deallocate
UNLESS P_P1=M'LP' START
UNLESS FIND(P_P1)<0 START
STATE=GDCT_STATE
IF STATE=READY OR (SSERIES=YES AND STATE=IDENTIFY FIRED) START
IF P_SRCE<<1>>17>63 START ;! from user process
IF 0<GDCT_RESPONSE DEST>>16<64 THEN FLAG=4 AND ->FALL; ! prohibit
FINISH
IF SSERIES=YES AND STATE=IDENTIFY FIRED THEN C
STRMQ(GDCT_DSSMM>>24<<8!(GDCT_DSSMM>>8)&255)=ENDLIST; ! clear identify
GDCT_STATE=NOT ALLOCATED
GDCT_FLAGS=0
P_P3=GDCT_DEVICE ENTRY A
FLAG=0
FINISH ELSE FLAG=STATE<<16!3
FINISH ELSE FLAG=2
FINISH ELSE FLAG=1
FALL:
->ACKNOWLEDGE
ACT(6): ! clocktick
IF SSERIES=YES AND MULTI OCP=YES AND RECOVER DCU1S#0 START
! DCU1 recovery required in controlling OCP
*LSS_(3); *USH_-26; *AND_3; *ST_I
IF I=COM_OCPPORT0 START
I=RECOVER DCU1S
RECOVER DCU1S=0
DCU1 RECOVERY(I)
OPMESS("DCU1 recovery initiated")
FINISH ELSE START
P_SRCE=M'STIK'
PON(P); ! try for other OCP
FINISH
RETURN
FINISH
IF SSERIES=YES AND DCU RFLAG#0 START
! reconnect of DCU1 streams required
P_SRCE=0
P_P1=DCU RFLAG
DCU RFLAG=0
->RECON
FINISH
FOR SLOT=0,1,LASTSLOT CYCLE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
IF GDCT_STATE=REQUEST FIRED OR C
(SSERIES=YES AND GDCT_STATE=IDENTIFY FIRED) OR C
(SSERIES=NO AND GDCT_STATE=SENSE FIRED) START
DEV==RECORD(GDCT_DEVICE ENTRY A)
DEV_SECS SINCE=DEV_SECS SINCE+TICK INTERVAL
IF DEV_SECS SINCE>DEV_TIMEOUT START
CA==RECORD(DEV_CAA)
IF SSERIES=YES AND GDCT_UTAD=0 START
! recover any 'dead' DCU1s
ISAD=CA_IAWA
IF MULTI OCP=YES START
*INCT_DCU1 SEMA
*JCC_8,<TSEMAG>
SEMALOOP(DCU1 SEMA,0)
TSEMAG:
FINISH
FOR I=1,1,COM_INSPERSEC*2 CYCLE ; ! approx 20 millisecs
*LB_ISAD; *LSD_0; *L_(0+B ); *STUH_SINK
*JAT_4,<TOK>
REPEAT
! activate word not cleared so assume DCU1 has died
CNO=GDCT_DSSMM>>16&255
IF MULTI OCP=YES START
*TDEC_DCU1 SEMA
*LSS_(3); *USH_-26; *AND_3; *ST_I
UNLESS I=COM_OCPPORT0 START
RECOVER DCU1S=CNO; ! recover DCU1 in controlling OCP
RETURN
FINISH
FINISH
DCU1 RECOVERY(CNO)
OPMESS("DCU1 recovery initiated")
RETURN
TOK:
IF MULTI OCP=YES START ; *TDEC_DCU1 SEMA; FINISH
FINISH ELSE IF SSERIES=NO START
SLAVESONOFF(0)
FOR I=1,1,COM_INSPERSEC*2 CYCLE ; ! 20 msecs
J=CA_PAW
EXIT IF J=0
REPEAT
SLAVESONOFF(-1)
UNLESS J=0 START ; ! presume GPC dead
PT=GDCT_PTSM>>8&255
CONTROLLER DUMP(3,PT)
I=GPC INIT(ADDR(CA),PT,0)
IF I=0 THEN WK=" reinitialised" ELSE WK=" reinit fails"
OPMESS("GPC ".HTOS(PT,2).WK)
CONNECT STREAM(PT,ADDR(CA),-1,1)
FINISH
FINISH
OPMESS(MTOS(GDCT_MNEMONIC)." timed out")
!*
!* fail transfer(s)
!*
IF MULTI OCP=YES START
IF SSERIES=YES THEN SEMA=ADDR(CA_SEMA) C
ELSE SEMA=ADDR(STRM SEMAPHORE(GDCT_PTSM>>24!GDCT_PTSM>>4&15))
*LXN_SEMA; *INCT_(XNB +0); *JCC_8,<TSEMAGOT>
SEMALOOP(INTEGER(SEMA),0)
TSEMAGOT:
FINISH
FAIL TRANSFER(GDCT,SLOT)
IF SSERIES=YES THEN STRMQ(GDCT_DSSMM>>24<<8!GDCT_DSSMM>>8&255)=ENDLIST C
ELSE STRMQ(GDCT_PTSM>>16<<4!GDCT_PTSM>>4&15)=ENDLIST
IF GDCT_DEVTYPE=MT START ; ! fail Q'ed MT requests aussi
CYCLE
I=GDCT_LINK
EXIT IF I=ENDLIST
GDCT_LINK=ENDLIST
GDCT==RECORD(GDCT BASE+I*SLOT SIZE)
FAIL TRANSFER(GDCT,I)
REPEAT
FINISH
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
FINISH
FINISH
REPEAT
RETURN
ACT(12): ! execute request
SLOT=P_P2&X'FFFF'-LOID
IF 0<=SLOT<=LASTSLOT START ; ! valid slot
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
IF SSERIES=YES START
I=0; *INCT_I; ! clear operand slaves
GDCNO=GDCT_DSSMM>>24
STRM=GDCT_DSSMM>>8&255
FINISH ELSE START
GDCNO=GDCT_PTSM>>16
PT=GDCT_PTSM>>8&255
STRM=GDCT_PTSM>>4&15
PAW FN=(P_P3&X'F0')<<20!STRM
USAW0=(P_P3&15)<<28!RCB BOUND
FINISH
DEV==RECORD(GDCT_DEVICE ENTRY A)
UCCBA=P_P1
IF SSERIES=YES START
IF GDCT_UTAD=0 AND (UCCBA&7#0 OR UCCBA>>18#DEV_UA AD>>18) START
FLAG=M'BTCB'
P_P3=UCCBA
->ACKNOWLEDGE
! bad TCBs can cause havoc !!!
FINISH
FINISH ELSE START
DEV_IDENT=P_P4; ! returned on chain termination
P_P6=P_P4; ! used by TCSS (only?)
! if "S" series TCSS appears then DEV format will have to expand
FINISH
CA==RECORD(DEV_CAA)
IF MULTI OCP=YES START
IF SSERIES=YES THEN SEMA=ADDR(CA_SEMA) ELSE C
SEMA=ADDR(STRM SEMAPHORE(GDCNO<<4!STRM))
*LXN_SEMA; *INCT_(XNB +0); *JCC_8,<SSEMAGOT>
SEMALOOP(INTEGER(SEMA),0)
SSEMAGOT:
FINISH
IF GDCT_STATE=READY START
IF SSERIES=YES THEN QHD==STRMQ(GDCNO<<8!STRM) ELSE C
QHD==STRMQ(GDCNO<<4!STRM)
IF QHD=ENDLIST START ; ! ok to fire I/O
GDCT_LINK=ENDLIST
QHD=SLOT
GDCT_STATE=REQUEST FIRED
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
IF SSERIES=YES START
IF GDCT_UTAD=0 THEN ACTIVATE(X'01000000'!STRM,UCCBA,CA_IAWA) C
ELSE FIRE DCU2(GDCT_UTAD,UCCBA,START STREAM)
FINISH ELSE START
STREAM==CA_STREAM(STRM)
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<CAAG>
SEMALOOP(CA_MARK,2)
CAAG:
IF CA_PAW#0 THEN CA_MARK=-1 AND PAW WAIT(CA)
CA_PAW=PAW FN
STREAM_SAW0=USAW0
STREAM_SAW1=UCCBA
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
FINISH
FINISH ELSE IF GDCT_DEVTYPE=MT START
I=QHD; ! Q MT request
UNTIL I=ENDLIST CYCLE
GE==RECORD(GDCT BASE+I*SLOTSIZE)
I=GE_LINK
REPEAT
GDCT_LINK=ENDLIST
GE_LINK=SLOT
GDCT_STATE=QUEUED
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
FINISH ELSE ->STRM BUSY
IF SSERIES=YES START
FINISH ELSE START
IF P_P3&X'100'=0 THEN GDCT_FLAGS=0 ELSE C
GDCT_FLAGS=GET STRM DATA
DEV_USAW0=USAW0
DEV_PAW=PAW FN
DEV_RESP1=0
FINISH
DEV_UCCBA=UCCBA
DEV_SECS SINCE=0
P_P1=0
->OUT
FINISH ELSE START
IF SSERIES=YES AND GDCT_STATE=IDENTIFY FIRED AND GDCT_Q=0 START
!* Q request 'till identify terminates
I=NEW PP CELL
GDCT_Q=I
QACT==PARM(I)
IF GDCT_UTAD=0 START
QACT_ACTWD=X'01000000'!STRM
QACT_ISAD=CA_IAWA
FINISH ELSE QACT_ACTWD=GDCT_UTAD
QACT_TCBAD=UCCBA
QACT_P2=M'IDWT'
P_P1=0
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
->OUT
FINISH
STRM BUSY:
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
FLAG=2
P_P3=ADDR(DEV)
P_P6=P_P4
FINISH
FINISH ELSE FLAG=1
->ACKNOWLEDGE
!*
!*
!*
ACT(3): ! interrupt
IF SSERIES=YES START
*INCT_I; ! clear operand slaves
INTWD=P_P1
STRM=INTWD&255
CNO=INTWD>>24&15
GDCNO=CNO TO GDC(CNO-LOCNO)
IF INTWD&PRIMITIVE#0 START ; ! DCU gone primitive (or similar)
PKMONREC("DCU gone primitive!",P)
!* dump DCU ?
IF MULTI OCP=YES THEN RECOVER DCU1S=CNO ELSE START
DCU1 RECOVERY(CNO)
OPMESS("DCU1 recovery initiated")
FINISH
->OUT
FINISH
UNLESS CONNECT TERM#INTWD&STREAM CTERM#DISCONNECT TERM START
! i.e if INTWD&CTERM = CONNECT or DISCONNECT
PKMONREC("DCU control term",P)
IF INTWD&DISCONNECT TERM=DISCONNECT TERM START
! DCU1s only (DCU2s give a simulated connect term)
CAA=CAAS(GDCNO)
CA==RECORD(CAA)
ACTIVATE(X'03000000'!STRM,0,CA_IAWA); ! reconnect
FINISH
->OUT
FINISH
QHD==STRMQ(GDCNO<<8!STRM)
IF INTWD&STREAM ITA=STREAM IA START
! attention & no TCB termination
SLOT=CSTRM TO SLOT((CNO-LOCNO)<<8!STRM)
IF SLOT=ENDLIST THEN ->SURPRISE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
DEV==RECORD(GDCT_DEVICE ENTRY A)
IF MULTI OCP=YES START
CA==RECORD(DEV_CAA)
SEMA=ADDR(CA_SEMA)
*LXN_SEMA; *INCT_(XNB +0); *JCC_8,<ASEMAGOT>
SEMALOOP(INTEGER(SEMA),0)
ASEMAGOT:
FINISH
TRYNMT:
IF GDCT_STATE=READY START
IF QHD=ENDLIST START
FIRE IDENTIFY
QHD=SLOT
FINISH ELSE START ; ! MT request on another slot
GDCT==RECORD(GDCT BASE+QHD*SLOT SIZE)
GDCT_ATTN=1
FINISH
FINISH ELSE START
IF GDCT_STATE=NOT ALLOCATED OR GDCT_STATE=DISCONNECTED START
IF GDCT_DEVTYPE=MT START
! must be careful not to lose an attention when
! 1st n decks of a cluster are not allocated etc.
SLOT=SLOT+1
IF SLOT<=LASTSLOT START
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE)
DEV==RECORD(GDCT_DEVICE ENTRY A)
IF GDCT_DSSMM>>24=GDCNO AND C
GDCT_DSSMM>>8&255=STRM THEN ->TRYNMT; ! next deck
FINISH
FINISH
UNLESS GDCT_DEVTYPE=FE START
! dont report spurious FE attentions lest FE in a twist
! & we thus swamp the mainlog
BYTEINTEGER(ADDR(P_P3))=GDCT_STATE
PKMONREC("DCU attention?:",P)
FINISH
FINISH ELSE GDCT_ATTN=1; ! identify on termination
FINISH
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
->OUT
FINISH
SLOT=QHD
IF SLOT=ENDLIST THEN ->SURPRISE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
DEV==RECORD(GDCT_DEVICE ENTRY A)
IF GDCT_STATE=IDENTIFY FIRED THEN CCB==RECORD(DEV_MYCCBA) ELSE C
CCB==RECORD(DEV_UCCBA)
WHILE CCB_RESP&TCB CONT#0 CYCLE ; ! find 'stopped' TCB
CCB==RECORD(CCB_NTCB)
REPEAT
IF GDCT_STATE=REQUEST FIRED START
IF INTWD&INVALID ACTIVATE#0 START
PKMONREC("DCU1 invalid act:",P)
RESP0=CONTROLLER DETECTED ERROR
RESP1=INTWD
INTWD=0
DEV_LAST TCB ADDR=ADDR(CCB)
FINISH ELSE START
IF CCB_RESP&TCB ATTN#0 THEN GDCT_ATTN=1
! the above is for DCU2s - is there a better way?
RESP0=CCB_RESP>>24<<8; ! primary status
RESP1=CCB_RESP&X'FFFF'; ! RBC
IF INTWD&STREAM ABTERM=0 START
RESP0=RESP0!NORMAL TERMINATION
FINISH ELSE START
IF DEV_LOGMASK>>8#0 START
PRINTSTRING("DT: ".DATE." ".TIME. C
" DCU--Abnormal termination - ". C
MTOS(GDCT_MNEMONIC)."(".HTOS(GDCT_DSSMM>>8&255,3). C
") TCB RESP = ".HTOS(CCB_RESP,8)."
")
DUMPTABLE(0,DEV_UCCBA,14*4*2)
FINISH
DEV_LAST TCB ADDR=ADDR(CCB)
RESP0=RESP0!(CCB_RESP&INIT FAIL)>>4!ABNORMAL TERMINATION
! primary status + init fail + abterm
RESP0=RESP0!(((ADDR(CCB)-DEV_UCCBA)//TCB LENGTH)&255)
! failing TCB
Q_P4=(CCB_COMMAND&POST AMBLE VALID)>>7!!(CCB_RESP&SENSE FAIL)>>13
! X'80' if succesful sense done by DCU
! tho' not for discs??
IF Q_P4#0 THEN DEV_SENSDAT AD=ADDR(CCB_POSTAMBLE(0))
FINISH
FINISH
FINISH ELSE IF GDCT_STATE=IDENTIFY FIRED START
IF INTWD&INVALID ACTIVATE#0 OR CCB_RESP&TCB FAIL#0 START
PRINTSTRING("DCU identify fails - parm = ".HTOS(INTWD,8). C
" TCB_RESP = ".HTOS(CCB_RESP,8)."
")
INTWD=0; ! 'lest identify loop
->MORE REQUESTS
FINISH ELSE START
IF GDCT_DEVTYPE=MT AND DEV_MECH&7#GDCT_DSSMM&7 START
I=MECHSLOTS(GDCT_MECHINDEX+DEV_MECH&7)
GE==RECORD(GDCT BASE+I*SLOT SIZE)
UNLESS GE_STATE=NOT ALLOCATED OR GE_STATE=DISCONNECTED START
! allocated decks only
Q_DEST=GE_RESPONSE DEST
Q_SRCE=GDC DEST!3
Q_P1=(I+LOID)<<24!ATTENTION!DEV_ATTN<<8
Q_P2=0
Q_P3=GE_DEVICE ENTRY A
PON(Q)
FINISH
->MORE REQUESTS
FINISH
RESP0=ATTENTION!DEV_ATTN<<8
RESP1=0
FINISH
FINISH ELSE ->SURPRISE
FINISH ELSE START
PT=P_P1
GDCNO=CNO TO GDC(PT-LOCNO)
CAA=CAAS(GDCNO)
CA==RECORD(CAA)
*LXN_CAA
*INCT_(XNB +0)
*JCC_8,<CGOT1>
SEMALOOP(INTEGER(CAA),2)
CGOT1:
PIW0=CA_PIW0
CA_PIW0=0
CA_MARK=-1
MORE INTS:
*LSS_PIW0
*JAT_4,<OUT>; ! no (more) interrupts
*SHZ_STRM
PIW0=PIW0!!X'80000000'>>STRM
STREAM==CA_STREAM(STRM)
*LXN_CAA
*INCT_(XNB +0)
*JCC_8,<CGOT2>
SEMALOOP(INTEGER(CAA),2)
CGOT2:
RESP0=STREAM_RESP0
RESP1=STREAM_RESP1
STREAM_RESP0=0
STREAM_RESP1=0
CA_MARK=-1
IF RESP0&ATTENTION#0 START
SLOT=CSTRM TO SLOT((PT-LOCNO)<<4!STRM)
IF SLOT=ENDLIST THEN ->SURPRISE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
IF GDCT_DEVTYPE=MT START
SLOT=MECHSLOTS(GDCT_MECHINDEX+RESP0>>24&15)
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
FINISH
IF GDCT_STATE=NOT ALLOCATED THEN ->SURPRISE
IF SSERIES=NO THEN DEV==RECORD(GDCT_DEVICE ENTRY A); ! for _IDENT
->RESPOND
FINISH ELSE SLOT=STRMQ(GDCNO<<4!STRM)
IF SLOT=ENDLIST THEN ->SURPRISE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
DEV==RECORD(GDCT_DEVICE ENTRY A)
IF GDCT_STATE=REQUEST FIRED START
DEV_RESP0=RESP0
DEV_RESP1=RESP1
IF RESP0&ABNORMAL TERMINATION#0 AND GDCT_RESPONSE DEST>>16<65 START
IF RESP0&X'FF0000'=CONTROLLER DETECTED ERROR OR C
DEV_LOGMASK>>8#0 START
PRINTSTRING("DT: ".DATE." ".TIME. C
" GPC--Abnormal termination - ".MTOS(GDCT_MNEMONIC). C
"(".HTOS(PT<<4!STRM,3).") RESP0 = ".HTOS(RESP0,8)."
")
J=READ STREAM DATA(PT,STRM,2); ! control stream status
J=READ STREAM DATA(PT,STRM,0); ! stream data
IF GDCT_DEVTYPE=FE AND RESP0&X'FF0000'=CONTROLLER DETECTED ERROR C
THEN CONNECT STREAM(PT,CAA,STRM,1)
FINISH
IF GDCT_FLAGS&GET STRM DATA#0 START
GDCT_CSTATUS=READ STREAM DATA(PT,STRM,1); ! stream's cstatus
->SET SENSE
FINISH
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<CAG>
SEMALOOP(CA_MARK,2)
CAG:
IF CA_PAW#0 THEN CA_MARK=-1 AND PAW WAIT(CA)
CA_PAW=DO STREAM REQUEST!STRM
STREAM_SAW0=X'10000020'
STREAM_SAW1=DEV_MYCCBA
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
GDCT_STATE=SENSE FIRED
->MORE INTS
FINISH
FINISH ELSE IF GDCT_STATE=SENSE FIRED START
SET SENSE:
IF DEV_LOGMASK&BYTEINTEGER(ADDR(DEV_SENSE1))#0 START
IF MULTI OCP=YES THEN RESERVE LOG
PRINTSTRING("DT: ".DATE." ".TIME." GPC--device entry after sense:")
DUMPTABLE(0,ADDR(DEV),DEV_DEVICE ENTRY S)
IF MULTI OCP=YES THEN RELEASE LOG
FINISH
Q_P4=RESP0>>16
Q_P5=GDCT_CSTATUS
RESP0=DEV_RESP0
RESP1=DEV_RESP1
FINISH ELSE ->SURPRISE
FINISH
RESPOND: ! tell allocatee
Q_DEST=GDCT_RESPONSE DEST
Q_SRCE=GDC DEST!3
Q_P1=RESP0
BYTEINTEGER(ADDR(Q_P1))=SLOT+LOID
Q_P2=RESP1
Q_P3=GDCT_DEVICE ENTRY A
IF SSERIES=NO THEN Q_P6=DEV_IDENT; ! not "S" protem - see ACT(12)
PON(Q)
IF SSERIES=NO AND RESP0&ATTENTION#0 THEN ->MORE INTS
!*
MORE REQUESTS:
IF MULTI OCP=YES START
IF SSERIES=YES THEN CA==RECORD(DEV_CAA) AND SEMA=ADDR(CA_SEMA) ELSE C
SEMA=ADDR(STRM SEMAPHORE(GDCNO<<4!STRM))
*LXN_SEMA; *INCT_(XNB +0); *JCC_8,<SSEMAG>
SEMALOOP(INTEGER(SEMA),0)
SSEMAG:
FINISH
IF SSERIES=YES AND GDCT_Q#0 START ; ! fire waiting I/O
I=GDCT_Q
GDCT_Q=0
QACT==PARM(I)
GDCT_STATE=REQUEST FIRED
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
DEV_SECS SINCE=0
DEV_UCCBA=QACT_TCBAD
IF GDCT_UTAD=0 THEN ACTIVATE(QACT_ACTWD,QACT_TCBAD,QACT_ISAD) C
ELSE FIRE DCU2(QACT_ACTWD,QACT_TCBAD,START STREAM)
RETURN PP CELL(I)
->OUT
FINISH
IF SSERIES=YES AND (INTWD&STREAM ATTENTION#0 OR GDCT_ATTN#0) START
FIRE IDENTIFY
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
->OUT
FINISH
GDCT_STATE=READY
IF SSERIES=NO THEN QHD==STRMQ(GDCNO<<4!STRM); ! already mapped for S series
UNLESS GDCT_DEVTYPE=MT START
QHD=ENDLIST
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
IF SSERIES=YES THEN ->OUT ELSE ->MORE INTS
FINISH
QHD=GDCT_LINK
GDCT_LINK=ENDLIST
IF QHD#ENDLIST START ; ! request to go
SLOT=QHD
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
DEV==RECORD(GDCT_DEVICE ENTRY A)
CA==RECORD(DEV_CAA)
GDCT_STATE=REQUEST FIRED
IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
IF SSERIES=YES START
IF GDCT_UTAD=0 THEN ACTIVATE(X'01000000'!STRM,DEV_UCCBA,CA_IAWA) C
ELSE FIRE DCU2(GDCT_UTAD,DEV_UCCBA,START STREAM)
FINISH ELSE START
STREAM==CA_STREAM(STRM)
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<CAAGOT>;
SEMALOOP(CA_MARK,2)
CAAGOT:
IF CA_PAW#0 THEN CA_MARK=-1 AND PAW WAIT(CA)
CA_PAW=DEV_PAW
STREAM_SAW0=DEV_USAW0
STREAM_SAW1=DEV_UCCBA
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
FINISH
FINISH ELSE IF MULTI OCP=YES START ; *LXN_SEMA; *TDEC_(XNB +0); FINISH
IF SSERIES=YES THEN ->OUT ELSE ->MORE INTS
!*
SURPRISE: ! unexpexted interrupt
IF SSERIES=YES START
PRINTSTRING("DT: ".DATE." ".TIME. C
" DCU--Surprise interrupt - parm = ".HTOS(INTWD,8)." ".HTOS(P_P2,8)."
")
->OUT
FINISH ELSE START
PRINTSTRING("DT: ".DATE." ".TIME. C
" GPC--Surprise interrupt on ".HTOS(PT<<4!STRM,3)."/".HTOS(RESP0,8)."
")
->MORE INTS
FINISH
RETURN
!*
IF SSERIES=YES START
ACT(10):RECON: ! reconnect streams
! P_P1 = DCU1 H/W no. or -1 for all DCU1s
FOR SLOT=0,1,LASTSLOT CYCLE
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE)
IF GDCT_UTAD=0 AND (P_P1=-1 OR GDCT_DSSMM>>16&255=P_P1) START
CONTINUE IF GDCT_DEVTYPE=ZX
CONTINUE IF GDCT_DEVTYPE=MT AND GDCT_DSSMM&15>0
DEV==RECORD(GDCT_DEVICE ENTRY A)
CA==RECORD(DEV_CAA)
ACTIVATE(X'03000000'!GDCT_DSSMM>>8&255,0,CA_IAWA)
WAIT(10)
FINISH
REPEAT
->ACK1
FINISH ELSE START
ACT(7): ! entry from reconfigure routine
! P_P1=IDENT,P_P2=SAC
I=P_P2
P_P2=0
FOR SLOT=0,1,LASTSLOT CYCLE
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE)
IF GDCT_PTSM>>12&15=I AND GDCT_STATE&15#DISCONNECTED START ; ! SAC in use
P_P2=3<<24!GDCT_MNEMONIC
EXIT
FINISH
REPEAT
->ACK1
ACT(9): ! entry from SHUTDOWN routine
! P_P1 = pt
IF COM_NSACS=1 AND COM_SACPORT0#P_P1>>4 THEN ->ACK1; ! SAC gone
FOR SLOT=0,1,LAST SLOT CYCLE
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
PT=GDCT_PTSM>>8&255
IF PT=P_P1 START
DEV==RECORD(GDCT_DEVICE ENTRY A)
CCB==RECORD(DEV_MYCCBA)
STRM=GDCT_PTSM>>4&15
CA==RECORD(DEV_CAA)
STREAM==CA_STREAM(STRM)
IF GDCT_DEVTYPE=MT START
CCB_LIM FLAGS=X'C000'
I=CCB_INIT&X'FF'
I=3 IF I=0
CCB_INIT=MECH<<24!I
FINISH ELSE CCB_LIM FLAGS=PRIV ONLY
INTEGER(CCB_LBA)=X'80F01800'
LONGINTEGER(CCB_ALA)=X'5800000481000000'
CCB_LBS=4
CCB_ALS=8
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<GOT1>
SEMALOOP(CA_MARK,2)
GOT1:
CA_PAW=DO STREAM REQUEST!STRM
CA_PIW0=0
STREAM_SAW0=3<<28!RCB BOUND
STREAM_SAW1=ADDR(CCB)
STREAM_RESP0=0
STREAM_RESP1=0
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
WAIT(10)
FINISH
REPEAT
WAIT(100)
->ACK1
ACT(10): ! Reinit GPC
! P_P1 = PT
! P_P2 = OLD PT IF >=0
PT=P_P1
IF P_P2>=0 AND PT#P_P2 START ; ! SAC switch
! *** not implemented protem - grope table requires extension ***
OPMESS("Cannot switch GPCs")
->ACK1
FINISH
IF 0<=PT<=X'1F' AND BYTEINTEGER(COM_CONTYPEA+PT)=3 START
I=GPC INIT(CAAS(CNO TO GDC(PT-LOCNO)),PT,0); ! reinitialise GPC
IF I=0 THEN WK=" reinitialised" ELSE WK=" reinit fails"
OPMESS("GPC ".HTOS(PT,2).WK)
FINISH ELSE OPMESS("Cannot reinit GPC ".HTOS(PT,2))
->ACK1
FINISH
!*
ACT(*):
IF SSERIES=YES THEN PKMONREC("DCU bad DACT:",P) ELSE PKMONREC("GPC bad DACT:",P)
RETURN
!*
ACKNOWLEDGE:
P_P1=FLAG
ACK1:
IF P_SRCE>0 START ; ! PON reply
P_DEST=P_SRCE
P_SRCE=GDC DEST!DACT
PON(P)
FINISH
OUT:
IF SSERIES=YES AND QHEAD#0 START
IF MULTI OCP=YES START
*INCT_DCU1SEMA
*JCC_8,<DCU1SEMAGOT>
SEMALOOP(DCU1 SEMA,0)
DCU1SEMAGOT:
FINISH
WHILE QHEAD#0 CYCLE
QACT==PARM(QHEAD)
L=LENGTHENI(QACT_TCBAD)<<32!QACT_ACTWD
ISAD=QACT_ISAD
FOR I=1,1,COM_INSPERSEC CYCLE
*LB_ISAD; *LSD_0; *L_(0+B ); *STUH_SINK
*JAT_4,<OK>
REPEAT
->NOTOK
OK: *LSD_L; *ST_(0+B )
I=QHEAD
QHEAD=QACT_LINK
RETURN PP CELL(I)
REPEAT
NOTOK:
IF MULTI OCP=YES START ; *TDEC_DCU1SEMA; FINISH
FINISH
RETURN
!*
ACT(1): ! command (CDS etc)
SRCE=P_SRCE<<1>>1
TEXT=P_TEXT
IF SSERIES=YES AND TEXT="DIAGS" START
REPLY(SRCE,"DCU ACTs Q'd = ".STRINT(ACTS QD))
REPLY(SRCE,"DCU ACT cycs = ".STRINT(ACT CYCLES))
REPLY(SRCE,"DCU max Q'd = ".STRINT(MAX Q))
RETURN
FINISH
IF TEXT="?" THEN ->GC4
FOR J=1,1,LIMIT CYCLE
IF TEXT->(COMMAND(J)).TEXT THEN ->FOUND
REPEAT
ERR:
IF SSERIES=YES THEN REPLY(SRCE,"DCU ??".P_TEXT) ELSE C
REPLY(SRCE,"GPC ??".P_TEXT)
RETURN
FOUND: ! QS,CDS or CDM
UNLESS TEXT->MNEMOS.(" ").TEXT START
->ERR UNLESS J=1; ! must be QS
MNEMOS<-TEXT
FINISH
MNEMONIC=TRANS MNEMONIC(MNEMOS); ! to integer
IF FIND(MNEMONIC)<0 THEN ->ERR; ! not found
DEV==RECORD(GDCT_DEVICE ENTRY A)
->GDC COMMAND(J)
GDC COMMAND(1): ! QS dev
PRSTATUS:
STATUS(SLOT)
RETURN
GDC COMMAND(2): ! CDS dev ON/OFF
LENGTH(TEXT)=LENGTH(TEXT)-1 WHILE CHARNO(TEXT,LENGTH(TEXT))=' '
STATE=GDCT_STATE&15
IF TEXT="OFF" START
IF STATE CHECK(MNEMONIC,STATE)=OK START
IF SSERIES=YES START
! disconnect DCU1 stream
! (but note that stream is reconnected on disconnect term.)
! no disconnect on DCU2, stream is reset by CDS ON etc.
IF GDCT_UTAD=0 START
CA==RECORD(DEV_CAA)
ACTIVATE(X'02000000'!GDCT_DSSMM>>8&255,0,CA_IAWA)
FINISH
FINISH ELSE CONNECT STREAM(GDCT_PTSM>>8&255,DEV_CAA,GDCT_PTSM>>4&15,0)
IF MNEMONIC>>16=M'M' START ; ! MT cluster
I=GDCT BASE
FOR J=0,1,LASTSLOT CYCLE
GDCT==RECORD(I)
IF GDCT_MNEMONIC&MNMASK=MNEMONIC THEN GDCT_STATE=STATE<<4!DISCONNECTED
I=I+SLOT SIZE
REPEAT
FINISH ELSE GDCT_STATE=STATE<<4!DISCONNECTED
FINISH
->PRSTATUS
FINISH
IF TEXT="ON" START
IF STATE=DISCONNECTED THEN ->CDS ON
->PRSTATUS
FINISH
->ERR
GDC COMMAND(3): ! CDM dev1 dev2
MNEMONIC1=MNEMONIC
MNEMONIC2=TRANS MNEMONIC(TEXT)
J=SLOT; ! save 1st slot
UNLESS FIND(MNEMONIC2)<0 THEN ->ERR; ! already exists
SLOT=J
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE); ! remap target slot
IF MNEMONIC1>>8=M'ZX' START ; ! introduce device
I=MNEMONIC2>>8
FOR J=0,1,CDMDEVLIMIT CYCLE
IF I=CDMDEV(J) THEN ->IDEV
REPEAT
->ERR; ! invalid for CDM
IDEV:
GDCT_MNEMONIC=MNEMONIC2
GDCT_DEVTYPE=CDMDEVTYPE(J)
DEV_MNEMONIC=MNEMONIC2
IF CDMDEVTYPE(J)=LP START
DEV_UA SIZE=DEV_UA SIZE-256; ! TRTAB space
DEV_TRTAB AD=DEV_UA AD+DEV_UA SIZE
FINISH
DEV_TIMEOUT=CDMDEVTIMEOUT(J)&X'FFFF'
DEV_LOGMASK=CDMDEVTIMEOUT(J)>>16
IF CDMDEVTYPE(J)=FE THEN COM_FEPS=COM_FEPS!1<<(16+MNEMONIC2&15)
! FEP map
FINISH ELSE START ; ! take out device
UNLESS MNEMONIC2>>8=M'ZX' THEN ->ERR
UNLESS GDCT_STATE=DISCONNECTED THEN ->ERR
I=MNEMONIC1>>8
FOR J=0,1,CDMDEVLIMIT CYCLE
IF I=CDMDEV(J) THEN ->TOUT
REPEAT
->ERR
TOUT:
IF CDMDEVTYPE(J)=FE THEN COM_FEPS=COM_FEPS&(¬(1<<(16+MNEMONIC1&15)))
IF CDMDEVTYPE(J)=LP START
DEV_UA SIZE=DEV_UA SIZE+256; ! recover TRTAB space
DEV_TRTAB AD=0
FINISH
GDCT_MNEMONIC=MNEMONIC2
GDCT_DEVTYPE=ZX
FINISH
->PRSTATUS
GC4: ! ?
FOR SLOT=0,1,LASTSLOT CYCLE
STATUS(SLOT)
REPEAT
RETURN
!*
CDS ON:
BEGIN
IF SSERIES=YES START ; ! only on same DSS protem
CA==RECORD(DEV_CAA)
STRM=GDCT_DSSMM>>8&255
IF GDCT_UTAD=0 THEN ACTIVATE(X'03000000'!STRM,0,CA_IAWA) C
ELSE FIRE DCU2(GDCT_UTAD,0,RESET STREAM)
WAIT(10)
IF GDCT_DEVTYPE=FE START ; ! FEP needs send propcodes to wake it up
CCB==RECORD(DEV_MYCCBA)
CCB_COMMAND=X'2F40400E'; ! send propcodes
CCB_RESP=0
IF GDCT_UTAD=0 START ; ! DCU1
L=LENGTHENI(ADDR(CCB))<<32!X'01000000'!STRM
J=CA_IAWA
FOR I=1,1,COM_INSPERSEC CYCLE
*LB_J; *LSD_0; *L_(0+B ); *STUH_SINK
*JAT_4,<CDSOK>
REPEAT
->RESET CCB; ! fire fails so report not found
CDSOK:
*LSD_L; *ST_(0+B )
FINISH ELSE START ; ! DCU2
FIRE DCU2(GDCT_UTAD,ADDR(CCB),START STREAM)
FINISH
SLAVES ON OFF(0); ! slaves off
FOR I=1,1,COM_INSPERSEC*20 CYCLE
EXIT IF CCB_RESP#0
REPEAT
SLAVES ON OFF(-1); ! back on
RESETCCB:
CCB_COMMAND=X'2F00400A'; ! identify
IF CCB_RESP=0 START
REPLY(SRCE,"DCU: ".MTOS(MNEMONIC)." not found")
->RETURN
FINISH
FINISH
GDCT_STATE=GDCT_STATE>>4
OPMESS("DCU: ".MTOS(MNEMONIC)." now on DSS ".HTOS(GDCT_DSSMM>>8,3))
RETURN:
FINISH ELSE START
INTEGERFNSPEC FIND BYTE(INTEGER BYTE,ADDR,LEN)
RECORD (ALEF)ARRAYFORMAT ALEFF(0:3)
RECORD (ALEF)ARRAYNAME XALE
RECORD (CCB)NAME XCCB
RECORD (CAF)NAME XCA
RECORD (CASEF)NAME XSTREAM
OWNINTEGERARRAY XLBE(0:7)=C
X'00F10900',X'04F10800',X'04F00E00',X'00F00402',
X'80F02504',X'80F00106',X'82F00500',X'80F00106'
OWNINTEGERARRAY X(0:117)=0(*); ! needs to be %OWN for I/O (stack not 'fixed'!)
SWITCH CDS(0:7)
INTEGER XPT,XGPTSM,XPTS
INTEGER XSTRM,XA,XSLOT,XMNEMONIC,XDEVTYPE,XGDC,XCAA,XSTATE,XSRCE
INTEGER XCOUNT,XCART,XSTYLE,XLEN,XS
XA=ADDR(X(0)); ! set up CCB etc.
XCCB==RECORD(XA)
XCCB_LIMFLAGS=X'4000'; ! trusted chain
XCCB_LSTA=0
XCCB_LB S=32
XCCB_AL S=32
XCCB_AL A=XA+32
XALE==ARRAY(XCCB_AL A,ALEFF)
XALE(0)_S=8
XALE(0)_A=XA+64; ! propsdata
XALE(1)_S=12
XALE(1)_A=XA+72; ! sense data
XALE(2)_S=384
XALE(2)_A=XA+84; ! LP repertoire
XALE(3)_S=4
XALE(3)_A=XA+468; ! LP initword
! remember what we're looking for!
XSRCE=SRCE
XSLOT=SLOT
XMNEMONIC=MNEMONIC
XDEVTYPE=GDCT_DEVTYPE
XPTS=GDCT_PTSM>>4&X'FFF'
XGDC=0
GLOOP:
XPT=TABLE(16+XGDC)
IF RECONFIGURE=YES START ; ! SAC may be configured out
IF COM_NSACS=1 START
UNLESS XPT>>4=COM_SACPORT0 THEN ->SKIPG; ! SAC gone
FINISH
FINISH
XCAA=TABLE(8+XGDC)
XCA==RECORD(XCAA)
XSTRM=0
SLOOP:
XSTATE=-1; ! nothing fired
SLOT=CSTRM TO SLOT((XPT-LOCNO)<<4!XSTRM)
IF SLOT=255 THEN ->CONNECT
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE)
UNLESS GDCT_STATE&15=DISCONNECTED THEN ->SKIP
CONNECT:
! now found a strm that either has no slot
! associated with it or has a slot which
! has been disconnected
XSTREAM==XCA_STREAM(XSTRM)
X(16)=0
XSTATE=1; ! connect
XCOUNT=0; ! connect tries
->XFIRE
! response from connect
CDS(1):
IF X(16)>>24>0 START
! first byte of props data gives devtype,
! zero if no device
IF X(16)>>24=XDEVTYPE START
! dev of right type
! if MT, next byte gives cluster id
! if FE, next byte gives FE no.
! if SU, next byte gives SU no.
UNLESS (XDEVTYPE=MT AND XMNEMONIC&X'F00'#X(16)>>12 C
&X'F00') OR (XDEVTYPE=FE C
AND XMNEMONIC&15#X(16)<<8>>24) OR C
(XDEVTYPE=SU AND XMNEMONIC&15#X(16)<<8>>24) THEN ->XFOUND
FINISH
! if found a device of wrong type, disconnect it
XSTATE=0; ! disconnect
->XFIRE
FINISH ELSE IF XCOUNT=0 START ; ! 1st connect always fails for EMLAN feps!!
WAIT(10)
XCOUNT=1
->XFIRE
FINISH
! response from disconnect
CDS(0):
SKIP:
UNLESS XSTRM=14 THEN XSTRM=XSTRM+1 AND ->SLOOP
SKIPG:
UNLESS XGDC=NO OF GDCS-1 THEN XGDC=XGDC+1 AND ->GLOOP
REPLY(XSRCE,"GPC: ".MTOS(XMNEMONIC)." not found")
->RETURN
XFOUND:
REPLY(XSRCE,"GPC: ".MTOS(XMNEMONIC)." now on pts ".HTOS( C
XPT<<4!XSTRM,3))
CSTRM TO SLOT(XPTS-(LOCNO<<4))=255
CSTRM TO SLOT((XPT-LOCNO)<<4!XSTRM)=XSLOT
XGPTSM=(XGDC<<16)!(XPT<<8)!(XSTRM<<4)
FOR SLOT=0,1,LASTSLOT CYCLE
GDCT==RECORD(GDCT BASE+SLOT*SLOTSIZE)
IF (GDCT_PTSM>>4)&X'FFF'=XPTS START
! move everything on this PTS
DEV==RECORD(GDCT_DEVICE ENTRY A)
DEV_GPTSM=XGPTSM!(DEV_GPTSM&15)
GDCT_PTSM=DEV_GPTSM
DEV_CAA=XCAA
GDCT_STATE=GDCT_STATE>>4
FINISH
REPEAT
UNLESS XDEVTYPE=LP THEN ->XOUT
! first build a translate table in
! the device entry to filter out invalid characters
XCART=(X(17)>>16)&15
XA=REPERTOIRE A(XCART)
REP==ARRAY(XA,BIFT)
XS=REPERTOIRE S(XCART)
TRTAB==ARRAY(DEV_TRTAB AD,BIFT)
FOR I=0,1,255 CYCLE ; TRTAB(I)=I; REPEAT
UNLESS XCART=0 START
FOR I=0,1,255 CYCLE
IF FIND BYTE(I,XA,XS)<0 START
! not in rep
IF FIND BYTE(I,ADDR(LCLETTS(1)),26)<0 START
TRTAB(I)=LP ILLCHAR
FINISH ELSE START
TRTAB(I)=I!X'40'; ! make uc letter
FINISH
FINISH
REPEAT
TRTAB(37)=X'15'
TRTAB(21)=X'15'
TRTAB(12)=X'0C'; ! newline
TRTAB(13)=X'0D'
TRTAB(64)=X'40'; ! space
FINISH
! X(16) has bytes 0-3 of LP properties
! X(17) has bytes 4-5
! bottom 4 bits of byte 5 has cartridge number set on front of LP.
! if cartridge number is set zero, we don't load any rep if
! there's one already loaded, else we load the 64-char rep
! (being the first 64 chars of the 96-char rep above).
! if the cartridge number is :
! 2 we load the 48-char rep
! 3 we load the 384-char rep for the Bush estate 2980
! 4 we load the 64-char rep
! 5 we load the 96-char rep for the ERCC-KB 2972s
XSTYLE=X(16)&255
XLEN=(XSTYLE>>4)*10+XSTYLE&15
XLEN=66 IF XLEN=0
XLBE(6)=(XLBE(6)&(¬255))!(XLEN-1)
FOR I=0,XS,384-XS CYCLE
MOVE(XS,XA,ADDR(X(21))+I)
REPEAT
X(117)=LP ILLCHAR; ! back '?' for ERCC, autothrow not set
XSTATE=5; ! initialise outwards
->XFIRE
CDS(5): ! resp from init
IF XCART=0 AND X(17)&X'100000'=0 THEN ->CDS4
XSTATE=4; ! loadrep outwards
->XFIRE
CDS(4):CDS4: ! resp from load rep
X(117)=X'0000FC10'
XSTATE=7; ! another init
->XFIRE
CDS(7): ! resp from second init
IF XSTYLE=X'99' THEN ->XOUT
XSTATE=6; ! write control
->XFIRE
CDS(6):XOUT: ! resp from write control
->RETURN
XFIRE:
! needs XCAA, XSENT, XPT, XSTRM setting up outside
! uses XSTATE to select required command
IF XCA_PAW#0 START
PRINTSTRING("DT: ".DATE." ".TIME. C
" GPC--PAW not cleared - PT".HTOS(XPT,2).",PAW = ".HTOS(XCA_PAW,8)."
")
CONTROLLER DUMP(3,XPT)
->SKIPG; ! give up on this GPC
FINISH
XCCB_LBA=ADDR(XLBE(XSTATE))
SLAVES ON OFF(0); ! slaves off
*LXN_XCAA
*INCT_(XNB +0)
*JCC_8,<XGOT>
SEMALOOP(INTEGER(XCAA),2)
XGOT:
XCA_PAW=DO STREAM REQUEST!XSTRM
XSTREAM_SAW0=X'30000020'
XSTREAM_SAW1=ADDR(XCCB)
XSTREAM_RESP0=0
XCA_MARK=-1
I=X'40000800'!XPT<<16
*LB_I; *LSS_1; *ST_(0+B )
FOR I=1,1,COM_INSPERSEC*150 CYCLE ; ! wait about 1 sec
EXIT IF XSTREAM_RESP0#0
REPEAT
XCA_PIW0=XCA_PIW0&(¬(X'80000000'>>XSTRM));! no surprise ints.
XSTREAM_RESP0=0
SLAVES ON OFF(-1); ! back on
->CDS(XSTATE); ! process response
RETURN:
INTEGERFN FIND BYTE(INTEGER BYTE,ADDR,LEN)
INTEGER I
FOR I=0,1,LEN-1 CYCLE
IF BYTE=BYTEINTEGER(ADDR+I) THEN RESULT =I
REPEAT
RESULT =-1
END
FINISH
END
!*
!*
ROUTINE FAIL TRANSFER(RECORD (GDCTF)NAME GDCT,INTEGER SLOT)
! CA already mapped
RECORD (PARMF) Q
INTEGER I
IF SSERIES=NO START
INTEGER PT,STREAM
FINISH
IF SSERIES=NO OR (SSERIES=YES AND (GDCT_STATE=REQUEST FIRED OR C
GDCT_STATE=QUEUED OR GDCT_Q#0)) START
Q_DEST=GDCT_RESPONSE DEST
Q_SRCE=GDC DEST!6
Q_P1=ABNORMAL TERMINATION
BYTEINTEGER(ADDR(Q_P1))=SLOT+LOID
Q_P2=-1; ! timeout
Q_P3=GDCT_DEVICE ENTRY A
PON(Q)
FINISH
IF SSERIES=YES THEN GDCT_Q=0
UNLESS GDCT_STATE=QUEUED START
IF SSERIES=YES START
IF GDCT_UTAD#0 THEN FIRE DCU2(GDCT_UTAD,0,RESET STREAM) C
ELSE ACTIVATE(X'02000000'!GDCT_DSSMM>>8&255,0,CA_IAWA)
FINISH ELSE START
if multi ocp=yes then gdct_state=timed out
! to prevent ints. from stop/connect stream being passed on
! to adaptors if grabbed by the other OCP
PT=GDCT_PTSM>>8&255
STREAM=GDCT_PTSM>>4&15
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<CSEMAG>
SEMALOOP(CA_MARK,2)
CSEMAG:
IF CA_PAW#0 THEN CA_MARK=-1 AND PAW WAIT(CA)
CA_PAW=3<<24!STREAM
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
WAIT(10)
CONNECT STREAM(PT,ADDR(CA),STREAM,1)
FINISH
FINISH
GDCT_STATE=READY
END
!*
INTEGERFN FIND(INTEGER DEV)
INTEGER PTR
AGN:
PTR=GDCT BASE
FOR SLOT=0,1,LAST SLOT CYCLE
GDCT==RECORD(PTR)
IF DEV=LOID+SLOT OR DEV=GDCT_MNEMONIC C
OR (SSERIES=YES AND DEV=GDCT_DSSMM&X'FFFFF') OR C
(SSERIES=NO AND DEV=GDCT_PTSM&X'FFFF') C
OR (DEV=M'LP' AND GDCT_MNEMONIC>>8=M'LP' C
AND GDCT_PROPS03&X'80'=0 AND GDCT_STATE=NOT ALLOCATED) C
THEN RESULT =0
PTR=PTR+SLOT SIZE
REPEAT
IF DEV=M'LP' THEN DEV=M'LP0' AND ->AGN
RESULT =-1
END
!*
STRING (4)FN MTOS(INTEGER M)
INTEGER I,J
IF M>>24=0 THEN J=M<<8!X'20' ELSE J=M
IF SSERIES=YES THEN I=4 ELSE I=3
RESULT =STRING(ADDR(I)+3)
END
!*
ROUTINE REPLY(INTEGER SRCE,STRING (30)TEXT)
RECORD (PARMF) Q
Q=0
Q_DEST=SRCE
Q_TEXT<-TEXT
PON(Q)
END
!*
INTEGERFN STATE CHECK(INTEGER MNEMONIC,STATE)
RECORD (GDCT)NAME G
INTEGER I,PTR
IF MNEMONIC>>16=M'M' START ; ! check whole cluster
UNLESS MNEMONIC&255=M'0' START
IF SSERIES=YES THEN REPLY(SRCE,"DCU: must be MN0") ELSE C
REPLY(SRCE,"GPC: must be MN0")
RESULT =1
FINISH
PTR=GDCT BASE
FOR I=0,1,LAST SLOT CYCLE
G==RECORD(PTR)
IF G_MNEMONIC&MNMASK=MNEMONIC START
UNLESS G_STATE=NOT ALLOCATED START
IF SSERIES=YES THEN REPLY(SRCE,"DCU: ".MTOS(G_MNEMONIC)." state?") C
ELSE REPLY(SRCE,"GPC: ".MTOS(G_MNEMONIC)." state?")
RESULT =1
FINISH
FINISH
PTR=PTR+SLOT SIZE
REPEAT
RESULT =0
FINISH
RESULT =0 IF STATE=NOT ALLOCATED OR (STATE=READY AND MNEMONIC&MNMASK=M'OP0')
IF SSERIES=YES THEN REPLY(SRCE,"DCU: ".MTOS(MNEMONIC)." state?") C
ELSE REPLY(SRCE,"GPC: ".MTOS(MNEMONIC)." state?")
RESULT =1
END
!*
ROUTINE STATUS(INTEGER SLOT)
GDCT==RECORD(GDCT BASE+SLOT*SLOT SIZE)
IF SSERIES=YES START
REPLY(SRCE,"DCU: ".MTOS(GDCT_MNEMONIC)." ".HTOS(GDCT_DSSMM>>8&X'FFF',3). C
" ".STATES(GDCT_STATE&15))
FINISH ELSE START
REPLY(SRCE,"GPC: ".MTOS(GDCT_MNEMONIC)." ".HTOS(GDCT_PTSM>>4&X'FFF',3). C
" ".STATES(GDCT_STATE&15))
FINISH
END
!*
INTEGERFN TRANS MNEMONIC(STRINGNAME S)
INTEGER M,N
N=0
IF LENGTH(S)=3 START
STRING(ADDR(N))=S
BYTEINTEGER(ADDR(N))=0
FINISH ELSE IF LENGTH(S)=4 START
STRING(ADDR(M)+3)=S
FINISH
RESULT =N
END
IF SSERIES=YES START
ROUTINE ACTIVATE(INTEGER ACTWD,TCBAD,ISAD)
INTEGERNAME LINK
INTEGER I
IF MULTI OCP=YES START
*INCT_DCU1SEMA
*JCC_8,<SEMAGOT>
SEMALOOP(DCU1SEMA,0)
SEMAGOT:
FINISH
IF QHEAD=0 START ; ! no I/Os waiting to go
*LB_ISAD; *LSD_0; *L_(0+B ); *STUH_SINK
*JAT_4,<OK>
FOR I=1,1,COM_INSPERSEC CYCLE ; ! 10 millisecs approx
*LB_ISAD; *LSD_0; *L_(0+B ); *STUH_SINK
*JAT_4,<OKW>
REPEAT
->NOT OK
OKW: ACT CYCLES=ACT CYCLES+1
*LB_ISAD
OK:
*LSS_ACTWD; *LUH_TCBAD; *ST_(0+B )
IF MULTI OCP=YES START ; *TDEC_DCU1SEMA; FINISH
RETURN
FINISH
NOTOK:
ACTS QD=ACTS QD+1
I=1
LINK==QHEAD
WHILE LINK#0 CYCLE
QACT==PARM(LINK)
LINK==QACT_LINK
I=I+1
REPEAT
IF MAX Q<I THEN MAX Q=I
LINK=NEW PP CELL
IF MULTI OCP=YES START ; *TDEC_DCU1SEMA; FINISH
QACT==PARM(LINK)
QACT=0
QACT_ACTWD=ACTWD
QACT_TCBAD=TCBAD
QACT_ISAD=ISAD
END
ROUTINE FIRE DCU2(INTEGER UTAD,TCBAD,ACT)
INTEGER I
IF MULTI OCP=YES START
*INCT_DCU2SEMA
*JCC_8,<SEMAGOT>
SEMALOOP(DCU2SEMA,0)
SEMAGOT:
FINISH
*PRCL_4
*LSS_ACT
*SLSS_TCBAD; *LUH_X'2800000E'; *ST_TOS
*LDTB_X'B0000001'; *LDA_UTAD
*RALN_8
*CALL_(DR )
*ST_I
IF MULTI OCP=YES START ; *TDEC_DCU2SEMA; FINISH
UNLESS I=0 START
IF MULTI OCP=YES THEN RESERVE LOG
PRINTSTRING("DT: ".DATE." ".TIME. C
"DCU2 fire fails - resp = ".STRINT(I)." act = ".STRINT(ACT)."
Unit table:")
DUMPTABLE(0,UTAD,64)
PRINTSTRING("TCB:")
DUMPTABLE(0,TCBAD,14*4)
IF MULTI OCP=YES THEN RELEASE LOG
FINISH
END
ROUTINE FIRE IDENTIFY; ! GDCT & DEV mapped
RECORD (CCBF)NAME CCB
GDCT_ATTN=0
GDCT_STATE=IDENTIFY FIRED
CCB==RECORD(DEV_MYCCBA)
CCB_RESP=0
CA==RECORD(DEV_CAA)
IF GDCT_UTAD=0 THEN ACTIVATE(X'01000000'!STRM,ADDR(CCB),CA_IAWA) C
ELSE FIRE DCU2(GDCT_UTAD,ADDR(CCB),START STREAM)
DEV_SECS SINCE=0
END
FINISH ELSE START
!*
ROUTINE CONNECT STREAM(INTEGER PT,CAA,STREAM,CONNECT)
OWNRECORD (ALEF) ALE
OWNRECORD (CCBF)RCB
RECORD (CAF)NAME CA
RECORD (CASEF)NAME SENT
OWNINTEGER DIS LBE=0,CON LBE=X'00F10800'
INTEGER I,J,HI,LO
ALE_S=4; ALE_A=ADDR(DIS LBE); ! dummy
RCB_LIM FLAGS=PRIV ONLY
RCB_LBS=8
RCB_LBA=ADDR(DIS LBE)
RCB_ALS=8
RCB_ALA=ADDR(ALE)
DIS LBE=X'00F10900'!CONNECT<<26; ! chain on connect if req'd
IF STREAM<0 THEN LO=0 AND HI=14 ELSE LO=STREAM AND HI=STREAM
CA==RECORD(CAA)
SLAVESONOFF(0)
FOR J=LO,1,HI CYCLE
SENT==CA_STREAM(J)
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<SGOT>
SEMALOOP(CA_MARK,2)
SGOT:
CA_PAW=DO STREAM REQUEST!J
SENT=0
SENT_SAW0=X'30000020'
SENT_SAW1=ADDR(RCB)
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B )
FOR I=1,1,COM_INSPERSEC*2 CYCLE
EXIT IF SENT_RESP0#0
REPEAT
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<SGOT1>
SEMALOOP(CA_MARK,2)
SGOT1:
SENT_RESP0=0
CA_PIW0=CA_PIW0&(¬(X'80000000'>>J))
CA_MARK=-1
REPEAT
SLAVESONOFF(-1)
END
!*
INTEGERFN READ STREAM DATA(INTEGER PT, STREAM, CONTROLLER)
CONSTSTRING (24)ARRAY HEADER(0:2)="stream data", C
"stream controller status", C
"control stream status"
CONSTBYTEINTEGERARRAY COMMAND(0:2)=7,3,5
CONSTBYTEINTEGERARRAY LENGTH(0:2)=64,4,64
OWNINTEGERARRAY STREAM DATA(0:63)
INTEGER I,CAA,COUNT,GPCNO,SAWFLAGS,LEN
RECORD (CAF)NAME CA
GPCNO=CNO TO GDC(PT-LOCNO)
CAA=CAAS(GPCNO)
CA==RECORD(CAA)
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<CAG>
SEMALOOP(CA_MARK,2)
CAG:
IF CA_PAW#0 THEN CA_MARK=-1 AND PAW WAIT(CA)
SAWFLAGS=3; ! clear abn & inhibit term int
LEN=LENGTH(CONTROLLER)
CA_CRESP0=0
CA_PAW=DO CONTROLLER REQUEST
CA_CSAW0=SAWFLAGS<<28!COMMAND(CONTROLLER)<<24!STREAM<<16!LEN
CA_CSAW1=ADDR(STREAM DATA(0))
CA_MARK=-1
I=X'40000800'!PT<<16
*LB_I; *LSS_1; *ST_(0+B ); ! send channel flag
SLAVES ON OFF(0); ! slaves off
FOR COUNT=1,1,COM_INSPERSEC*5 CYCLE
EXIT IF CA_CRESP0#0
REPEAT
SLAVES ON OFF(-1); ! slaves back on
IF MULTIOCP=YES START ; RESERVE LOG; FINISH
PRINTSTRING("GPC ".HEADER(CONTROLLER)." pts=".HTOS(PT<<4! C
STREAM,3))
DUMP TABLE(-1,ADDR(STREAM DATA(0)),LEN)
PRINTSTRING("CRESP0=".HTOS(CA_CRESP0,8)); NEWLINE
IF MULTIOCP=YES START ; RELEASE LOG; FINISH
RESULT =STREAM DATA(0); ! useful if controller#0
END ; ! of READ STRM DATA
!*
ROUTINE PAW WAIT(RECORD (CAF)NAME CA)
! return with semaphore
INTEGER I
I=0
CYCLE
*LXN_CA+4; *INCT_(XNB +0); *JCC_8,<SG>
SEMALOOP(CA_MARK,2)
SG:RETURN IF CA_PAW=0
EXIT IF I>=5
CA_MARK=-1
I=I+1
WAIT(1)
REPEAT
PRINTSTRING("DT: ".DATE." ".TIME." GPC--PAW not cleared - PT". C
HTOS(PT,2).",PAW = ".HTOS(CA_PAW,8)."
")
END
!*
FINISH
!*
END ; ! of GDC
!*
IF SSERIES=NO START
EXTERNALINTEGERFN GPC INIT(INTEGER CAA,PT,FLAG)
RECORDFORMAT CA0F(INTEGER MARK,PAW,PIW0,PIW1,CSAW0,CSAW1,CRESP0,CRESP1)
RECORDFORMAT INIF(INTEGER PSTL,PSTB,CAA,SOE)
CONSTINTEGER REAL0AD=X'81000000'
CONSTRECORD (CA0F)NAME CA0=REAL0AD
RECORD (CAF)NAME CA
RECORD (INIF) INI
CONSTINTEGER INIT CONTROLLER=X'32000010'
CONSTINTEGER LOAD MICROPROGRAM=X'08000000'
!*
!* GPC microprogram follows as %OWNINTEGERARRAY GPCMPROG(0:511)
!* Program C03 patch level 5
ENDOFLIST
OWNINTEGERARRAY GPCMPROG(0:511)= C
X'F160F161',X'482049E0',X'4022802C',X'E80AF0C9',
X'000AD009',X'80054265',X'9320BE0A',X'100A8005',X'C213CAB3',
X'8025CA33',X'8223CA53',X'8275CAD3',X'8005CA93',X'80C2CA73',
X'8005CB34',X'8005CAF3',X'82FACAD4',X'80788005',X'C273C2D3',
X'80298005',X'C2B38213',X'8210182E',X'93088007',X'4820E00C',
X'740C500B',X'930FB725',X'F9C0F16C',X'DEEB21CC',X'EB4BE008',
X'29E82C8C',X'61CC2CAC',X'61EC4C6B',X'7968B795',X'F9C00CCC',
X'610CFC00',X'61ECFC00',X'70CC0825',X'818F8070',X'48400825',
X'C2D4CA93',X'804AA2D4',X'BC091005',X'CAD48059',X'C27383DC',
X'9062805F',X'B21AA27A',X'A29A82D9',X'B80983DF',X'10054989',
X'C2D48068',X'B2F4A2D4',X'C2F4B2F4',X'EA131013',X'C6732013',
X'98019205',X'98020835',X'C2738005',X'A2F44282',X'498C9205',
X'8005A83D',X'A9D4F3AC',X'DCAC200C',X'4BC0700E',X'090C4042',
X'B3ACE80E',X'240C5006',X'C00680B0',X'782CB795',X'F9C0A335',
X'AED45017',X'500C0C17',X'C073A9F4',X'F48C501F',X'640E080C',
X'500EC873',X'AAF40D15',X'500C4FE0',X'68972CF5',X'12E1EA57',
X'E017C274',X'80A6B795',X'F9C0A673',X'1059C033',X'80ACF800',
X'90BAC008',X'BA0ACAF4',X'80054065',X'80DC4BE0',X'BC0A100A',
X'4BC0C883',X'81229341',X'8180E41F',X'1122A150',X'C813A011',
X'A2D39320',X'BA0AF800',X'98019308',X'BC0A100A',X'A83D9316',
X'782CB795',X'F9C0A735',X'5017500C',X'0C17C073',X'AE93501F',
X'930F0D15',X'68972D15',X'12E1C033',X'80DCF800',X'90BAC008',
X'BA0AAB74',X'A2739341',X'82E1E006',X'5826EFF4',X'50085826',
X'32A82768',X'C014AEF4',X'9012ABF2',X'5826F177',X'F168FC00',
X'91972C37',X'C1A83C37',X'61770835',X'E40C6908',X'DFEC2173',
X'58260CF5',X'501F9341',X'82E1E018',X'5826F177',X'AEB49197',
X'58262C37',X'C1DAFC00',X'501F9341',X'82E1E419',X'6077A2B4',
X'F573F9C0',X'C21481B4',X'C1F4C9D4',X'82E10835',X'0C06C01F',
X'B3B7B01D',X'A15DA17D',X'A1B04298',X'A3144D81',X'10050905',
X'8180DEF3',X'200CEB6C',X'E00CF168',X'DDE321C8',X'486829E8',
X'2D4C632C',X'0C2C7B8C',X'0C2C70CC',X'0C0DC00E',X'4D00117D',
X'0C4C70AC',X'4920F56E',X'117D0C4C',X'70AC0C25',X'70C88180',
X'0C2C708C',X'48408170',X'0C2C70AC',X'0C257AC8',X'814B4840',
X'0C2C790C',X'920B817D',X'640F0815',X'F575117D',X'09150C1F',
X'C006920B',X'817D5C26',X'5004EBA4',X'E004920B',X'817D5C26',
X'9002ABE2',X'920B817D',X'5C26500D',X'EBADE01F',X'93478180',
X'E00D920B',X'81315406',X'500C49C0',X'C00C49E0',X'81314B20',
X'920B817D',X'4B00C0E3',X'817A6E2F',X'08104716',X'117D5E2F',
X'50108178',X'4840A500',X'11854840',X'9205A120',X'A1E0A2E4',
X'0C07C101',X'DDE321C0',X'4BE0C053',X'A011A3E9',X'A6D31005',
X'48409205',X'A2E4B160',X'A1E00C0B',X'C0C083E2',X'EB532418',
X'C01F541F',X'501DEBDD',X'42229801',X'C0FD9802',X'E00CA8EC',
X'DDF36A8C',X'EF5D200C',X'034C0CB5',X'732C28B5',X'EB5D2418',
X'C01F541F',X'501DC8FD',X'980126D3',X'119C0855',X'C9F48287',
X'C9D482B9',X'919782E1',X'0835F16C',X'DCFD21CC',X'C1FD81D7',
X'C23482E1',X'292CB67A',X'F9A0F17B',X'0C2C612C',X'FC006ACC',
X'498842A2',X'A21A4D8F',X'11D1498D',X'09B5A354',X'A233BC0A',
X'100A82E1',X'0855282C',X'CA3481E3',X'2CAC628C',X'2C2C62CC',
X'2C6C630C',X'FC00634C',X'C0DD81EA',X'A01FA03F',X'B3F70D75',
X'11FE0835',X'EB5D075A',X'C00CC7FD',X'706CC2B4',X'82E12419',
X'C00C582C',X'0C555017',X'500CA774',X'501F9341',X'82E1E41F',
X'60F74284',X'4983A754',X'10112895',X'2D1512E1',X'EA15E00C',
X'DCF5686C',X'E0159801',X'2887C007',X'98020887',X'9801B795',
X'F9C08217',X'DE5221D5',X'AB55A375',X'A315A335',X'906282F6',
X'82E3C053',X'A0110C13',X'C1D0A190',X'BA099801',X'B715F9C0',
X'AA33CA5A',X'A2F3CB54',X'8252CB14',X'8238C334',X'823FC2D3',
X'8232A633',X'10050855',X'AB34C29A',X'82F082F6',X'82F00835',
X'AB149242',X'82D92A35',X'ADB011B4',X'0835A735',X'12F6EA3B',
X'E01BF56C',X'689BC09D',X'AA9ADB7A',X'F55DC16C',X'DC6C216C',
X'C61A686C',X'CAF49801',X'9802C87D',X'921CAB54',X'924282D9',
X'C09D825F',X'C23AC19D',X'82ABA1D4',X'A69310C2',X'C0BD82D7',
X'C23AC19D',X'8266A693',X'10C2EB53',X'E00CCA3A',X'082C0C2C',
X'C1D3D9F3',X'1C2C200C',X'034C2D35',X'708C2CB5',X'11B982E1',
X'C87D921C',X'AA53C19D',X'827DA1F4',X'A69310C2',X'DDF3200C',
X'EB4C0753',X'C00C2DD5',X'708C0CB5',X'12E10833',X'919782E1',
X'0895C0DD',X'8293A01F',X'A03FB3F7',X'498B0955',X'A7541011',
X'EB5D075A',X'C00CC7FD',X'706CC2B4',X'82E12419',X'C00C582C',
X'0C555017',X'500CA774',X'501F9341',X'82E1E41F',X'60B7498B',
X'A7541011',X'2D1512E1',X'EB53E00C',X'CA3A082C',X'0C2CC1D3',
X'D9F31C2C',X'200C034C',X'2D35786C',X'82E128B5',X'919782E1',
X'C87D921C',X'C09D82CE',X'C19D82C4',X'A1D4A693',X'10C2DDF3',
X'200CEB4C',X'0753C00C',X'0CB5706C',X'82E10C33',X'12B809D5',
X'C0BD82D7',X'C19D82D5',X'A69310C2',X'AE3A1266',X'A51012DB',
X'A130A2F4',X'EA3BE411',X'F9000C1A',X'C1B082E8',X'498D9205',
X'CA138213',X'A2F4A130',X'A1F00C13',X'C1D0C053',X'A011AA73',
X'BA09A6D3',X'1011B170',X'0C1AC0F0',X'DCFA21B0',X'82EA9205',
X'A170A5F0',X'12DAAAF3',X'CAF48022',X'F17DF17F',X'B3D74284',
X'A33483D8',X'8005B715',X'F9C00C75',X'12F64BC0',X'740E5008',
X'C8089802',X'4BE08801',X'F08C640E',X'080C540E',X'500C4BE0',
X'98014043',X'B7AC131D',X'F3ACDCAC',X'200C090C',X'E80E200C',
X'98019316',X'084C540C',X'50061C4E',X'68669308',X'98016C2C',
X'0810640C',X'08114067',X'E00C540C',X'5006B806',X'640C0806',
X'930FB809',X'AAD3F170',X'C8114880',X'F1719803',X'229F283F',
X'A81FD83F',X'09159802',X'EA37E017',X'C43D62B7',X'4137413A',
X'EFB4787F',X'EBA40835',X'07BFC008',X'EFBF60A8',X'E4087088',
X'9801E008',X'0835A808',X'DFC82008',X'EE92787F',X'EA822008',
X'5C28500C',X'5008EE3F',X'900BC374',X'8368DEEC',X'787DDB6C',
X'E008EB74',X'0368B708',X'78689801',X'08353828',X'F0CCAA94',
X'C82CA294',X'EA3F2637',X'C0082828',X'C9A89801',X'EA28022C',
X'AFEB786C',X'98010835',X'C06B8385',X'C02B9801',X'A3EB540B',
X'900B837D',X'0835CA94',X'8395C02B',X'9801EA3F',X'C83DEA28',
X'E01FB34C',X'382CF1EB',X'D83F0875',X'328B9802',X'08354063',
X'2855C02B',X'98010875',X'E81FC83D',X'E008B2AC',X'382CF07F',
X'EA37241F',X'C00CABEB',X'F17EDD28',X'21DEEA8B',X'201E282C',
X'F168DD2C',X'21C8D928',X'2017B108',X'E8080017',X'B2A8E808',
X'000CFC00',X'716C583E',X'C03D285E',X'040C9016',X'C0369801',
X'FC007ACC',X'541E9008',X'C0289801',X'C81783CA',X'085EC83D',
X'289E200C',X'B12BE80B',X'0017EA88',X'E008A048',X'D82CC03D',
X'D83F32C8',X'08359802',X'A273F57A',X'F8604D8A',X'1005C334',
X'80058059',X'CAD4A274',X'8005AC53',X'118A0000',X'00000000'(9),
X'0000F2B2',X'B80AA213',X'498D9800',X'0C030005',X'F621BEA3'
LIST
!*
INTEGER ISA,I
ISA=X'40000800'!PT<<16
*LB_ISA; *LSS_2; *ST_(0+B ); ! master clear
WAIT(50)
IF FLAG=0 THEN SLAVES ON OFF(0); ! FLAG=1 if called from chopsupe
CA0=0
CA0_PAW=LOAD MICROPROGRAM
CA0_CSAW1=REALISE(ADDR(GPC MPROG(0)))
CA0_MARK=-1
*LB_ISA; *LSS_1; *ST_(0+B )
IF FLAG=0 THEN I=100*COM_INSPERSEC ELSE I=100000
I=I-1 UNTIL (CA0_CRESP0#0 AND CA0_MARK=-1) OR I<=0
IF CA0_CRESP0&NORMAL TERMINATION=0 START
IF FLAG=0 THEN SLAVES ON OFF(-1)
IF MULTI OCP=YES THEN RESERVE LOG
PRINTSTRING("DT: ".DATE." ".TIME." GPC--microprogram load fails
CA0:")
DUMPTABLE(0,REAL0AD,32)
IF MULTI OCP=YES THEN RELEASE LOG
RESULT =1<<24!CA0_CRESP0
FINISH
WAIT(50)
CA0=0
CA0_PAW=DO CONTROLLER REQUEST
CA0_CSAW0=INIT CONTROLLER
CA0_CSAW1=REALISE(ADDR(INI))
GET PSTB(INI_PSTL,INI_PSTB)
INI_CAA=CAA
INI_SOE=0
CA==RECORD(CAA)
CA=0
CA_MARK=-1
CA0_MARK=-1
*LB_ISA; *LSS_1; *ST_(0+B ); ! initialise
IF FLAG=0 THEN I=100*COM_INSPERSEC ELSE I=100000
I=I-1 UNTIL (CA_CRESP0#0 AND CA_MARK=-1) OR I<=0
IF FLAG=0 THEN SLAVES ON OFF(-1)
I=0
IF CA_CRESP0&NORMAL TERMINATION=0 START
IF MULTI OCP=YES THEN RESERVE LOG
PRINTSTRING("DT: ".DATE." ".TIME." GPC--INIT fails
CA0:")
DUMPTABLE(0,REAL0AD,32)
PRINTSTRING("CA:")
DUMPTABLE(0,INI_CAA,272)
PRINTSTRING("INI:")
DUMPTABLE(0,ADDR(INI),16)
IF MULTI OCP=YES THEN RELEASE LOG
IF CA_CRESP0=0 THEN I=2<<24!CA0_CRESP0 C
ELSE I=3<<24!CA_CRESP0
FINISH
CA_CRESP0=0
CA_MARK=-1
RESULT =I
END
FINISH
!*
IF CSU FITTED=YES START
EXTERNALROUTINE CSU(RECORD (PARMF)NAME P)
RECORDFORMAT DEVICE ENTRY F(INTEGER SER, GPTSM, PROPADDR, C
SECS SINCE, CA A, MYCCBA, LB A, AL A, X2, RESP0, C
RESP1, SENSE1, SENSE2, SENSE3, SENSE4, X3, X4, IDENT C
, X5, MNEMONIC, DEVICE ENTRY S, PAW, U SAW 0, C
U CCB A, SENSE DATA A, LOG MASK, TRTAB AD, UA SIZE, C
UA AD, TIMEOUT, PROPS0, PROPS1)
RECORD (PARMF) Q
RECORD (DEVICE ENTRY F)NAME DEV
SWITCH ACT(0:10)
OWNINTEGERARRAY DTODA(0:9)=NOT ALLOCATED(*)
CONSTINTEGER CSU SNO=CSU DEST>>16
IF KMONNING=YES AND KMON>>CSU SNO&1#0 THEN PKMONREC("CSU :",P)
RETURN ; ! ignore protem (or forever?)
->ACT(P_DEST&255)
ACT(0): ! initialise call from GDC
Q=0
Q_DEST=GDC DEST!11; ! allocate
Q_SRCE=P_DEST!1
Q_P1=P_P1
Q_P2=P_DEST!5; ! interrupts to ACT 5
PON(Q)
RETURN
ACT(1): ! reply from allocate
UNLESS P_P1=0 START ; ! failed
BYTEINTEGER(ADDR(P_P6))=3
OPMESS(STRING(ADDR(P_P6))." alloc fails ".HTOS(P_P1,1))
RETURN
FINISH
DEV==RECORD(P_P3)
DTODA(P_P6&255-'0')=P_P3
RETURN
ACT(2): ! deallocate
RETURN
ACT(3): ! deallocate reply
RETURN
ACT(5): ! interrupt from GDC
RETURN
ACT(6): ! switch device
RETURN
ACT(7): ! switch controller
RETURN
END
FINISH
ENDOFFILE