%EXTERNALSTRING (15) %FNSPEC STRINT(%INTEGER N)
%EXTERNALSTRING (8) %FNSPEC STRHEX(%INTEGER N)
%EXTERNALSTRING(8) %FNSPEC HTOS(%INTEGER VALUE,PLACES)
%EXTERNALROUTINESPEC PKMONREC(%STRING(20)TEXT,%RECORDNAME P)
%EXTERNALROUTINESPEC OPMESS(%STRING (63) S)
%EXTERNALROUTINESPEC MONITOR(%STRING (63) S)
%EXTERNALROUTINESPEC DUMP TABLE(%INTEGER T, A, L)
%ROUTINESPEC ELAPSED INT(%RECORDNAME P)
%SYSTEMROUTINESPEC MOVE(%INTEGER L,F,T)
%SYSTEMROUTINESPEC ETOI(%INTEGER A, L)
%ROUTINESPEC PDISC(%RECORDNAME P)
%EXTERNALROUTINESPEC HOOT(%INTEGER NHOOTS)
%EXTERNALROUTINESPEC WAIT(%INTEGER MSECS)
%EXTERNALINTEGERFNSPEC HANDKEYS
%EXTERNALINTEGERFNSPEC REALISE(%INTEGER PUBVIRTADDR)
%EXTERNALROUTINESPEC SLAVESONOFF(%INTEGER ONOFF)
%IF MULTIOCP=YES %THEN %START
%EXTERNALROUTINESPEC RESERVE LOG
%EXTERNALROUTINESPEC RELEASE LOG
%FINISH
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20J ONWARDS *
%RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C
DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C
DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, %C
TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,DQADDR, %C
%BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C
NOCPS,RESV2,OCPPORT1,OCPPORT0, %C
%INTEGER ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, %C
BLKADDR,RATION,SMACS,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,SP0,SP1, %C
SP2,SP3,SP4,SP5,SP6,SP7,SP8, %C
LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, %C
HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, %C
SDR4,SESR,HOFFBIT,S2,S3,S4,END)
!-----------------------------------------------------------------------
! PON & POFF ETC. DECLARATIONS
%RECORDFORMAT PARMF(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, %C
P6)
%CONSTLONGINTEGER NONSLAVED=X'2000000000000000'
%CONSTINTEGER PSTVA=X'80040000'
%CONSTINTEGER PPSEG=20
%CONSTINTEGER PCELLSIZE=36; ! NO OF BYTES FOR 1 PARAM CELL
%CONSTINTEGER MARGIN=48; ! MARGIN OF UNFORMATTED CELLS
%RECORDFORMAT PDOPEF(%INTEGER CURRMAX, MAXMAX, FIRST UNALLOC, %C
LAST UNALLOC, NEXTPAGE, S1, S2, S3, S4)
%OWNRECORDNAME PARMDOPE(PDOPEF)
%EXTERNALINTEGER PARMASL=0,MAINQSEMA=-1
%RECORDFORMAT PARMXF(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, %C
P6, LINK)
%OWNRECORDARRAYFORMAT PARMSPF(0:4095)(PARMXF)
%OWNRECORDARRAYNAME PARM(PARMXF)
%EXTERNALLONGINTEGER PARMDES
%OWNLONGLONGREAL GETNEWPAGE
%OWNRECORDNAME COM(COMF)
%RECORDFORMAT STOREF(%INTEGER FLAGLINK,BFLINK,REALAD)
%OWNRECORDARRAYFORMAT STOREAF(0:2047)(STOREF)
%OWNRECORDARRAYNAME STORE(STOREF)
%OWNINTEGERNAME STORESEMA
%CONSTSTRINGNAME DATE=X'80C0003F'
%CONSTSTRINGNAME TIME=X'80C0004B'
%CONSTINTEGER EPAGESIZE=4,TRANSIZE=1024*EPAGESIZE
%CONSTINTEGER LOCSN0=64
%CONSTINTEGER LOCSN1=LOCSN0+MAXPROCS
%CONSTINTEGER MAXSERV=LOCSN0+4*MAXPROCS
%RECORDFORMAT SERVF(%INTEGER P, L)
! L IS LINK IN CIRCULAR CHAIN OF
! SERVICES WHICH CONSTITUTE A QUEUE
! P IS POINTER TO CIRCULAR LIST
! OF PARAMETERS FOR THIS SERVICE
! 2**31 BIT OF P IS INHIBIT
! 2**30 OF P IS INTEROCP LOCKOUT
%EXTERNALRECORDARRAY SERVA(0:MAXSERV)(SERVF)
! LOCAL CONTROLLERS & USER SERVICES INHIBITED INITIALLY
%EXTERNALINTEGER KERNELQ=0, RUNQ1=0, RUNQ2=0
%RECORDFORMAT PROCF(%STRING (6) USER, %C
%BYTEINTEGER INCAR,CATEGORY, WSN, RUNQ, ACTIVE, %C
%INTEGER ACTW0, LSTAD, LAMTX, STACK, STATUS)
%EXTRINSICRECORDARRAY PROCA(0:MAXPROCS)(PROCF)
%IF MONLEVEL&2#0 %THEN %START
%EXTRINSICLONGINTEGER KMON
%FINISH
!-----------------------------------------------------------------------
%ROUTINE PUTONQ(%INTEGER SERVICE)
%RECORDNAME PROC(PROCF)
%RECORDNAME SERV, SERVQ(SERVF)
%INTEGERNAME RUNQ
SERV==SERVA(SERVICE)
%IF LOCSN0<SERVICE<=LOCSN1 %THEN %START
PROC==PROCA(SERVICE-LOCSN0)
%IF PROC_RUNQ=1 %C
%THEN RUNQ==RUNQ1 %ELSE RUNQ==RUNQ2
%IF RUNQ=0 %THEN SERV_L=SERVICE %ELSE %START
SERVQ==SERVA(RUNQ)
SERV_L=SERVQ_L
SERVQ_L=SERVICE
%FINISH
RUNQ=SERVICE %UNLESS PROC_STATUS&3#0 %AND RUNQ#0
! PRIORITY PROCS ON FRONT
%FINISH %ELSE %START
%IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSE %START
SERVQ==SERVA(KERNELQ)
SERV_L=SERVQ_L
SERVQ_L=SERVICE
%FINISH
KERNELQ=SERVICE
%FINISH
%END
!-----------------------------------------------------------------------
%EXTERNALINTEGERFN PPINIT(%INTEGERFN NEW EPAGE)
%INTEGERFNSPEC NEW EPAGE
%CONSTINTEGER PTSIZE=128; ! ALLOW 128K FOR PARM SPACE
%INTEGER I, J, CELLS, VI, PARMAD
%LONGINTEGER L
*LSQ_(%LNB+5)
*ST_GETNEWPAGE; ! STORE AWAY FN PARAM
COM==RECORD(X'80C00000'); ! FOR OTHER RTS TOO!
I=NEW EPAGE
VI=X'80000000'!(I+X'01000000')
STORE==ARRAY(COM_STOREAAD,STOREAF)
STORESEMA==INTEGER(COM_STOREAAD+8);! USE STORE(0)_REALAD AS SEMA
%IF MAXPROCS#COM_MAXPROCS %OR EPAGESIZE#COM_EPAGESIZE %THEN %C
PRINTSTRING("INCOMPATABLE COMPONENTS!!!
")
L=PTSIZE*8-1
L=X'4110000080000001'!L<<39!I
%IF MULTIOCP=YES %THEN L=L!NONSLAVED
! PAGE TABLE AT BEGINNING OF PPSEG
LONG INTEGER(PSTVA+8*PPSEG)=L
! ** NON SLAVED IN DUALS ???
%CYCLE J=0,1,COM_EPAGESIZE-1
INTEGER(VI+4*J)=X'80000001'!I+1024*J
%REPEAT
PARMAD=X'80000000'!PPSEG<<18+PTSIZE*4
PARM==ARRAY(PARMAD,PARMSPF); ! MAP ARRAY ONTO PARM SEGMNT
PARMDOPE==PARM(0); ! USE FIRST CELL FOR INFO
PARMDOPE_CURRMAX=1024*COM_EPAGESIZE-PTSIZE*4
PARMDOPE_MAXMAX=1024*PTSIZE-PTSIZE*4
CELLS=PARMDOPE_CURRMAX//PCELLSIZE-1; ! NO OF CELLS NOW AVAIABLE
PARMDOPE_FIRSTUNALLOC=CELLS-MARGIN+1
PARMDOPE_LAST UNALLOC=CELLS
PARMDOPE_NEXTPAGE=COM_EPAGESIZE
CELLS=CELLS-MARGIN; ! MARGIN OF "MARGIN" CELLS FOR TRYING
! TO OBTAIN FURTHER EPAGE
%CYCLE I=1,1,CELLS-1
PARM(I)_LINK=I+1
%REPEAT
PARM(CELLS)_LINK=1
PARMASL=CELLS
J=PARMAD
I=PARMDOPE_CURRMAX!X'18000000'
PARMDES=LONGINTEGER(ADDR(I)); ! DESCRPTR TO PP AREA
%RESULT =PARMAD
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE SEMALOOP(%INTEGERNAME SEMA)
!***********************************************************************
!* LOOP TILL A SEMA COMES FREE. MAXCOUNT IS LARGE ENOUGH SO THAT *
!* IT IS ONLY INVOKED WHEN ANOTHER OCP HAS GONE DOWN HOLDING A SEMA *
!***********************************************************************
%CONSTINTEGER MAXCOUNT=32000
%EXTERNALLONGINTEGER SEMATIME=0
%INTEGER I,J
*LSS_(5); *ST_J
%CYCLE I=1,1,MAXCOUNT
*INCT_(SEMA)
*JCC_7,<ON>
%IF MONLEVEL&4#0 %THEN %START
*LSS_(5); *IRSB_J
*IMYD_1; *IAD_SEMATIME; *ST_SEMATIME
%FINISH
%RETURN
ON: %REPEAT
SEMA=-1; ! FREE BEFORE MESSGE-MAY BE IOCP
! SEMA THAT IS HELD !
PRINTSTRING("
SEMA FORCED FREE AT ".STRHEX(ADDR(SEMA)))
%END
!-----------------------------------------------------------------------
%ROUTINE MORE PPSPACE
!***********************************************************************
!* CALLED WHEN PARM ASL IS EMPTY AND ATTEMPS TO GRAB A FREE EPAGE *
!* AND USE TO EXTEND THE (PAGED) PARAMETER PASSING AREA *
!* IF NO PAGE AVAILABLE IT TRIES TO USE ONE OF THE SMALL NO OF CELLS*
!* NOT FORMATTED INTO THE ORIGINAL LIST. THIS GIVES US A FAIR *
!* CHANCE OF FINDING A FREE EPAGE BEFORE DISASTER STRIKES *
!***********************************************************************
%INTEGER I, J, REALAD, PTAD, CELLS, FIRST, CMAX
%LONGLONGREAL X
*LSS_(3); *ST_I; ! ARE WE IN SYSTEM ERROR ROUTINE
! IE SYSTEM ERROR INTS MASKED
%IF I&1#0 %THEN ->TRY MARGIN; ! IF SO DO NOT TRY TO GET PAGE
CMAX=PARMDOPE_CURRMAX
%IF CMAX>=PARMDOPE_MAXMAX %THEN ->FAIL
X=GET NEW PAGE; ! 4 WORD RT PARAMETER !!
*PRCL_4
*LD_X
*LXN_X+12
*RALN_5
*CALL_(%DR)
*ST_I; ! 0 IF NO PAGE AVAIALBE
%IF I=-1 %THEN ->TRY MARGIN
REALAD=I!X'80000001'
PTAD=X'80000000'!PPSEG<<18+4*PARMDOPE_NEXTPAGE
!
! EXTEND PARM AREA BY 1 EPAGE BY ADDING ENTRIES INTO PAGE TABLE
!
!
%CYCLE I=0,1,COM_EPAGESIZE-1
INTEGER(PTAD+4*I)=REALAD+1024*I
%REPEAT
!
! ADJUST PARAM AREA DESCRIPTOR AND FORMAT UP NEW BIT OF PARMLIST
!
CMAX=CMAX+COM_EPAGESIZE*1024
PARMDOPE_CURRMAX=CMAX
CELLS=CMAX//PCELLSIZE-1
FIRST=PARMDOPE_FIRST UNALLOC
PARMDOPE_FIRST UNALLOC=CELLS-MARGIN+1
PARMDOPE_LAST UNALLOC=CELLS
PARMDOPE_NEXTPAGE=PARMDOPE_NEXTPAGE+COM_EPAGESIZE
CELLS=CELLS-MARGIN
%CYCLE I=FIRST,1,CELLS-1
PARM(I)_LINK=I+1
%REPEAT
PARM(CELLS)_LINK=FIRST
PARMASL=CELLS
INTEGER(ADDR(PARMDES))=X'18000000'!CMAX
%RETURN
TRY MARGIN:
!
! NO EPAGE AVAILABLE JUST NOW, USE ONE OF MARGIN CELLS
!
I=PARMDOPE_FIRST UNALLOC
%IF I>PARMDOPE_LAST UNALLOC %THEN ->FAIL
PARMDOPE_FIRST UNALLOC=I+1
PARM(I)_LINK=I
PARMASL=I
%RETURN
FAIL:
MONITOR("PARM ASL EMPTY")
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE PON(%RECORDNAME P)
%RECORDSPEC P(PARMF)
%RECORDNAME SERV,SERVQ(SERVF)
%RECORDNAME ACELL, SCELL, NCELL(PARMXF)
%INTEGER SERVICE, NEWCELL, SERVP, I
SERVICE=P_DEST>>16
%IF MONLEVEL&2#0 %AND SERVICE>MAXSERV %C
%THEN PKMONREC("INVALID PON:",P) %AND %RETURN
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN MORE PPSPACE
ACELL==PARM(PARMASL); ! ACELL =ASL HEADCELL
NEWCELL=ACELL_LINK
NCELL==PARM(NEWCELL); ! NCELL MAPPED ONTO NEWCELL
%IF NEWCELL=PARMASL %THEN PARMASL=0 %C
%ELSE ACELL_LINK=NCELL_LINK
NCELL<-P; ! COPY PARAMETERS IN
SERV==SERVA(SERVICE)
SERVP=SERV_P&X'3FFFFFFF'
%IF SERVP=0 %THEN NCELL_LINK=NEWCELL %ELSE %START
SCELL==PARM(SERVP)
NCELL_LINK=SCELL_LINK
SCELL_LINK=NEWCELL
%FINISH
I=SERV_P&X'C0000000'
SERV_P=I!NEWCELL
%IF I=0 %AND SERV_L=0 %START; ! Q IF NOT XECUTING OR INHBTD
%IF SERVICE>=LOCSN0 %THEN PUTONQ(SERVICE) %ELSE %START
%IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSE %START
SERVQ==SERVA(KERNELQ)
SERV_L=SERVQ_L
SERVQ_L=SERVICE
%FINISH
KERNELQ=SERVICE
%FINISH
%FINISH
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE FASTPON(%INTEGER CELL)
!***********************************************************************
!* CAN BE USED WHEN RECORD ALREADY IN PARAM TABLE TO AVOID COPY *
!* CELL IS NO OF ENTRY IN PARM HOLDING THE RECORD *
!***********************************************************************
%INTEGER SERVICE, SERVP, I
%RECORDNAME SERV,SERVQ(SERVF)
%RECORDNAME CCELL, SCELL(PARMXF)
CCELL==PARM(CELL)
SERVICE=CCELL_DEST>>16
SERV==SERVA(SERVICE)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<SSEMAGOT>
SEMALOOP(MAINQSEMA)
SSEMAGOT:
%FINISH
SERVP=SERV_P&X'3FFFFFFF'
%IF SERVP=0 %THEN CCELL_LINK=CELL %ELSE %START
SCELL==PARM(SERVP)
CCELL_LINK=SCELL_LINK
SCELL_LINK=CELL
%FINISH
I=SERV_P&X'C0000000'
SERV_P=I!CELL
%IF I=0 %AND SERV_L=0 %THEN %START
%IF SERVICE>=LOCSN0 %THEN PUTONQ(SERVICE) %ELSE %START
%IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSE %START
SERVQ==SERVA(KERNELQ)
SERV_L=SERVQ_L
SERVQ_L=SERVICE
%FINISH
KERNELQ=SERVICE
%FINISH
%FINISH
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE DPON(%RECORDNAME P, %INTEGER DELAY)
!***********************************************************************
!* AS FOR PON EXCEPT FOR A DELAY OF "DELAY" SECONDS. ZERO DELAYS *
!* ARE ALLOWED. ELAPSED INT IS USED TO KICK DPONPUTONQ *
!***********************************************************************
%RECORDSPEC P(PARMF)
%RECORD POUT(PARMF)
%RECORDNAME ACELL, NCELL(PARMXF)
%INTEGER SERVICE, NEWCELL
SERVICE=P_DEST>>16
%IF MONLEVEL&2#0 %AND SERVICE>MAXSERV %C
%THEN PKMONREC("INVALID DPON:",P) %AND WRITE(DELAY,4) %C
%AND %RETURN
%IF DELAY<=0 %THEN PON(P) %AND %RETURN
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN MORE PPSPACE
ACELL==PARM(PARMASL)
NEWCELL=ACELL_LINK
NCELL==PARM(NEWCELL); ! ONTO CELL IN FREELIST
%IF NEWCELL=PARMASL %THEN PARMASL=0 %C
%ELSE ACELL_LINK=NCELL_LINK
NCELL<-P
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
POUT_DEST=X'A0002'
POUT_SRCE=0
POUT_P1=X'C0000'!NEWCELL
POUT_P2=DELAY
PON(POUT)
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE DPONPUTONQ(%RECORDNAME P)
!***********************************************************************
!* SECOND PART OF DPON. THE DELAY HAS ELAPSED AND P_DACT HAS THE *
!* NUMBER OF A PPCELL SET UP READY FOR FASTPONNING *
!***********************************************************************
%RECORDSPEC P(PARMF)
%IF MONLEVEL&2#0 %AND KMON&1<<12#0 %THEN %C
PKMONREC("DPONPUTONQ:",P)
FASTPON(P_DEST&X'FFFF')
%END
!-----------------------------------------------------------------------
%EXTERNALINTEGERFN NEWPPCELL
!***********************************************************************
!* PROVIDE A PP CELL FOR USE ELSEWHERE THAN IN PON-POFF AREA *
!***********************************************************************
%INTEGER NEWCELL
%RECORDNAME ACELL(PARMXF)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN MORE PPSPACE
ACELL==PARM(PARMASL)
NEWCELL=ACELL_LINK
%IF NEWCELL=PARMASL %THEN PARMASL=0 %C
%ELSE ACELL_LINK=PARM(NEWCELL)_LINK
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%RESULT =NEWCELL
%END
!-----------------------------------------------------------------------
!%EXTERNALROUTINE POFF(%RECORDNAME P)
!!***********************************************************************
!!* REMOVE A SET OF PARAMATERS FROM THEIR QUEUE AND COPY THEM *
!!* INTO THE PARAMETER RECORD. THE SERVICE NO IS IN P_DEST AND AN *
!!* EMPTY OR INHIBITED QUEUE IS NOTIFIED BY RETURNING A ZERO P_DEST *
!!***********************************************************************
!%RECORDSPEC P(PARMF)
!%RECORDNAME SERV(SERVF)
!%RECORDNAME ACELL, CCELL, SCELL(PARMXF)
!%INTEGER SERVICE, CELL, SERVP
! SERVICE=P_DEST>>16
! %IF MONLEVEL&2#0 %AND(SERVICE<0 %OR SERVICE>MAXSERV) %C
! %THEN PKMONREC("INVALID POFF:",P) %AND P_DEST=0 %AND %RETURN
! %IF MULTIOCP=YES %THEN %START
! *INCT_MAINQSEMA
! *JCC_8,<SSEMAGOT>
! SEMALOOP(MAINQSEMA)
!SSEMAGOT:
! %FINISH
! SERV==SERVA(SERVICE)
! SERVP=SERV_P
! %IF SERVP<=0 %THEN P_DEST=0 %AND MAINQSEMA=-1 %AND %RETURN
! SCELL==PARM(SERVP)
! CELL=SCELL_LINK
! CCELL==PARM(CELL)
! P<-CCELL; ! COPY PARAMETERS OUT
! %IF CELL=SERV_P %THEN SERV_P=0 %ELSE SCELL_LINK=CCELL_LINK
! %IF PARMASL=0 %THEN CCELL_LINK=CELL %ELSE %START
! ACELL==PARM(PARMASL)
! CCELL_LINK=ACELL_LINK
! ACELL_LINK=CELL
! %FINISH
! PARMASL=CELL
! %IF MULTIOCP=YES %THEN MAINQSEMA=-1
!%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE SUPPOFF(%RECORDNAME SERV, P)
!***********************************************************************
!* A MORE EFFICIENT POFF FOR SUPERVISOR *
!* ASSUMES VITAL CHECKS HAVE BEEN DONE AND ALSO THAT CURRENT OCP *
!* HAS OBTAINED MAINQSEMA ! *
!***********************************************************************
%RECORDSPEC SERV(SERVF)
%RECORDSPEC P(PARMF)
%RECORDNAME ACELL, CCELL, SCELL(PARMXF)
%INTEGER CELL, SERVP
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
SERVP=SERV_P&X'3FFFFFFF'
SCELL==PARM(SERVP)
CELL=SCELL_LINK
CCELL==PARM(CELL)
P<-CCELL
%IF CELL=SERVP %THEN SERV_P=SERV_P&X'C0000000' %C
%ELSE SCELL_LINK=CCELL_LINK
%IF PARMASL=0 %THEN CCELL_LINK=CELL %ELSE %START
ACELL==PARM(PARMASL)
CCELL_LINK=ACELL_LINK
ACELL_LINK=CELL
%FINISH
PARMASL=CELL
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE RETURN PPCELL(%INTEGER CELL)
!***********************************************************************
!* RETURNS A CELL SUPLIED FOR OTHER PURPOSES VIA NEWPPCELL *
!***********************************************************************
%RECORDNAME ACELL, CCELL(PARMXF)
CCELL==PARM(CELL)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN CCELL_LINK=CELL %ELSE %START
ACELL==PARM(PARMASL)
CCELL_LINK=ACELL_LINK
ACELL_LINK=CELL
%FINISH
PARMASL=CELL
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE INHIBIT(%INTEGER SERVICE)
!***********************************************************************
!* INHIBIT A SERVICE BY SETTING TOP BIT IN SERV_P *
!***********************************************************************
%RECORDNAME SERV(SERVF)
%IF MONLEVEL&2#0 %AND(SERVICE<0 %OR SERVICE>MAXSERV) %C
%THEN PRINT STRING('INVALID INHIBIT: '.STRINT(SERVICE)."
") %AND %RETURN
SERV==SERVA(SERVICE)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<SSEMAGOT>
SEMALOOP(MAINQSEMA)
SSEMAGOT:
%FINISH
SERV_P=SERV_P!X'80000000'
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE UNINHIBIT(%INTEGER SERVICE)
!***********************************************************************
!* UNINHIBIT A SERVICE BY UNSETTING TOP BIT IN P_SERV AND ADDING *
!* ANY SERVICE CALLS TO APPROPIATE QUEUE *
!***********************************************************************
%RECORDNAME SERV(SERVF)
%IF MONLEVEL&2#0 %AND(SERVICE<0 %OR SERVICE>MAXSERV) %C
%THEN PRINT STRING('INVALID UNINHIBIT: '.STRINT(SERVICE)."
") %AND %RETURN
SERV==SERVA(SERVICE)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<SSEMAGOT>
SEMALOOP(MAINQSEMA)
SSEMAGOT:
%FINISH
SERV_P=SERV_P&X'7FFFFFFF'
%IF SERV_L=0 %AND 0<SERV_P<X'FFFF' %THEN PUTONQ(SERVICE)
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%EXTERNALROUTINE CLEAR PARMS(%INTEGER SERVICE)
!***********************************************************************
!* THROW AWAY ALL CELLS QUEUING FOR SERVICE EN BLOCK *
!* ALSO PRINT DISCARDED CELLS FOR INFORMATION *
!***********************************************************************
%RECORDNAME SERV(SERVF)
%INTEGER CELL, SERVP
SERV==SERVA(SERVICE)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<SSEMAGOT>
SEMALOOP(MAINQSEMA)
SSEMAGOT:
%FINISH
SERVP=SERV_P&X'3FFFFFFF'
%IF SERVP=0 %THEN MAINQSEMA=-1 %AND %RETURN
%IF MONLEVEL&2#0 %THEN %START
CELL=SERVP
%UNTIL CELL=SERVP %CYCLE
CELL=PARM(CELL)_LINK
PKMONREC("PARM CLEARED:",PARM(CELL))
%REPEAT
%FINISH
SERV_P=SERV_P&X'C0000000'
%IF PARMASL#0 %THEN CELL=PARM(SERVP)_LINK %C
%AND PARM(SERVP)_LINK=PARM(PARMASL)_LINK %C
%AND PARM(PARMASL)_LINK=CELL
PARMASL=SERVP
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%END
!-----------------------------------------------------------------------
%ROUTINE HAMMING(%INTEGER ONOFF)
!***********************************************************************
!* ON 2960 &2970 CAN TURN OFF HAMMING REPORTING IN OCP OR SMAC *
!* ON 2980 CAN ONLY DO IT IN SMAC. THIS ROUTINE CYCLES ROUND *
!* ALL THE SMACS SETTING & USETTING RIGHT BIT(DIFFERENT ON 2976) *
!***********************************************************************
%INTEGER I,J,K,SMAC
%CYCLE SMAC=0,1,15
%IF 1<<SMAC&COM_SMACS#0 %START; ! THIS SMAC EXISTS
J=COM_SESR!SMAC<<COM_SMACPOS
I=COM_HOFFBIT
K=\I
I=I&ONOFF
*LB_J
*LSS_(0+%B)
*AND_K
*OR_I
*ST_(0+%B)
%FINISH
%REPEAT
%END
%OWNINTEGER STORE RETRY COUNT=0, WAIT COUNT=1, RFLAGS=0, %C
OCP2 RETRY COUNT=0,OCP3 RETRY COUNT=0, ERRORS OFF=X'C02'
%EXTERNALROUTINE TURN ON ER(%RECORDNAME P)
!***********************************************************************
!* TURNS ON ERROR REPORTING AFTER TIME LAPSE *
!***********************************************************************
%INTEGER I, J, MYPORT
%CONSTSTRING(9)%ARRAY OMESS(0:3)="NO OCPS","OCP2","OCP3","BOTH OCPS";
%RECORDSPEC P(PARMF)
%CONSTINTEGER LAPSED MINS=20
%IF RFLAGS#0 %START
%IF RFLAGS&1#0 %THEN OPMESS("RETRY:-NO DMP IN SSN+1")
%IF RFLAGS&4#0 %THEN OPMESS("UNRECOVERED H-W ERRORS")
%IF RFLAGS&2#0 %THEN %START
OPMESS("HAMMING REPORTING OFF")
WAIT COUNT=10*LAPSED MINS
ERRORS OFF=ERRORS OFF!2
%FINISH
%IF RFLAGS&X'C00'#0 %START; ! ONE OR BOTH OCPS OFF
OPMESS("REPORTING OFF ".OMESS(RFLAGS>>10&3))
WAITCOUNT=10*LAPSED MINS
ERRORS OFF=ERRORS OFF!RFLAGS&X'C00'
%FINISH
RFLAGS=0
%FINISH
%IF WAITCOUNT#0 %THEN %START
%IF P_DEST&15=1 %THEN WAITCOUNT=WAITCOUNT-1 %C
%ELSE WAITCOUNT=0
%IF WAITCOUNT=0 %START
%IF ERRORS OFF&2#0 %START; ! TURN HAMMING ON
OPMESS("HAMMING REPORTING ON")
STORE RETRY COUNT=0
HAMMING(0)
ERRORS OFF=ERRORS OFF&(\2)
%FINISH
*LSS_(3); *USH_-26
*AND_3; *ST_MYPORT
%IF ERRORS OFF&(X'100'<<MYPORT)#0 %START
OPMESS("REPORTING ON OCP".TOSTRING(MYPORT+'0'))
%IF MYPORT=2 %THEN OCP2 RETRY COUNT=0 %ELSE %C
OCP3 RETRY COUNT=0
I=COM_INHSSR
J=I>>16; I=I&X'FFFF'
J=J!!(-1)
*LB_I; *LSS_(0+%B)
*AND_J; *ST_(0+%B)
%IF MULTIOCP=YES %AND COM_NOCPS>1 %START
ERRORS OFF=ERRORS OFF!!(X'100'<<MYPORT)
%IF ERRORS OFF#0 %THEN WAITCOUNT=1
%FINISH %ELSE ERRORS OFF=0
%FINISH
%FINISH
%FINISH
%END
%EXTERNALROUTINE ELAPSED INT(%RECORDNAME P)
!**********************************************************************
!* *
!* ELAPSED INTERVAL TIMER *
!* *
!* ACT 0 = CALL FROM RTC INTERRUPT HANDLER (CURRENTLY ONCE PER SEC) *
!* ACT 1 = Q/UNQ NOMINEE FOR KICK EVERY N SECONDS *
!* ACT 2 = Q NOMINEE FOR ONCE-OFF KICK IN N SECONDS *
!* *
!* WHERE : P_P1 IS ROUTINE TO BE KICKED *
!* : P_P2 IS (A) SECONDS TO ELAPSE BEFORE KICK (0<P_P2<X8000) *
!* OR (B) UNQ NOMINEE (P_P2 = -1,ACT 1 ONLY) *
!* : P_P3 IS PARAMETER RETURNED TO KICKED ROUTINE IN P_P1 *
!***********************************************************************
%ROUTINESPEC QUEUE
%ROUTINESPEC UNQUEUE(%INTEGER N)
%INTEGERFNSPEC SLOT(%INTEGER N)
%RECORDSPEC P(PARMF)
%RECORDFORMAT QF(%INTEGER DEST,KLOKTIKS,PARM,PROCNO,%STRING(7)USER, %C
%INTEGER P5,P6,LINK)
%RECORDNAME Q(QF)
%SWITCH ACT(0:2)
%INTEGER I, SRCE, PROCNO
%INTEGERNAME HEAD
HEAD==COM_ELAP HEAD
SRCE=P_SRCE
I=P_DEST&X'FFFF'
%IF MONLEVEL&2#0 %AND 1<<10&KMON# 0 %THEN %C
PKMONREC("ELAPSED INT:",P)
->ACT(I) %IF 0<=I<=2
%IF MONLEVEL&2#0 %AND I>2 %THEN %C
PKMONREC("ELAPSED INT REJECTS:",P)
%RETURN
ACT(0): ! RTC INTERRUPT
P_SRCE=P_DEST
I=HEAD
%WHILE I>0 %CYCLE
Q==PARM(I)
I=Q_LINK
%IF Q_DEST#0 %START
Q_KLOKTIKS=Q_KLOKTIKS-1
%IF Q_KLOKTIKS&X'FFFF'=0 %START
P_DEST=Q_DEST
P_P1=Q_PARM
!
! CHECK USER PROCESS HAS NOT LOGGED OFF AND IF SO CANCEL REQUEST
!
PROCNO=Q_PROCNO
%IF PROCNO=0 %OR Q_USER=PROCA(PROCNO)_USER %THEN %C
PON(P) %ELSE Q_KLOKTIKS=0
%IF Q_KLOKTIKS=0 %THEN UNQUEUE(Q_DEST) %C
%ELSE Q_KLOKTIKS=Q_KLOKTIKS!Q_KLOKTIKS>>16
%FINISH
%FINISH
%REPEAT
%RETURN
ACT(1): ! REQUEST TIMER INTERRUPT
%IF P_P2<0 %THEN UNQUEUE(P_P1) %AND %RETURN
ACT(2): ! ONE TIME ONLY
%RETURN %IF X'7FFF'<P_P2<1
%IF I=1 %THEN P_P2=P_P2<<16+P_P2
QUEUE
%RETURN
%ROUTINE QUEUE
%INTEGER CELL,PROCNO
%RETURN %IF SLOT(P_P1)#0; ! ALREADY Q'D
CELL=NEWPPCELL
Q==PARM(CELL)
Q_P6=0
Q_LINK=HEAD
PARM(HEAD)_P6=CELL
HEAD=CELL
Q_DEST=P_P1
Q_KLOKTIKS=P_P2
Q_PARM=P_P3
PROCNO=P_P1>>16-LOCSN0
%IF PROCNO<0 %THEN PROCNO=0 %ELSE PROCNO=PROCNO&(MAXPROCS-1)
Q_PROCNO=PROCNO
Q_USER=PROCA(PROCNO)_USER %IF PROCNO>0
%END
%ROUTINE UNQUEUE(%INTEGER N)
%INTEGER I
%RECORDNAME Q(QF)
I=SLOT(N)
%RETURN %IF I=0; ! NOT Q'D
Q==PARM(I)
%IF Q_P6=0 %THEN HEAD=Q_LINK %ELSE PARM(Q_P6)_LINK=Q_LINK
%IF Q_LINK#0 %THEN PARM(Q_LINK)_P6=Q_P6
RETURN PPCELL(I)
%END
%INTEGERFN SLOT(%INTEGER DEST)
%INTEGER I, J
I=HEAD
%WHILE I>0 %CYCLE
Q==PARM(I)
%RESULT =I %IF Q_DEST=DEST
I=Q_LINK
%REPEAT
%RESULT =0
%END
%END
%IF MULTIOCP=YES %THEN %START
%ROUTINE HALT OTHER OCP
%INTEGER I,HISPORT
*LSS_(3); *USH_-26
*AND_3; *NEQ_1
*ST_HISPORT
%IF COM_OCPTYPE<=3 %THEN %START
I=X'42086011'!HISPORT<<20
*LB_I; *LSS_X'80010000'
*ST_(0+%B); ! CLEAR SLAVES AND SUSPEND
%FINISH %ELSE %START
I=X'42000004'!HISPORT<<20
*LB_I; *LSS_4; ! ACC VALUE FOR RECORD INWD 9
*ST_(0+%B); ! SUSPEND
%FINISH
%END
%INTEGERFN GET BSEIP(%INTEGER FPN)
!***********************************************************************
!* AFTER A BROADCAST SYTEM ERROR THIS GETS THE PARAMETER *
!* FROM THE FAILING OCP *
!***********************************************************************
%INTEGER I
%IF COM_OCPTYPE<=3 %START; ! 2960S & 70S
I=X'42086302'!FPN<<20
*LB_I; *LSS_(0+%B); ! CLEAR OUT INT
*SBB_1; *LSS_(0+%B); ! GET PARAMETER
*EXIT_-64
%FINISH
I=X'42000003'!FPN<<20
*LB_I; *LSS_(0+%B)
*EXIT_-64
%END
%ROUTINE SEND MPINT TO SELF(%INTEGER MYPORT)
!***********************************************************************
!* USED AFTER A BROADCAST CATASTROPHIC ERROR TO SINGLE UP *
!***********************************************************************
%INTEGER I
%IF COM_OCPTYPE<=3 %START
I=(MYPORT!!1)<<20!X'420C6009'
*LSS_0; *ST_(0+%B); ! CLEAR HIS BCAST ERROR BIT
! ALSO MPINT TO ME
%FINISH %ELSE %START
*LSS_(X'4012'); *OR_X'200'
*ST_(X'4012'); ! SET MPIS BIT
%FINISH
%END
%ROUTINE RESTART OTHER OCP(%INTEGER PARAM)
!***********************************************************************
!* PARAM=0 THIS OCP WILL CONTINUE ALSO *
!* PARAM=1 THIS OCP WILL STOP(IDLE_DEAD) TELL OTHER OCP VIA MP INT *
!* THAT IT IS NOW ON ITS OWN AS A SINGLE SYSTEM *
!***********************************************************************
%INTEGER I,HISPORT
*LSS_(3); *USH_-26
*AND_3; *NEQ_1; *ST_HISPORT
%IF COM_OCPTYPE<=3 %THEN %START
I=X'42016011'!HISPORT<<20!PARAM<<18
*LB_I; *LSS_X'80010000'
*ST_(0+%B); ! CLEAR SLAVES&CONTINUE
! GIVES MP INT IF PARAM=1
%IF PARAM=0 %START
*LSS_1; *ST_(X'6009'); ! RESET BCAST SE INTS
%FINISH
%FINISH %ELSE %START
I=X'42000005'!HISPORT<<20
*LB_I; *LSS_5; ! ACC FOR WD9 IN DUMPS ONLY
*ST_(0+%B); ! RESTART
%IF PARAM#0 %START
*LSS_(X'4012')
*OR_X'100'
*ST_(X'4012'); ! SEND MP INT TO HIM
%FINISH
%FINISH
%END
%FINISH
%SYSTEMROUTINE STOP
%INTEGER I, W0, W1, W2, W3, W4, W5
%CONSTINTEGER RESTACK=X'80180000'
%CONSTINTEGER SEG10=X'80280000'; ! FOR COMMCN WITH DUMP RT
%CONSTINTEGER LCSTACK=0
*STSF_I
W1=I>>18<<18
%UNLESS W1<0 %OR W1=LCSTACK %START
*OUT_28; ! CAN HAPPEN
%FINISH
%IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN HALT OTHER OCP
I=COM_LSTL
*LB_I; *LSS_(0+%B); *ST_W2
I=COM_LSTB
*LB_I; *LSS_(0+%B); *ST_W3
*LSS_(3)
*ST_W0
W0=-(W0>>26&3); ! DUMMY SYSERR
! = - OCP PORT NO. FOR DUELS
*LXN_SEG10
*LSQ_(%XNB+0)
*ST_(%XNB+10) ; ! SYSERR TO OLDSE BIT
*LSQ_W0
*ST_(%XNB+0)
!
! NOW IF SUPERVISOR STOP SEG 10 IS SET UP AS IF WE HAVE HAD A DUMMY
! SYSTEM ERROR. A TAPE DUMP WILL THEN LOOK OK TO THE DUMP ANALYSER
!
HOOT(15)
%IF HANDKEYS&X'FFFF'#0 %START
W4=0; W5=RESTACK
*ACT_W2; ! DUMP TO TAPE VIA RESTART
%FINISH
*IDLE_X'DEAD'
%END; ! STOP
%EXTERNALROUTINE SYSERR(%INTEGER STK, IP)
!***********************************************************************
!* CALLED AFTER RECOVERED AND UNRECOVERED SYSTEM ERRORS *
!* IP=SYTEM ERROR INTERUPT PARAMETER. STACK =INTERUPTED SSN *
!***********************************************************************
%ROUTINESPEC PRINT PHOTO
%ROUTINESPEC RECONSTRUCT P4REGS
%ROUTINESPEC RESUME(%INTEGER MODE)
%ROUTINESPEC STORE ERROR(%INTEGER FC)
%CONSTSTRING(19)%ARRAY FCODE(0:3)="SOFTWARE ERROR",
"IRRECOVERABLE ERROR","SUCCESSFUL RETRY","UNSUCCESSFUL RETRY"
%SWITCH FAILURE(0:3)
%CONSTSTRING(7)%ARRAY CONT(0:3)="NOTHING"," SFC "," FPC2 "," GPC ";
%INTEGER I, J, K, FC, FPN, SACREG, TRUNK, ACT0, ACT1, ACT2, ACT3, %C
PHOTOAD, REGAD, REGPHOTO OFFSET, CONTYPE, OCPTYPE, MYPORT
%OWNBYTEINTEGERARRAY DEPTH(0:3)
%CONSTINTEGER ERR COUNT=8
%STRING(10)BCAST
%INTEGERNAME OCP RETRY COUNT
%CONSTINTEGER MIN SAC PORT=0,MAX SAC PORT=1
%CONSTINTEGER UNDUMPSEG=X'80280000',LCSTACK=0,%C
RESTACK=X'80180000'
FC=IP>>27&3
FPN=IP>>29
->RECURSIVE %IF DEPTH(FPN)#0
DEPTH(FPN)=1
OCPTYPE=COM_OCPTYPE; ! REFERENCED OFTEN SO PUT IN LOCAL
*LSS_(3); *USH_-26
*AND_3; *ST_MYPORT
BCAST=""
%IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN %START
%IF FPN=MYPORT!!1 %START; ! SE HAS BEEN BROADCAST
BCAST="BROADCCAST "
IP=GET BSEIP(FPN)
%FINISH %ELSE %START
HALT OTHER OCP
%FINISH
%FINISH
!
! 2980 HAS DIFFERENT FAILURE CODE TO 2970&2960. TRANSPOSE FC TO 70 MODE
!
%IF OCPTYPE=4 %OR OCPTYPE=6 %THEN FC=(X'1320'>>(4*FC))&15
SACREG=0
TRUNK=0
I=COM_LSTL
*LB_I ; *LSS_(0+%B)
*ST_ACT0
I=COM_LSTB
*LB_I ; *LSS_(0+%B)
*ST_ACT1
ACT2=0
ACT3=STK
NEWLINE
PRINT STRING(BCAST."SYSTEM ERROR INTERRUPT OCCURRED
PARAMETER ".STRHEX(IP)."
FAILING PORT NUMBER ".STRINT(FPN)."
".FCODE(FC)."
ACR LEVEL ".STRINT(IP>>20&15))
PRINTSTRING("
OLD STACK=".STRHEX(STK)."
")
!
! WORK OUT IF THERE WAS A DUMP IN SSN+1 AND/OR A PHOTO. IP IS DIFFERENT
! FOR DIFFERENT MEMBERS OF THE RANGE. WHEN THERE IS NO DUMP IN SSN+1
! TRY TO OBTAIN REGS FROM PHOTO SO DIAGNOSTICS ARE SENSIBLE.
!
REGAD=-1; PHOTOAD=-1
%IF OCPTYPE<=3 %THEN %START; ! P2 & P3
%IF IP&X'20000'=0 %AND BCAST="" %THEN REGAD=STK+X'40000'
%IF IP&X'40000'=0 %THEN PHOTOAD=X'81000100' %AND %C
REGPHOTOOFFSET=X'300'; ! NB P3 HAS PHOTO IN SMAC1 OPTION
! BUT EMAS DOES NOT ENABLE IT SO
! CAN FORGET IT. P2 HASNT OPTION
%IF FPN=3 %AND PHOTOAD#-1 %THEN PHOTOAD=PHOTOAD+X'700'
%FINISH %ELSE %START; ! P4S (INCL 2972 &2976)
%IF IP&X'30000'=X'10000' %AND BCAST="" %THEN %C
REGAD=STK+X'40000'
%UNLESS IP&X'30000'=0 %START; ! PHOT WITH SSN DUMP ON P4S
PHOTOAD=X'81000100'
REGPHOTO OFFSET=X'580'
%IF IP&X'30000'=X'30000' %THEN PHOTOAD=X'81400100'
%IF COM_NOCPS>1 %AND FPN=3 %AND PHOTOAD#-1 %THEN %C
PHOTOAD=PHOTOAD+4*X'600'
%FINISH
%FINISH
%IF REGAD=-1 %THEN PRINT STRING(" *****NO")
PRINT STRING(" DUMP IN SSN+1
")
%IF PHOTOAD=-1 %THEN PRINTSTRING("NO PHOTOGRAPH
") %ELSE PRINTSTRING("PHOTO SMAC".STRINT(PHOTOAD>>22&1)."
")
%IF REGAD=-1 %AND PHOTOAD#-1 %AND BCAST="" %START
%IF OCPTYPE>=4 %AND IP&X'18'#0 %AND %C
INTEGER(PHOTOAD+REGPHOTOOFFSET)=0 %THEN RECONSTRUCT P4REGS
PRINTSTRING("SSN+1 SET UP FROM PHOTO !
")
MOVE(64,PHOTOAD+REGPHOTO OFFSET,STK+X'40000')
%FINISH
!
! FIRST DEAL WITH SAC ERRORS. ALL ARE FULLY RECOVEREABLE
!
%IF MIN SAC PORT<=FPN<=MAX SAC PORT %START
PRINTSTRING("
SAC SYS INT=".STRHEX(SACREG))
I=X'44000000'!FPN<<20
*LB_I; *LSS_(0+%B); *ST_J
PRINTSTRING("
SAC PER INT=".STRHEX(J))
*LB_I; *ADB_X'200'; *LSS_(0+%B); *ST_J; *ST_SACREG
%IF SACREG>>16#0 %THEN %START
J=X'80000000'
%CYCLE I=0,1,15
%IF SACREG&J#0 %THEN %EXIT
J=J>>1
%REPEAT
TRUNK=I
%FINISH
PRINTSTRING("
SAC STATUS =".STRHEX(J))
CONTYPE=BYTEINTEGER(COM_CONTYPEA+TRUNK)
PRINTSTRING("
TRUNK ".STRINT(TRUNK)." HAS ".CONT(CONTYPE)." ON IT")
I=X'40000000'!FPN<<20!TRUNK<<16
*LB_I; *LSS_(0+%B); *ST_J
PRINTSTRING("
TRUNK ADDR REG - 0XX=".STRHEX(J))
*LB_I; *ADB_X'800'; *LSS_(0+%B); *ST_J
PRINTSTRING("
TRUNK CONTROL REG - 8XX=".STRHEX(J))
*LB_I; *ADB_X'C00'; *LSS_(0+%B); *ST_J
PRINTSTRING("
TRUNK STATUS REG - CXX=".STRHEX(J))
*LB_I; *ADB_X'D00'; *LSS_(0+%B); *ST_J
PRINTSTRING("
TRUNK DIAG STATUS REG - DXX=".STRHEX(J))
OPMESS("SAC SYSERROR TRUNK ".STRINT(TRUNK))
RESUME(2); ! WILL NOT RETURN
%FINISH
!
! IF IT WAS NOT A SAC ERROR IT MUST BE AN OCP ERROR. TREAT ALL 4 CASE
! DIFFERENTLY VIA THE SWITCH FAILURE
!
->FAILURE(FC)
FAILURE(2): ! ERROR RECOVERED BY H-WARE
%IF IP&X'20000'#0 %THEN RFLAGS=RFLAGS!1
%IF IP&X'C000'#0 %THEN %START
STORE ERROR(FC)
STORE RETRY COUNT=STORE RETRY COUNT+1
%IF STORE RETRY COUNT>=ERR COUNT %START
RFLAGS=RFLAGS!2
HAMMING(-1)
%FINISH
%FINISH %ELSE %START
PRINT PHOTO
%IF FPN=3 %THEN OCP RETRY COUNT==OCP3 RETRY COUNT %C
%ELSE OCP RETRY COUNT==OCP2 RETRY COUNT
OCP RETRY COUNT=OCP RETRY COUNT+1
%IF OCP RETRY COUNT>=ERR COUNT %START
RFLAGS=RFLAGS!X'100'<<FPN
J=COM_INHSSR
K=J>>16; J=J&X'FFFF'
*LB_J; *LSS_(0+%B)
*OR_K; *ST_(0+%B); ! SHUT UP ERROR REPORTING
%FINISH
%FINISH
RESUME(2); ! WILL NOT RETURN
FAILURE(1): ! UNRECOVEREABLE H-WARE
%IF IP&X'C000'#0 %START; ! HARD STORE ERROR
STORE ERROR(FC); ! MIGHT HELP ENGINEERS !
%FINISH
FAILURE(3): ! RETRY ALSO FAILED
PRINT PHOTO
RESUME(1); ! DOES NOT RETURN
FAILURE(0): ! SOFTWARE(MAY REALLY BE H-W
PRINT PHOTO
RESUME(0); ! CRASH
RECURSIVE:
*IDLE_X'DEAD'
%ROUTINE RESUME(%INTEGER MODE)
!***********************************************************************
!* MODE=0 SYSTEM MUST CRASH *
!* MODE=1 UNRECOVERED H-W FAULT. IN DUALS SINGLE UP *
!* IN SINGLES CRASH UNLESS IN USER *
!* MODE=2 RECOVERED BOTH OCPS TO RUN ON *
!***********************************************************************
%INTEGER I,J
%SWITCH SW(0:2)
->SW(MODE)
SW(2): ! RESTART BOTH OCPS
%IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN RESTART OTHER OCP(0)
DEPTH(FPN)=0
*ACT_ACT0; ! RESUME INTERRUPTED PROCESS
SW(1): ! OCP HAS HAD H-W ERROR
%IF MULTIOCP=YES %AND COM_NOCPS>1 %START
%IF FPN=MYPORT %START; ! I HAVE DIED
RESTART OTHER OCP(1); ! YO'RE ON YOUR OWN MATE!
%FINISH %ELSE %START; ! HE HAS DIED I'M OK
SEND MPINT TO SELF(MYPORT)
*ACT_ACT0; ! DONT CLEAR DEPTH
%FINISH
%FINISH %ELSE %START
!
! IF THE OLD STACK WAS A USER STACK WE CAN USE OUT 28 TO PASS
! CONTROL TO THE LOCAL CONTROLLER. THIS MAY KEEP SYSTEM RUNNING
!
%UNLESS STK<0 %OR STK=LCSTACK %START
RFLAGS=RFLAGS!4
INTEGER(STK!X'40044')=IP; ! STORE SEIP INWORD 17 OF SSN+1
DEPTH(FPN)=0
*OUT_28; ! TO LOCAL CONTROLLER
%FINISH
%FINISH
SW(0): ! CRASH NECESSARY
LONGLONGREAL(UNDUMPSEG+40)=LONGLONGREAL(UNDUMPSEG)
INTEGER(UNDUMPSEG)=IP
INTEGER(UNDUMPSEG+4)=STK
INTEGER(UNDUMPSEG+8)=ACT0
INTEGER(UNDUMPSEG+12)=ACT1
I=INTEGER(STK!X'40000'); ! OLD LNB FROM SSN+1
%IF REGAD=-1 %OR (BCAST#"" %AND PHOTOAD#-1) %THEN %C
I=INTEGER(PHOTOAD+REGPHOTO OFFSET)
*LSS_I
*ST_(%LNB+0) ; ! TO FRIG %MONITOR
%IF MULTIOCP=YES %AND BCAST#"" %START; ! MUST SWITCH LST BASE
I=INTEGER(X'80000000'+4*95+FPN<<18);! FAILING PROC FROM IST
%IF I#0 %START; ! THERE WAS A PROCESS
J=PROCA(I)_LSTAD
I=COM_LSTB
*LSS_J; *LB_I; *ST_(0+%B)
%FINISH
%FINISH
PRINTSTRING("DISASTER
")
%MONITOR
%IF HANDKEYS&X'FFFF'#0 %START
ACT3=RESTACK
*ACT_ACT0
%FINISH
HOOT(7)
*IDLE_X'DEAD'
%END
%ROUTINE STORE ERROR(%INTEGER FC)
!***********************************************************************
!* PRINT OUT AN ERROR REPORT FOR ALL SMACS. IF RECOVERED ERROR *
!* READ AND REWRITE DATA. MARK PAGE AS FLAWED BY SETTING TOP *
!* BIT OF THE REAL ADDRESS. PAGE MAY BE DISCARDED *
!***********************************************************************
%INTEGER I,J,K,AD,DR,SMAC
PRINTSTRING("
&& STORE ERROR SMAC STATUS REPORT AT ". %C
STRING(ADDR(COM_TIME0)+3)." ON ". %C
STRING(ADDR(COM_DATE0)+3)." SEIP = ".STRHEX(IP)."
SMAC DATAREG ADDRESS STATUS ENGSTATUS CONFIGN")
%CYCLE SMAC=0,1,15
%IF COM_SMACS&1<<SMAC#0 %START
NEWLINE; WRITE(SMAC,2)
J=COM_SDR1!SMAC<<COM_SMACPOS
*LB_J; *LSS_(0+%B); *ST_DR
PRINTSTRING(" ".STRHEX(DR))
J=COM_SDR2!SMAC<<COM_SMACPOS
*LB_J; *LSS_(0+%B); *ST_AD
PRINTSTRING(" ".STRHEX(AD))
J=COM_SDR3!SMAC<<COM_SMACPOS
*LB_J; *LSS_(0+%B); *ST_K
PRINTSTRING(" ".STRHEX(K))
J=COM_SESR!SMAC<<COM_SMACPOS
*LB_J; *LSS_(0+%B); *ST_K
PRINTSTRING(" ".STRHEX(K))
J=COM_SDR4!SMAC<<COM_SMACPOS
*LB_J; *LSS_(0+%B); *ST_K
PRINTSTRING(" ".STRHEX(K))
AD=AD&X'3FFFFFF'
%IF AD#0 %AND DR#0 %START
!
! AD HAS REAL ADDRESS OF FAILING WORD . MARK PAGE AS FLWED BY
! SETTING TOP BIT IN "REALAD" FIELD OF STORE ARRAY
!
J=AD&(\(1024*COM_EPAGESIZE-1))
%CYCLE I=0,1,COM_SEPGS-1
%IF STORE(I)_REALAD=J %THEN STORE(I)_REALAD %C
=J!X'80000000' %AND %EXIT
%REPEAT
!
! READ OUT AND REWRITE DATA FOR RECOVERED ERRORS ONLY !!!
!
%IF FC=2 %START
AD=(AD+X'01000000')!X'80000000'
*LXN_AD
*LSD_(%XNB+0)
*ST_(%XNB+0)
*ST_J; ! DOUBLE WORD AT FAILING ADDRSS
PRINTSTRING(" ".STRHEX(J).STRHEX(K))
%FINISH
%FINISH
%FINISH
%REPEAT
NEWLINES(2)
%END
%ROUTINE RECONSTRUCT P4REGS
!***********************************************************************
!* AFTER CERTAIN TIMEOUTS THE REGISTERS ON A P4 MUST BE DUG *
!* OUT OF THE PHOTO AS PER 4.2.4G SECTION 7.1.8 *
!***********************************************************************
%RECORDFORMAT REGFORM (%INTEGER LNB,PSR,PC,SSR,SF,IT,IC,CTB,%C
XNB,B,DR0,DR1,ACC0,ACC1,ACC2,ACC3)
%RECORDNAME REGS(REGFORM)
%INTEGER B,I
B=PHOTOAD-X'100'; ! BASE ADDRESS FOR DIGGING
REGS==RECORD(PHOTOAD+REGPHOTOOFFSET)
!
I=INTEGER(B+4*X'C0')
STK=(I&X'7FFE0000')<<1
REGS_LNB=STK!(I&X'FFFF')<<2
REGS_PSR=REGS_PSR!INTEGER(B+4*X'52')
REGS_PC=INTEGER(B+4*X'D4')&X'FFFC0000'! %C
INTEGER(B+4*X'D2')>>15<<1
REGS_SSR=INTEGER(B+4*X'54')
REGS_SF=STK!(INTEGER(B+4*X'C4')&X'FFFF')<<2
I=INTEGER(B+4*X'C6')
REGS_CTB=(I&X'7FFE0000')<<1!(I&X'FFFF')<<2
I=INTEGER(B+4*X'C2')
REGS_XNB=(I&X'7FFE0000')<<1!(I&X'FFFF')<<2
REGS_B=INTEGER(B+4*X'82')
REGS_DR0=INTEGER(B+4*X'8E')
REGS_DR1=INTEGER(B+4*X'90')
REGS_ACC0=INTEGER(B+4*X'200')
REGS_ACC1=INTEGER(B+4*X'202')
REGS_ACC2=INTEGER(B+4*X'204')
REGS_ACC3=INTEGER(B+4*X'206')
%END
%ROUTINE PRINT PHOTO
!***********************************************************************
!* PRINTS THE PHOTOGRAPH AND OTHER BITS NOT REQUIRED *
!* IN SINGLE BITE ERROR REPORTIN *
!***********************************************************************
%CONSTHALFINTEGERARRAY PHOTOL(0:6)=0,X'700'(3),X'1400'(2),X'800';
!
! THE FOLLOWING ARRAYS DECODE THE BOTTOM 16 BITS OF THE SYSTEM ERROR
! PARAMETER TO TEXT. SEMESS HAS THE TEXT: SWPTR&HWPTR HAS ARRAYS OF POINTERS
! THIS TECHNIQUE IS NEEDED AS HARDWARE ERRORS ARE NONSTANDARD
! OCPTYPES SIGNIFY 2=2960,3=2970,4=2980,5=NOTUSED,6=2972(2976)
!
%CONSTSTRING(15)%ARRAY SEMESS(0:40)="",
"ILLEGAL VSI",
"MASKED VS INT",
"MASKED PE INT",
"MASKED SC INT",
"MASKED OUT INT",
"MASKED XCDE INT",
"SSN ERROR",
"SEG TABLE ERROR",
"SOFTWARE SE INT",
"ACTIVATE ACS=0",
"SPARE AS YET",
"STORE FAIL",
"HAMMING ERROR",
"STORE TIMEOUT",
"OCP TIMEOUT",
"ANY TIMEOUT",
"SAC TIMEOUT",
"AGU DATA ERROR",
"AGU CNTRL ERROR",
"ARU DATA ERROR",
"ARU CNTRL ERROR",
"INSTRN PARITY",
"AGU FN PARITY",
"STK SLAVE FAIL",
"INSN SLAVE FAIL",
"SMAC0 FAIL",
"TRANSLATN FAIL",
"FETCH FAIL",
"MODIFY FAIL",
"OPERAND FAIL",
"STRING FAIL",
"WRITE FAIL",
"SYSTEM TIMEOUT",
"UNDOCMTD ERROR?",
"DECODER P E",
"ENGINE ERROR",
"DATA PROG ERROR",
"SAU ERROR",
"MPROG ERROR",
"DISPLMNT FAIL";
%CONSTBYTEINTEGERARRAY SWSEPTR(16:25)=%C
1,2,3,4,5,6,7,8,9,10; ! NEAR ENOUGH RANGE STANDARD!
%CONSTBYTEINTEGERARRAY HWSEPTR(2:6,16:30)=%C
12, 12, 12, 34, 12,
13, 13, 26, 34, 26,
35, 14, 27, 34, 27,
38, 15, 28, 34, 28,
14, 16, 40, 34, 40,
15, 17, 24, 34, 24,
36, 18, 29, 34, 29,
37, 19, 30, 34, 30,
39, 20, 21, 34, 21,
34, 21, 31, 34, 31,
34, 22, 32, 34, 32,
34, 23, 16, 34, 16,
34, 24, 33, 34, 33,
34, 25, 34, 34, 34,
34, 34, 34, 34, 34;
%INTEGER I,J
%IF FC=0 %THEN %START; ! SOFTWARE ERROR
%CYCLE I=16,1,25
%IF IP&X'80000000'>>I#0 %THEN %C
PRINTSTRING(SEMESS(SWSEPTR(I))) %AND NEWLINE
%REPEAT
%FINISH %ELSE %START; ! HARDWARE ERRORS
%CYCLE I=16,1,30
%IF IP&X'80000000'>>I#0 %THEN %C
PRINTSTRING(SEMESS(HWSEPTR(OCPTYPE,I))) %AND NEWLINE
%REPEAT
%FINISH
%IF PHOTOAD=-1 %THEN %RETURN; ! NO PHOTO TAKEN
%UNLESS FC=2 %OR (FC#0 %AND (STK>LCSTACK %OR COM_NOCPS>1)) %C
%THEN %RETURN; ! PRINT PHOTO ONLY IS SYSTEM
! IS LIKELY TO RUN ON. OTHERWISE
! LEAVE BUFFER SPACE FOR DIAGS
PRINTSTRING("PHOTOGRAPH AREA
")
J=PHOTOL(OCPTYPE)
DUMP TABLE(0,PHOTOAD,J)
%RETURN %UNLESS FC=2
%IF OCPTYPE=3 %START; ! UNINHIBIT PHOTO
*LSS_(X'6011'); *AND_X'FFFE'; *ST_(X'6011')
%FINISH
%IF OCPTYPE=4 %OR OCPTYPE=6 %START
*LSS_(X'4012'); *AND_X'FEFFFFFF'; *ST_(X'4012')
%FINISH
*LDTB_X'18000000'; *LDB_J
*LDA_PHOTOAD; *MVL_%L=%DR,0,0
%END
%END
!-----------------------------------------------------------------------
%CONSTINTEGER RFB=X'400',AFB=X'800',AFA=X'100', %C
CLEAR RFB AND AFA=X'500'
%EXTERNALINTEGER NORFBS=0
%INTEGERFN WAIT ARFB(%INTEGER PTS,RFB OR AFB,CMD)
!***********************************************************************
!* WAIT FOR RFB OR AFB ON SPECIFIED TRUNK. ARRANGE FOR TIME OUT *
!***********************************************************************
%INTEGER I,Q,ISA
ISA=PTS!X'40000E00'
Q=100
AGN:
*LB_ISA
*LSS_(0+%B)
*ST_I
Q=Q-1
->AGN %UNLESS Q=0 %OR I&RFB OR AFB#0
%IF Q=0 %START
%IF NORFBS<25 %THEN %C
PRINTSTRING("NO R/AFB ".HTOS(CMD,8)." ".HTOS(I,8)."
")
NORFBS=NORFBS+1
%FINISH
%RESULT=I
%END
%ROUTINE INTO DCM(%INTEGER PTS)
%CONSTINTEGER WAITLOOP=100
%INTEGER I,ISA,J
ISA=X'40000800'!PTS
*LB_ISA; *LSS_(0+%B); ! THIS CLEARS STOGGLE IF SET !!
*LSS_3; *LB_ISA; *ST_(0+%B); ! SUSPEND
%CYCLE I=1,1,WAITLOOP; %REPEAT
!
! NOW INTO DIRECT CONTROL MODE
!
ISA=X'40000D00'!PTS
*LB_ISA
*LSS_X'400'; *ST_(0+%B)
ISA=X'40000800'!PTS
*LSS_3; *LB_ISA; *ST_(0+%B)
ISA=X'40000E00'!PTS
%CYCLE I=1,1,WAITLOOP; %REPEAT
*LB_ISA; *LSS_(0+%B); *ST_I
J=0
%WHILE I&RFB#0 %AND J<WAITLOOP %CYCLE;! TRUNK CYCLE OUTSTANDING
*LB_ISA; *LSS_AFA; *ST_(0+%B)
*LB_ISA; *LSS_(0+%B); *ST_I
J=J+1
%REPEAT
%END
%ROUTINE OUT OF DCM(%INTEGER PTS)
%INTEGER ISA
ISA=X'40000E00'!PTS
*LB_ISA; *LSS_X'1E12'; *ST_(0+%B)
*SBB_X'100'; ! B TO D00
*LSS_0; *ST_(0+%B); ! UNSET DCM
%END
%EXTERNALINTEGERFN CONTROLLER DUMP(%INTEGER CONTYPE,PT)
%ROUTINESPEC WRITE16(%INTEGER REG)
%ROUTINESPEC DWRITE16(%INTEGER REGDATA)
%IF SFC FITTED=YES %THEN %START
%INTEGERFNSPEC READ32(%INTEGER REG)
%FINISH
%INTEGERFNSPEC DREAD16(%INTEGER REG)
%INTEGERFNSPEC READ16(%INTEGER REG)
%ROUTINESPEC PRINT(%INTEGER AD,N,PL)
%ROUTINESPEC SEQREG(%INTEGER F,S,L,SH,PL,%INTEGERFN GET)
%ROUTINESPEC PRINT BFUNS(%INTEGER F,L)
%ROUTINESPEC SQPRINT(%INTEGER F,L)
%ROUTINESPEC CHANGE STREAM(%INTEGER STRM)
%ROUTINESPEC PSTRMS(%INTEGER FIRST,LAST)
%INTEGERFNSPEC READSPAD(%INTEGER SPAD)
%CONSTSTRING(4)%ARRAY CNAMES(1:3)="SFC ","DFC ","GPC ";
%INTEGERARRAY DAT(0:7),ATUS(0:127)
%CONSTHALFINTEGERARRAY BFUNS(0:46)=X'9180',X'9181',X'9182',X'9183',
X'91D0',X'91D1',X'91D2',X'91D3',
X'91D4',X'91D5',X'91D6',X'91D7',
X'9380',X'9388',X'9389',X'938A',
X'938B',X'938C',X'938D',X'938E',
X'938F',X'9390',0,0,
X'9740',X'9340',X'9400',X'9000',
X'9500',X'9100',X'9580',X'9180',
X'9600',X'9200',X'9640',X'9240',
X'9680',X'9280',X'96C0',X'92C0',
X'9700',X'9300',X'9780',X'9380',
X'97C0',X'93C0',X'FFFF';
%CONSTINTEGERARRAY SSPAD(0:8)=X'6001',X'F810',X'3921',X'6000'(2),
X'800097C0',X'800093C0',X'3921'(2);
%SWITCH SW(1:3)
%STRING(4) CNAME
%INTEGER I,RES,PTS,J,K,L,R388,MPLDREG,RESULT
%RESULT=-1 %UNLESS 1<=CONTYPE<=3
RESULT=0
CNAME=CNAMES(CONTYPE)
%IF MULTIOCP=YES %THEN RESERVE LOG
PRINTSTRING("
&& DUMP OF ".CNAME.HTOS(PT,2)." ".DATE." ".TIME)
NEWLINE
NEWLINE
NORFBS=0
PTS=PT<<16
INTO DCM(PTS)
->SW(CONTYPE)
SW(1): ! SFC
%IF SFC FITTED=YES %THEN %START
PRINTSTRING(" A ".HTOS(READ32(X'5000'),8)."
TINC ".HTOS(READ32(X'52E0'),8)."
TINCPAR ".HTOS(READ32(X'52E9'),8)."
REGISTERS:-
")
DAT(0)=READ16(X'5800')>>16
%CYCLE I=1,1,127; ! 64 32 BIT REGISTERS
! AUTOMATIC SEQUENCING
J=I&7
DAT(J)=WAITARFB(PTS,RFB,X'5800')>>16
*LSS_CLEAR RFB AND AFA; *LB_PTS
*ADB_X'40000E00'; *ST_(0+%B);! SEND AFA
%IF J=7 %THEN PRINT(I-J,J,4)
%REPEAT
SEQREG(X'9800',16,X'98F0',0,8,READ32)
SEQREG(X'9200',1,X'93FF',0,8,READ32)
->WAYOUT
%FINISH
SW(2): ! DFC
PRINT BFUNS(0,21)
->WAYOUT %IF NORFBS>2
NEWLINES(2)
SEQREG(X'5000',1,X'5316',16,4,DREAD16)
NEWLINES(3)
SEQREG(X'5328',1,X'59FF',16,4,DREAD16)
!
! READ OUT 256 CONTROLLER SPADS AFTER STOPPING THE CLOCK (20F 2**7 BIT)
!
PRINTSTRING("
CNTRLR SPADS
")
DWRITE16(X'A20F0080')
SEQREG(0,1,255,0,4,READSPAD)
!
! READ OUT 32 STREAM SPADS FOR FIRST 8 STREAMS
! SECOND 8 STREAMS IN X300 TO X3FF BUT I DONT KNOW HOW TO TELL
! IF DFC HAS THE EXTENDED OPTION! ANSWER FROM DFC EXPERT:-
! READ 9388 IF 2**11 BIT SET THEN N0 EXTENDED OPTION
! 9388 READ AND SAVED BY PRINT BFUNS
!
J=15; %IF R388&X'800'#0 %THEN J=7
%CYCLE K=0,1,J
PRINTSTRING("
SPADS FOR STRM")
WRITE(K,1)
NEWLINE
SEQREG(X'200'+32*K,1,X'21F'+32*K,0,4,READSPAD)
%REPEAT
!
! READ OUT 2 ATUS
!
%CYCLE I=1,1,2
%CYCLE J=0,1,15
DWRITE16((X'A8C6'-2*(I-1))<<16!J<<12)
K=READ16(X'5886'-2*(I-1))
L=READ16(X'588E'-2*(I-1))
ATUS(16*I+J)=K&X'FFFF0000'!L>>16
%REPEAT
%REPEAT
PRINTSTRING("
REG ATU 1 ATU 2
")
SQPRINT(1,2)
PRINTSTRING("
LBE BUFFER
")
DWRITE16(X'A4FC0000')
%CYCLE I=1,1,4
DWRITE16(X'A4D80000')
DWRITE16(X'A4C10000')
%REPEAT
%CYCLE I=0,1,3
DWRITE16(X'A4CE0000')
%CYCLE J=0,1,7
DWRITE16(X'A40C0080')
DAT(J)=READ16(X'54D4')>>16
%REPEAT
PRINT(8*I,7,4)
DWRITE16(X'A40C0080')
DWRITE16(X'A4C90000')
%REPEAT
DWRITE16(X'61080000'); ! WRITE DIRECT TO REG 108
! ZEROS TO CLEAR CONFUSED
DWRITE16(X'A378FFFF'); ! CLEAR SYS ERRORS
! REGISTERED IN PROGRAM CONTROLL
RESULT=MPLDREG
%IF MPLDREG#X'0080' %THEN DWRITE16(X'A10F0000')
->WAYOUT
SW(3): ! GPC
PRINT BFUNS(24,46)
NEWLINE
SEQREG(X'5000',1,X'503F',16,4,READ16)
SEQREG(X'5430',1,X'5433',16,4,READ16)
->WAYOUT %UNLESS NORFBS=0; ! LITTLE POINT IN CONTINUING
%CYCLE I=1,1,3
J=READ16(X'5039')>>16
%IF J&7=6 %THEN %EXIT; ! GPC IN DIAGNOSTIC STATE
PRINTSTRING("REG039=".HTOS(J,4)."
")
WRITE16(X'3921'); ! TRY TO STEP IT INTO NEXT STATE
%REPEAT
RES=0
%CYCLE I=0,1,15
CHANGE STREAM(I)
%CYCLE J=0,1,15; ! 15 REGS FOR EACH STRM
%CYCLE K=0,1,8
L=SSPAD(K)
%IF L=X'F810'%THEN L=L+J
%IF L<0 %THEN RES=RES<<16!READ16(L)>>16 %ELSE WRITE16(L)
%REPEAT
ATUS(16*(I&7)+J)=RES
%REPEAT
PSTRMS(I-7,I) %IF I&7=7
%REPEAT
WAYOUT:
PRINTSTRING("
".CNAME."DUMP ENDS
")
%IF MULTIOCP=YES %THEN RELEASE LOG
OUT OF DCM(PTS)
%RESULT=RESULT
%ROUTINE PSTRMS(%INTEGER FIRST,LAST)
%INTEGER I
PRINTSTRING("
SPAD")
%CYCLE I=FIRST,1,LAST
%IF I#15 %THEN %START
PRINTSTRING(" STREAM")
WRITE(I,2)
%FINISHELSE PRINTSTRING("CONTROLLER")
%REPEAT
NEWLINE
SQPRINT(FIRST,LAST)
%END
%ROUTINE CHANGE STREAM(%INTEGER STRM)
%INTEGER I,J,NR
!***********************************************************************
!* CHANGE FROM ONE GPC STREAM TO ANOTHER BEFORE READING SPADS *
!***********************************************************************
%CONSTHALFINTEGERARRAY W(0:12)=X'6001',X'4860',X'3921',X'6000'(3),
0,X'A000',X'3921'(3),X'3923',X'3921';
NR=NORFBS
%CYCLE I=0,1,12
J=W(I)
%IF J=0 %THEN J=STRM
WRITE16(J)
%REPEAT
%UNLESS NR=NORFBS %THEN %START
PRINTSTRING("FAILED TO CHANGE TO STRM")
WRITE(STRM,2); NEWLINE
%FINISH
%END
%INTEGERFN READSPAD(%INTEGER SPAD)
%INTEGER I
DWRITE16(X'62470000'!SPAD); ! WRITE DIRECT THE SPAD NO TO R247
DWRITE16(X'A3600000'); ! WRITE INDIRECT
I=READ16(X'5246')
%RESULT=I>>16
%END
%ROUTINE PRINT(%INTEGER AD,N,PL)
%INTEGER I,SAME
SAME=0
N=N-1 %AND SAME='Z' %WHILE N>=0 %AND DAT(N)=0
%RETURN %IF N<0
PRINTSTRING(HTOS(AD,4))
%IF SAME=0 %START
%WHILE N>0 %AND DAT(N)=DAT(N-1) %CYCLE
SAME='*'
N=N-1
%REPEAT
%FINISH
%CYCLE I=0,1,N
SPACE
PRINTSTRING(HTOS(DAT(I),PL))
%REPEAT
PRINTSYMBOL(SAME) %IF SAME#0
NEWLINE
%END
%ROUTINE WRITE16(%INTEGER REG)
%INTEGER ISA,I,Q
ISA=X'40000E00'!PTS
I=REG<<16!X'E80'
*LB_ISA; *LSS_I
*ST_(0+%B)
Q=WAIT ARFB(PTS,AFB,REG)
%END
%ROUTINE DWRITE16(%INTEGER REGDATA)
!***********************************************************************
!* SENDS A WRITE COMMAND (IN TO 16 BITS OF PARAM) AND AFTER AFB *
!* FOLLOW UP WITH THE DATA (BOTTOM 16 BITS). *
!***********************************************************************
WRITE16(REGDATA>>16)
WRITE16(REGDATA)
%END
%INTEGERFN DREAD16(%INTEGER REG)
!***********************************************************************
!* SPECIAL FOR DFC. SEND DIRECT AND INDIRECT READ AND 'OR' DATA *
!* TOGETHER. SAVES WORRYING IF LOCATION DIRECTLY OR INDIRECTLY *
!* ADDRESSED. WRONG FORM (PRESUMABLY!) RETURNS ZERO. *
!***********************************************************************
%INTEGER ISA,I,J,K
ISA=X'40000E00'!PTS
I=REG<<16!X'E80'
*LB_ISA; *LSS_I
*ST_(0+%B)
J=WAIT ARFB(PTS,RFB,REG)
*LSS_AFA; *LB_ISA; *ST_(0+%B); ! SEND AFA
I=I!!X'C0000000'
*LB_ISA; *LSS_I; *ST_(0+%B)
K=WAIT ARFB(PTS,RFB,REG)
*LSS_AFA; *LB_ISA; *ST_(0+%B); ! SEND AFA
J=J!(K&X'FFFF0000')
%IF REG=X'510F' %THEN MPLDREG=J>>16
%RESULT=J
%END
%INTEGERFN READ16(%INTEGER REG)
%INTEGER ISA,I
ISA=X'40000E00'!PTS
I=REG<<16!X'E80'
*LB_ISA; *LSS_I
*ST_(0+%B)
I=WAIT ARFB(PTS,RFB,REG)
*LSS_AFA; *LB_ISA; *ST_(0+%B); ! SEND AFA
%RESULT=I
%END
%IF SFC FITTED=YES %THEN %START
%INTEGERFN READ32(%INTEGER REG)
!***********************************************************************
!* SPECIAL FOR SFC. SEND READ COLLECT 32 BITS IN 2 PARTS *
!***********************************************************************
%INTEGER I,J,ISA
ISA=X'40000E00'!PTS
I=REG<<16!X'E80'
*LB_ISA; *LSS_I; *ST_(0+%B)
I=WAIT ARFB(PTS,RFB,REG)
*LSS_CLEAR RFB AND AFA; *LB_ISA; *ST_(0+%B); ! SEND AFA
J=WAIT ARFB(PTS,RFB,REG)
*LSS_AFA; *LB_ISA; *ST_(0+%B); ! SEND AFA
%RESULT=J>>16!(I&X'FFFF0000')
%END
%FINISH
%ROUTINE PRINT BFUNS(%INTEGER FIRST,LAST)
%INTEGER I,J,K
%CYCLE I=FIRST,1,LAST
J=BFUNS(I)
K=READ16(J)>>16!J<<16
PRINTSTRING(HTOS(K,8))
%IF J=X'9388' %THEN R388=K; ! SAVE DFC CONFIGN FOR LATER
%IF I&7=7 %THEN NEWLINE %ELSE SPACE
%REPEAT
%END
%ROUTINE SQPRINT(%INTEGER FIRST,LAST)
!***********************************************************************
!* PRINTS PARTS OF ATU ARRAY IN A SQUARE GRID FORMAT *
!***********************************************************************
%INTEGER I,J
%CYCLE J=0,1,15
WRITE(J,2)
%CYCLE I=FIRST,1,LAST
SPACES(2)
PRINTSTRING(HTOS(ATUS(16*(I&7)+J),8))
%REPEAT
NEWLINE
%REPEAT
%END
%ROUTINE SEQREG(%INTEGER FIRST,STEP,LAST,SHFT,PL,%INTEGERFN GET)
!***********************************************************************
!* READ A SEQENCE OF REGISTER AND PRINT THEM . FN GET OBTAINS REG *
!* SHIFT AND PL CONCERN MANIPULATING AND PRINTING RESULT *
!***********************************************************************
%INTEGERFNSPEC GET(%INTEGER I)
%INTEGER COUNT,SAVE,I
COUNT=0
%CYCLE I=FIRST,STEP,LAST
%IF COUNT=0 %THEN SAVE=I
DAT(COUNT)=GET(I)>>SHFT
%IF COUNT=7 %OR I=LAST %THEN %C
PRINT(SAVE,COUNT,PL) %AND COUNT=-1
COUNT=COUNT+1
%REPEAT
%END
%END
%OWNLONGINTEGER VSN=X'4641535420563135';! M'FAST V15'
! DRIVING FPC2S WRITTEN BY PDS OCT 76
%RECORDFORMAT DDTFORM(%INTEGER SER, PTS, PROPADDR, STICK, STATS, %C
RQA, LBA, ALA, STATE, IW1, CONCOUNT, SENSE1, SENSE2, SENSE3, %C
SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, %C
%STRING (6) LAB, %BYTEINTEGER MECH)
%RECORDFORMAT PROPFORM(%INTEGER TRACKS, CYLS, PPERTRK, BLKSIZE %C
, TOTPAGES, RQBLKSIZE, LBLKSIZE, ALISTSIZE, KEYLEN, %C
SECTINDX)
%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)
%RECORDFORMAT LABFORM(%BYTEINTEGERARRAY VOL(0:5), %C
%BYTEINTEGER S1, S2, S3, S4, ACCESS, %C
%BYTEINTEGERARRAY RES(1:20), %C
%BYTEINTEGER C1, C2, AC1, AC2, TPC1, TPC2, BF1, BF2, %C
%BYTEINTEGERARRAY POINTER(0:3), IDENT(1:14))
%CONSTINTEGER NORMALT=X'800000', ERRT=X'400000', %C
ATTNT=X'100000', DISCSNO=X'00200000', PDISCSNO=X'210000', %C
SCHEDSNO=X'30000'
%OWNBYTEINTEGERARRAY LVN(0:99)=254(100)
%CONSTLONGINTEGER LONGONE=1
%OWNINTEGER DITADDR, NDISCS
%EXTERNALROUTINE DISC(%RECORDNAME P)
%RECORDSPEC P(PARMF)
%ROUTINESPEC SET PAW(%RECORDNAME CCA, %INTEGER PTS, SAW, SRTM)
%ROUTINESPEC READ DLABEL(%RECORDNAME DDT)
%ROUTINESPEC LABREAD ENDS
%ROUTINESPEC REINIT DFC(%INTEGER SLOT,PART)
%ROUTINESPEC UNLOAD(%RECORDNAME DDT)
%STRING (4) %FNSPEC MTOS(%INTEGER M)
%ROUTINESPEC SENSE(%RECORDNAME DDT, %INTEGER VAL)
%ROUTINESPEC STREAM LOG(%RECORDNAME DDT)
%ROUTINESPEC DREPORT(%RECORDNAME DDT, P)
%RECORDNAME DDT,XDDT(DDTFORM)
%RECORDNAME RQB(RQBFORM)
%RECORDNAME LABEL(LABFORM)
%RECORDNAME CCA(CCAFORM)
%CONSTINTEGER HOLD=X'800',AUTO=X'8000';! BITS IN ATTN BYTE
%OWNINTEGER INITINH, LABREADS, CURRTICK, AUTOLD
%OWNBYTEINTEGERARRAY PTCA(0:63); ! MAX=PORT3,TRUNK F
%OWNBYTEINTEGERARRAY PTDSLOT(0:63)=255(64)
%INTEGER ACT, I, J, PTR, STRM, PIW, SIW1, SIW2, PT, SLOT, PTS
%STRING (40) S
%STRING (6) PREVLAB
%SWITCH INACT(0:7), AINT, FINT, NINT(0:15)
ACT=P_DEST&X'FFFF'
%IF MONLEVEL&2#0 %AND KMON&(LONGONE<<(DISCSNO>>16))#0 %THEN %C
PKMONREC("DISC:",P)
%IF ACT>=64 %THEN ->ACT64
->INACT(ACT)
INACT(0): ! INITIALISATION
! NO LONGER ANY PARAMS
! P_P2=ADDR(CONTROLLER LIST)
! P_P3=ADDR(DDT)
! P_P4=NO OF DISCS
NDISCS=COM_NDISCS
DITADDR=COM_DITADDR
INITINH=1
!
! SET UP TWO ARRAYS TO AVOID SEARCHING THE DDT
! PTCA HAS THE COMMNCTNS AREA PUBLIC SEG NO FOR EACH CONTROLLER(AS P/T)
! PTDSLOT HAS THE SLOT NO OF STREAM 0 OF A GIVEN P/T SO THAT THE
! SLOT OF STREAM S CAN BE FOUND BY INDEXING. IF THERE ARE MISSING STREAMS
! ON A FPC2 THEN THERE WILL BE MORE THAN ONE VALUE FOR PTDSLOT AND THE
! LOWEST IC CHOSEN. THIS WILL INVOLVE SEARCHING AND IS LESS EFFICIENT
!
%CYCLE J=0,1,NDISCS-1
DDT==RECORD(INTEGER(DITADDR+4*J))
PT=DDT_PTS>>4
STRM=DDT_PTS&15
PTCA(PT)<-DDT_LBA>>18; ! TO ASSOCIATE INTS
I=J-STRM; ! STRM 0 POSN
%IF I<0 %THEN I=0; ! IN CASE VERY PECULIAR CONFIGN
%IF PTDSLOT(PT)>I %THEN PTDSLOT(PT)=J
SENSE(DDT,0)
DDT_STATE=1; ! READ VOL LABELS
%REPEAT
P_DEST=PDISCSNO
PDISC(P)
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)
%RETURN
!
! A DISC MAY BE IN ANY ONE OF THE FOLLOWING STATES(HELD IN DDT_STATE):-
! 0 = DEAD (NOT ON LINE OR UNLOADED)
! 1 = CONNECT INTERFACE & SENSE ISSUED
! 2 = READ LABEL ISSUED
! 3 = DISCONNECT (IE UNLOAD) ISSUED. MUST RECONNECT ON TERMNTN
!
! IF THE LABEL WAS VALID THE STATES THEN GO:=
! 4 = AVAILABLE FOR PAGED OR PRIVATE USE
! 5 = PAGED TRANSFER ISSUED
! 6 = PAGED TRANSFER HAS FAILED & A SENSE ISSUED
! 7 = INOPERABLE AWAITING OPERATOR RELOAD
! 8 = LABEL REREAD ISSUED
! 9 = RESERVED FOR FURTHER ERROR RECOVERY
!
! NONEXISTENT OR INVALD LABELS THEN GO
! 10 = AVAILABLE FOR PRIVATE USE
! 11 = CLAIMED FOR PRIVATE USE BY SER=DDT_STATUS
! 12 = PRIVATE CHAIN ISSUED
! 13 = PRIVATE CHAIN HAS FAILED & A SENSE ISUUED
! 14 = SPECIAL PRIVATE CHAIN ISSUED (NO SENSE ON FAILURE)
!
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
%CYCLE I=0,1,NDISCS-1
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 MAPED ON RIGHT SLOT
%IF P_P2>0 %START
%IF DDT_STATE=10 %OR (DDT_STATE=4 %AND DDT_DLVN<0) %START
DDT_STATE=11
DDT_BASE=P_P2
->REPLY
%FINISH %ELSE ->CLAIM FAILS
%FINISH %ELSE %START
%IF DDT_STATE #11 %THEN OPMESS('BUM DEV RETURNED') %AND %RETURN
DDT_STATE=10; DDT_REPSNO=0
OPMESS(MTOS(DDT_MNEMONIC).' UNUSED')
%IF P_P2<0 %THEN SENSE(DDT,0) %AND DDT_STATE=1
%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=ID,_P2=DDTADDR)
DDT==RECORD(P_P2)
CCA==RECORD(DDT_LBA&X'FFFC0000')
%IF DDT_STATE#4 %OR P_SRCE&X'FFFF0000'#PDISCSNO %THEN ->REJECT
DDT_STATE=5; DDT_ID=P_P1
PT=DDT_PTS
DDT_STICK=CURRTICK
STRM=PT&15; ! REAL STREAM NO
! SET PAW(CCA,DDT_PTS,X'10000024',STRM)
J=X'07000000'!(X'8000'>>STRM); ! BO BATCH REQUEST
*LXN_CCA+4
*INCT_(%XNB+0)
*JCC_8,<GOTS>
SEMALOOP(CCA_MARK)
*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)
%RETURN
ACT64: ! PRIVATE CHAINS
!
! PRIVATE CHAINING SECTION
! ======= ======== =======
! THE USER HAS SET UP HIS CHAIN USEING THE RQB,LOGIC BLOCK &ADDRESS
! LIST AREA PROVIDED AT GROPE TIME
! P_P1 HAS A RETURNABLE IDENT
! P_P2=INHIBIT SENSE<<31!SAW FLAGS
! P_P5&6 LOCAL SEGMENT TABLE BASE
! IF THE REQUEST HAS COME VIA A LOCAL CONTOLLER THEN P_P3&4
! DEFINE AN AREA WHICH L-C HAS LOCKED DOWN.
!
STRM=ACT&63
DDT==RECORD(INTEGER(DITADDR+4*STRM))
%IF DDT_STATE#11 %THEN ->REJECT
!
DDT_REPSNO=P_SRCE
DDT_ID=P_P1; ! SAVE PRIVATE ID
DDT_STATE=12+2*(P_P2>>31)
CCA==RECORD(DDT_LBA&X'FFFC0000')
RQB==RECORD(DDT_RQA); ! MAP ONTO RQB
RQB_LSEGPROP=P_P5&X'FFFF0000'!X'C000'; ! ACR 0 PRO TEM
RQB_LSEGADDR=P_P6
STRM=DDT_PTS&15
DDT_STICK=CURRTICK
SET PAW(CCA,DDT_PTS,X'10000024',STRM);! USER SAW FLAGS IGNORED PRO TEM
%RETURN
REJECT: ! DISC REQUESTED REJECTED
%IF 7<=DDT_STATE<=8 %THEN DDT_ID=P_P1 %AND ->REPLY INOP
PKMONREC("*** DISC REJECTS",P)
P_DEST=P_SRCE
P_P2=-1
P_SRCE=DISCSNO+64+STRM
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
%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
%CYCLE J=0,1,NDISCS-1
DDT==RECORD(INTEGER(DITADDR+4*J))
%IF CURRTICK-DDT_STICK>2 %AND X'306E'&1<<DDT_STATE#0 %C
%THEN ->TOUT
%REPEAT
%RETURN
TOUT: ! DEVICES TIMES OUT
OPMESS(MTOS(DDT_MNEMONIC)." TIMED OUT")
CCA==RECORD(DDT_LBA&X'FFFC0000')
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
SET PAW(CCA,DDT_PTS,X'10000024',STRM)
WAIT(10)
DDT_STICK=CURRTICK
%IF CCA_PAW=0 %THEN OPMESS("TRANSFER RETRIED") %C
%ELSE REINIT DFC(J,1)
%RETURN
INACT(6): ! READ STREAM LOGP_P1=BITMASK
%IF MONLEVEL&4#0 %THEN %START
%IF MULTIOCP=YES %THEN RESERVE LOG
I=(-1)>>(32-NDISCS)
P_P1=P_P1&I
%IF P_P1=0 %THEN P_P1=I
PRINTSTRING("
DISC LOGGING INFORMATION
STR RESPONSE BYTES TRNFRD SEEKS SRNH WOFF SKER STER CORRN")
PRINTSTRING(" STRBE HDOFF MEDIA PAGEMOVES PAGEFAILS")
%CYCLE J=0,1,NDISCS-1
%IF P_P1&1<<J#0 %START
DDT==RECORD(INTEGER(DITADDR+4*J))
%IF DDT_STATE=4 %THEN STREAM LOG(DDT)
%UNLESS 5<=DDT_STATE<=6 %THEN P_P1=P_P1!!(1<<J)
%FINISH
%REPEAT
NEWLINE
%IF MULTIOCP=YES %THEN RELEASE LOG
%IF P_P1#0 %THEN DPON(P,1) %AND %RETURN
%FINISH
P_DEST=P_SRCE; P_SRCE=DISCSNO!6
PON(P) %IF P_DEST>0
PPROFILE
%RETURN
INACT(7): ! FOR TESTING FACILITIES
I=CONTROLLER DUMP(P_P1,P_P2)
%RETURN
INACT(3): ! INTERRUPTS
!***********************************************************************
!* DISC INTERRUPT HANDLING SEQUENCE *
!***********************************************************************
PT=P_P1; ! EXTRACT PORT & TRUNK FROM INT
PTR=PTCA(PT)
%IF PTR=0 %THEN PRINTSTRING('NO DISC 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)
*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
I=PTDSLOT(PT)+STRM; ! SLOT FOR THIS DEV IF ALL STRMS PRESENT
PTS=PT<<4+STRM
DDT==RECORD(INTEGER(DITADDR+4*I))
%IF I>=NDISCS %OR DDT_PTS#PTS %START; ! DISCS DISCONTINUOUS ON THIS CNTRLR
%IF I>=NDISCS %OR DDT_PTS>PTS %THEN I=-1
%CYCLE
I=I+1
%IF I>NDISCS %THEN ->SPURINT
DDT==RECORD(INTEGER(DITADDR+4*I))
%IF DDT_PTS=PTS %THEN %EXIT
%REPEAT; ! SEARCH FOR DISCONTINUOS DISC
%FINISH
SLOT=I
%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 CCA_PIW1#0 %THEN ->MORE INTS
%RETURN
CONTINT: ! INT FROM CONTOLLER OR SPURIOUS
SIW1=CCA_CRESP1; SIW2=CCA_CRESP2
CCA_CRESP1=0; CCA_MARK=-1
%IF SIW1#0 %THEN PRINTSTRING('DISC CONTROLERS INT :'. %C
STRHEX(SIW1)." ".STRHEX(SIW2).'??')
%RETURN
SPUR INT:
PRINTSTRING('SPUR DISC INT ON '.STRHEX(PT<<4+STRM)."
")
->CHINT
NINT(4):FINT(4):
NINT(10):FINT(10):
NINT(11):FINT(11):
NINT(0):FINT(0): ! DEAD DISC TERINATES?
PRINTSTRING("DISC INT STATE ".STRINT(DDT_STATE)." ?????
")
->CHINT
NINT(1): ! SENSE TERMINATES
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
%IF DDT_SENSE4<0 %THEN %START; ! DISC IN AUTO
READ DLABEL(DDT)
LABREADS=LABREADS+1
DDT_STATE=2
%FINISH %ELSE DDT_STATE=0
->CHINT
NINT(8): ! LABEL ON REMOUNTED DISC READ
NINT(2): ! LABEL READ SUCCESSFULLY
LABREAD ENDS
LABEL==RECORD(DDT_ALA+72)
ETOI(ADDR(LABEL),6)
PREVLAB=DDT_LAB
%CYCLE I=0,1,5
BYTEINTEGER(ADDR(DDT_LAB)+1+I)=LABEL_VOL(I)
%REPEAT
LENGTH(DDT_LAB)=6
%IF LABEL_ACCESS= X'C5' %AND '0'<=LABEL_VOL(4)<='9' %AND %C
'0'<=LABEL_VOL(5)<='9' %START
%CYCLE I=0,1,3
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 %THEN ->DUPLICATE
%IF DDT_STATE=8 %THEN DDT_LAB=PREVLAB %AND ->REMOUNT;! WRONG DISC REMOUNTED
LVN(I)=SLOT
DDT_DLVN=I!X'80000000'
DDT_STATE=4
%FINISH %ELSE %START
%IF DDT_STATE=8 %THEN ->REMOUNT;! WRONG DISC REMOUNTED
DDT_BASE=0
DDT_STATE=10
DDT_DLVN=-1
S=' FRGN'
%FINISH
DDT_STATS=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 7<=XDDT_STATE<=8 %THEN %START;! NOT AWAITING REMOUNT
OPMESS("DUPLICATE DISC LVN ")
DDT_DLVN=-1; ! DONT CLEAR LVN WHEN UNLOADING
UNLOAD(DDT)
DDT_STATE=3; ->CHINT
%FINISH
!
! SET UP P FOR PONING 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_STATS=XDDT_STATS; ! INCLUDING FCHK&CLODING BITS
DDT_CONCOUNT=XDDT_CONCOUNT
XDDT_STATS=0; XDDT_STATE=0
XDDT_CONCOUNT=0
LVN(I)=SLOT
%FINISH
DDT_STATE=4
PON(P)
->LOADMESS
FINT(1): !SENSE FAILS
DDT_STATE=0; ->CHINT
FINT(2): ! READ LABEL FAILS
LABREAD ENDS
DDT_LAB='NOLABL'
DDT_DLVN=-1
DDT_STATE=10
OPMESS(MTOS(DDT_MNEMONIC).' LOADED NO LABEL')
DDT_BASE=0
->CHINT
NINT(3):FINT(3): ! UNLOAD COMPLETE
SENSE(DDT,0); ! RECONNECT INTERFACE
DDT_STATE=1
UNLDED:OPMESS(MTOS(DDT_MNEMONIC).' UNLOADED')
%IF DDT_DLVN#-1 %THEN LVN(DDT_DLVN&255)=255
->CHINT
AINT(2):
LABREAD ENDS
AINT(0):AINT(1): ! ATTENTION WHILE INITIALISING
PRINTSTRING('ATTNTN WHILE INITNG '.STRHEX(PTS)." ". %C
STRHEX(SIW1).STRHEX(SIW2)."
")
%CYCLE I=1,1,5000
%IF CCA_PIW1&(X'80000000'>>STRM)#0 %THEN ->CHINT
%REPEAT
DDT_STATE=1
SENSE(DDT,1); ! START SEQUENCE AGAIN
AINT(3): ! EXTRA ATTENTION CAUSED BY UNLOAD
->CHINT
AINT(4):AINT(10): ! ATTENTION WHILE IDLE
AINT(5):AINT(6): ! ATTENTION WHILE PAGING
%IF SIW1&HOLD#0 %THEN %START; ! HOLD WAS PRESSED
%IF DDT_STATE=10 %OR (DDT_STATE=4 %AND DDT_CONCOUNT=0) %START
! NOT IN SYSTEM USE CAN UNLOAD
UNLOAD(DDT)
DDT_STATE=3
%FINISH %ELSE %START
OPMESS(DDT_LAB." STILL NEEDED ".STRINT(DDT_STATE))
%FINISH
->CHINT
%FINISH
!
! IF ATTNT WASNT HOLD 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=10 %OR (DDT_STATE=4 %AND DDT_CONCOUNT=0) %START
DDT_STATE=0
->UNLDED
%FINISH
REMOUNT: ! DEMAND RELOAD OF DEMOUNTED DISC
OPMESS("RELOAD ".DDT_LAB." NOW!!!".TOSTRING(17))
DDT_STATE=7
->CHINT
AINT(7): ! ATTENTION WHILE WAITING REMOUNT
%IF SIW1&AUTO#0 %START; ! DRIVE NOW RELOADED
READ DLABEL(DDT); ! CHECK ITS RIGHT DISC
LABREADS=LABREADS+1
DDT_STATE=8
->CHINT
%FINISH
FINT(8): ! FAILED TO READ LABEL
->REMOUNT
NINT(7):FINT(7): ! TRANSFERS & SENSES GOING WHEN
! DISC WENT INOP HAVE NOW FINISHED
REPLY INOP: ! TELL PDISC DISC IS INOP
P_P3=ERRT; ! TRANSFER FAILED ON LB 0
P_P4=0
P_P5=NORMALT; ! SENSE WORKED
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO
DDT_SENSE2=X'80800000'; ! INOP IN 2NDRY & 3RY STATUS
INTEGER(DDT_ALA+132)=DDT_SENSE2
PT=DDT_PTS>>4; ! IN CASE MORE INTS INCAREA
->COM2
NINT(12): ! PRIVATE CHAIN OK
NINT(14): ! SPECIAL PRIVATE CHAIN OK
FINT(14): ! SPECIAL PRIVAT CHAIN FAILS
P_DEST=DDT_REPSNO
P_SRCE=DISCSNO+64+DDT_PTS&15
P_P1=DDT_ID
P_P2=0; ! FLAG FOR NORMAL TERMINATION
P_P3=SIW1; P_P4=SIW2
PON(P)
DDT_STATE=11
->CHINT
FINT(5): ! PAGED REQUEST FAILS
FINT(12): ! PRIVATE CHAIN FAILS
DDT_IW1=SIW1
DDT_SENSE1=SIW2
DDT_STATE=DDT_STATE+1
SENSE(DDT,1)
->CHINT
NINT(5): ! PAGED TRANSFER OK
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO+2
P_P1=DDT_ID
P_P2=0
DDT_STATE=4
PDISC(P); ! CALL NOT PON FOR EFFICIENCY
->CHINT
NINT(6): ! PAGED SENSE OK
FINT(6): ! PAGED SENSE FAILS
P_DEST=PDISCSNO+10
P_SRCE=DISCSNO+2
DDT_STATE=4
->COM1
NINT(13): ! PRIVATE SENSE OK
FINT(13): ! PRIVATE SENSE FAILS (!???)
P_DEST=DDT_REPSNO
P_SRCE=DISCSNO+64+DDT_PTS&15
DDT_STATE=11
COM1:
I=DDT_ALA+128
P_P3=DDT_IW1
P_P4=DDT_SENSE1
P_P5=SIW1; ! SENSE TERMINATION
DDT_SENSE1=INTEGER(I)
DDT_SENSE2=INTEGER(I+4)
DDT_SENSE3=INTEGER(I+8)
DDT_SENSE4=INTEGER(I+40)
COM2: ! INOPERABLE REPLIES JOIN HERE
!
! 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
P_P1=DDT_ID
P_P2=1; ! TRANSFER FAILS
P_P6=ADDR(DDT_SENSE1)
DREPORT(DDT,P)
PON(P)
->CHINT
AINT(11):AINT(12):AINT(13): ! PRIVATE ATTENTIONS
P_DEST=DDT_BASE; 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(%RECORDNAME DDT)
!***********************************************************************
!* PERFORMS A DISCONNECT INTERFACE WHICH UNLOADS THE DISC *
!***********************************************************************
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME RQB(RQBFORM)
%RECORDNAME CCA(CCAFORM)
%INTEGER STRM
STRM=DDT_PTS&15
RQB==RECORD(DDT_RQA)
CCA==RECORD(DDT_LBA&X'FFFC0000')
RQB_W7=X'80001300'
RQB_W8=0
SET PAW(CCA,DDT_PTS,X'10000024',STRM)
%END
%ROUTINE READ DLABEL(%RECORDNAME DDT)
!***********************************************************************
!* READS SECTOR 0 HEAD 0 CYL 0 WHICH SHOULD BE 80 BYTE VOL LABEL *
!***********************************************************************
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME RQB(RQBFORM)
%RECORDNAME CCA(CCAFORM)
%INTEGER LBA,ALA,STRM
LBA=DDT_LBA
ALA=DDT_ALA
STRM=DDT_PTS&15
DDT_STICK=CURRTICK
RQB==RECORD(DDT_RQA)
CCA==RECORD(DDT_LBA&X'FFFC0000')
!
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_PTS,X'10000024',STRM)
%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(SCHEDSNO>>16)
%END
%ROUTINE SENSE(%RECORDNAME 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 *
!* A SENSE IS ALWAYS KEPT BELOW THE FALSE FLOOR IN LBLOACK &ALIST *
!***********************************************************************
%RECORDNAME RQB(RQBFORM)
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME CCA(CCAFORM)
%INTEGER LBA,ALA,STRM
LBA=DDT_LBA-8+4*VAL
ALA=DDT_ALA-8
STRM=DDT_PTS&15
DDT_STICK=CURRTICK
CCA==RECORD(DDT_LBA&X'FFFC0000')
RQB==RECORD(DDT_RQA)
RQB_LBADDR=LBA
RQB_ALADDR=ALA
RQB_W7=X'02001300'; ! DO CHAIN
SET PAW(CCA,DDT_PTS,X'10000024',STRM)
%END
%ROUTINE SET PAW(%RECORDNAME CCA,%INTEGER PTS,SAW,STRM)
!***********************************************************************
!* GRAB SEMA AND SET ACTIVATION WORDS. THEN FIRE IO *
!***********************************************************************
%RECORDSPEC CCA(CCAFORM)
%INTEGER W,PAW
PAW=X'07000000'!(X'8000'>>STRM); ! DO BATCH REQUEST
*LXN_CCA+4
*INCT_(%XNB+0)
*JCC_8,<GOTSEMA>
SEMALOOP(CCA_MARK)
GOTSEMA:
CCA_PAW=PAW! CCA_PAW; ! OR MULTIPLE BATCHS TOGETHER
INTEGER(ADDR(CCA)+32+16*STRM)=SAW
CCA_MARK=-1
! FIRE IO(PTS,1)
*LSS_PTS; *USH_-4; *USH_16; *OR_X'40000800'
*ST_%B; *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 *
!***********************************************************************
%RECORDNAME DDT(DDTFORM)
%RECORDFORMAT INITFORM(%INTEGER W0,W1,W2,W3,W4)
%OWNRECORD INIT(INITFORM)
%RECORDNAME CCA,CCA0(CCAFORM)
%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=X'40000800'!(PT<<16); ! FOR CHANNEL FLAGS
->PART2 %IF PART=2
DUMPS=DUMPS+1
%IF DUMPS<=1 %START
R=CONTROLLER DUMP(2,DDT_PTS>>4)
DUMPTABLE(60,DDT_LBA&X'FFFC0000',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(X'80040008')&X'FFFC'+X'80')//8-1)<<18! %C
X'80000000'
INIT_W1=INTEGER(X'8004000C')&X'0FFFFF80'
INIT_W2=DDT_LBA&X'FFFC0000'; ! 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_LBA&X'FFFC0000',127)
%FINISH
%IF CCA0_PAW=0 %THEN OPMESS("DFC REINITIALISED") %AND DUMPS=-1 %C
%ELSE OPMESS("FAILED TO AUTOLOAD DFC")
CCA==RECORD(DDT_LBA&X'FFFC0000')
CCA_CRESP1=0; ! DELETE INITIALISE RESPONSE
CCA_PAW=0
%CYCLE I=0,1,NDISCS-1
DDT==RECORD(INTEGER(DITADDR+4*I))
%IF DDT_PTS>>4=PT %AND X'306E'&1<<DDT_STATE#0 %START
SET PAW(CCA,DDT_PTS,X'10000024',DDT_PTS&15)
DDT_STICK=CURRTICK
%FINISH
%REPEAT
SLAVESONOFF(-1); ! SLAVES BACK ON
%END
%ROUTINE STREAM LOG(%RECORDNAME DDT)
!***********************************************************************
!* READ THE STREAM LOG FOR EACH STREAM IN TURN. WAITS FOR RESPONSE *
!***********************************************************************
%IF MONLEVEL&4#0 %THEN %START
%RECORDNAME RQB(RQBFORM)
%RECORDNAME CCA(CCAFORM)
%RECORDSPEC DDT(DDTFORM)
%INTEGER LBA,ALA,STRM,I,J
LBA=DDT_LBA; ALA=DDT_ALA
STRM=DDT_PTS&15
CCA==RECORD(DDT_LBA&X'FFFC0000')
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_PTS,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)
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_STATS&X'3FFFFF',9); ! PAGES TRANSFERRED
WRITE(DDT_STATS>>22,9); ! PAGES THAT FAILED TO TRANSFER
PRINTSTRING(" ".DDT_LAB)
%IF DDT_BASE=X'800' %THEN PRINTSTRING(" (IPL VOL)")
DDT_STATS=0; ! CLEAR OUT WITH LOGGING INF
%FINISH
%END
%ROUTINE DREPORT(%RECORDNAME DDT,P)
!***********************************************************************
!* PRINTS OUT A FAILURE REPORT IN A READABLE FORM *
!***********************************************************************
%CONSTSTRING(3)%ARRAY SENSEM(0:11)=" C0"," S0"," T3"," T7",
"T11","T15","T19","T23",
"T27","T31"," M0"," M4";
%RECORDSPEC DDT(DDTFORM)
%RECORDSPEC P(PARMF)
%RECORDNAME PROP(PROPFORM)
%INTEGER I,J,K,A0,A1,FLB,AAL,LBE
PROP==RECORD(DDT_PROPADDR)
%IF MULTIOCP=YES %THEN RESERVE LOG
PRINTSTRING("
&& DISC TRANSFER ".DDT_LAB." ON ".MTOS(DDT_MNEMONIC). %C
" (".HTOS(DDT_PTS,3).") FAILS ".DATE." ".TIME."
RESPONSE0 RESPONSE1 FAILURES TRANSFERS
")
PRINTSTRING(" ".STRHEX(P_P3)." ".STRHEX(P_P4))
WRITE(DDT_STATS>>22,8)
WRITE(DDT_STATS&X'3FFFFF',9)
PRINTSTRING("
SENSE DATA
")
K=DDT_ALA+128
%CYCLE I=0,1,11
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
%CYCLE J=0,4,4*I
%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
%CYCLE K=0,1,4
PRINTSTRING(HTOS(BYTEINTEGER(A1+K),2))
%REPEAT
%FINISH
%FINISH %ELSE PRINTSTRING("NOT VALID")
NEWLINE
%REPEAT
NEWLINE
%IF MULTIOCP=YES %THEN RELEASE LOG
%END
%END
%EXTERNALROUTINE PDISC(%RECORDNAME P)
!***********************************************************************
!* RECEIVES PAGED DISC TRANSFERS. ORGANISES ALL QUEUING AND *
!* GENERATES THE CCWS WHICH ARE THE PASSED TO DISC FOR EXECUITION *
!***********************************************************************
%RECORDFORMAT QFORM(%BYTEINTEGER QSLOT, STATE, SP0, PRIO, %C
%INTEGER LQLINK, UQLINK, CURCYL, PROPADDR, DDTADDR, SEMA, TRLINK)
%RECORDFORMAT REQFORM(%INTEGER DEST, %BYTEINTEGER FAULTS, FLB, %C
LLBP1, REQTYPE, %INTEGER IDENT, CYLINK, COREADDR, CYL, %C
TRKSECT, STOREX, REQLINK)
%RECORDSPEC P(PARMF)
%RECORDNAME DDT(DDTFORM)
!%RECORDNAME PROP(PROPFORM)
%RECORDNAME RQB(RQBFORM)
%RECORDNAME QHEAD,XQHEAD(QFORM)
%RECORDNAME ACELL(PARMXF)
%RECORDNAME REQ,ENTRY(REQFORM)
%CONSTINTEGERARRAY CCW(1:6)=X'04002202',
X'84002302',X'84002302',X'24002202',X'04002202',
X'84002302';
%CONSTINTEGER RETRIES=7, MAXTRANS=12
%CONSTINTEGER IGNORELB=X'400000'
%CONSTINTEGER TRANOK=0, TRANWITHERR=1, TRANREJECT=2, %C
NOTTRANNED=3, ABORTED=4, PTACT=5, POUTACT=6
%OWNRECORDARRAYFORMAT QSPACEF(1:512)(QFORM)
%OWNRECORDARRAYNAME QSPACE(QFORM)
!%ROUTINESPEC QUEUE(%INTEGERNAME QHEAD, %INTEGER REQ,CYL)
%ROUTINESPEC PTREPLY(%RECORDNAME REQ,%INTEGER FAIL)
%SWITCH PDA(0:11)
%OWNINTEGER INIT
%INTEGERNAME LINK
%INTEGER I, ACT, J, LBA, ALA, UNIT, LUNIT, CYL, TRACK, SECT, %C
CELL, XTRA, SECSTAT, CURRHEAD, FIRSTHEAD, FIRST SECT, %C
ERRLBE, K, UNRECOVERED, NEXTCELL, SRCE, FAIL, STOREX, %C
L, LBA0, ALA0, FLB, AD
ACT=P_DEST&X'FFFF'
*LSS_PARM+4; *ST_AD
%IF MONLEVEL&2#0 %AND KMON&(LONGONE<<(PDISCSNO>>16))#0 %THEN %C
PKMONREC("PDISC:",P)
->PDA(ACT)
PDA(0): ! INITIALISE
%IF INIT#0 %THEN %RETURN; ! IN CASE !
QSPACE==ARRAY(COM_DQADDR,QSPACEF)
%CYCLE I=0,1,NDISCS-1
QHEAD==QSPACE(I+1)
DDT==RECORD(INTEGER(DITADDR+4*I))
QHEAD=0; ! ZERO WHOLE RECORD
QHEAD_QSLOT=I+1
%IF MULTIOCP=YES %THEN QHEAD_SEMA=-1
QHEAD_PROPADDR=DDT_PROPADDR
QHEAD_DDTADDR=ADDR(DDT)
%REPEAT
INIT=1
%RETURN
PDA(6): ! PAGEOUT REQUEST(IE WRITE)
PDA(5): ! PAGETURN REQUEST(IE READ)
! P_P1=AMTX/EPX
! P_P2=DISCADDR
! P_P3=STOREX
! P_P4=PRIOITY 0=HIGH,1=LOW
P_P6=P_P3; ! SAVE STOREX
P_P3=(STORE(P_P3)_REALAD+X'01000000')!X'80000000'
! TURN INTO PDA(1) FORM
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
QHEAD==QSPACE(LUNIT+1)
! PROP==RECORD(QHEAD_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_QHEAD+4
*LXN_(%CTB+4); ! 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 MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<PSEMAGOT>
SEMALOOP(MAINQSEMA)
PSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN MORE PPSPACE
ACELL==RECORD(PCELLSIZE*PARMASL+AD);!==PARM(PARMASL)
CELL=ACELL_LINK
REQ==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL)
%IF CELL=PARMASL %THEN PARMASL=0 %ELSE %C
ACELL_LINK=REQ_REQLINK
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
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 MULTIOCP=YES %THEN %START
*LXN_QHEAD+4
*INCT_(%XNB+6); ! QHEAD_SEMA
*JCC_8,<QSEMAGOT1>
SEMALOOP(QHEAD_SEMA)
QSEMAGOT1:
%FINISH
%IF QHEAD_STATE=0 %OR CYL>=QHEAD_CURCYL %THEN %START
! QUEUE(QHEAD_UQLINK,CELL,CYL)
LINK==QHEAD_UQLINK; *JLK_<QUEUE>
%FINISH %ELSE %START
! QUEUE(QHEAD_LQLINK,CELL,CYL)
LINK==QHEAD_LQLINK; *JLK_<QUEUE>
%FINISH
->INIT TRANSFER %IF QHEAD_STATE=0; ! UNIT IDLE
%IF MULTIOCP=YES %THEN QHEAD_SEMA=-1
%RETURN
REJECT: ! REQUEST INVALID
PKMONREC("*** PDISC REJECTS",P)
P_DEST=SRCE
P_SRCE=PDISCSNO+ACT
P_P2=TRANREJECT; ! REJECTED
%IF ACT=PTACT %THEN PTREPLY(P,2) %ELSE PON(P)
%RETURN
INIT TRANSFER: ! SET UP CHAIN AND HAND TO DISC
DDT==RECORD(QHEAD_DDTADDR)
CELL=QHEAD_UQLINK
REQ==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL)
!
! ASSUME ALL TRANSFERS ON THIS CYL WILL BE CARRIED OUT AND ARRANGE
! LINKING ACCORDINGLY. CORRECT LINKING AT REPEAT IF NOT SO
!
QHEAD_UQLINK=REQ_REQLINK
CYL=REQ_CYL
%IF CYL=0 %THEN XTRA=IGNORELB %ELSE XTRA=0
ALA=DDT_ALA
ALA0=ALA
LBA=DDT_LBA
LBA0=LBA
RQB==RECORD(DDT_RQA)
!
! 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 CHOSUPI TO THE WORKSITE
!
FLB=0; I=0
%CYCLE
NEXTCELL=REQ_CYLINK
%IF REQ_REQTYPE=POUTACT %AND %C
STORE(REQ_STOREX)_FLAGLINK&X'FF0000'#0 %START
REQ_CYLINK=ABORTED
INTEGER(ADDR(REQ)+4)=PDISCSNO
FASTPON(CELL)
%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&SECTOR
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
I=I+1
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
!
! MOVE THE CELL FROM THE REQUEST QUEU TO TRANSFERINPROGRESS QUEU
!
REQ_REQLINK=QHEAD_TRLINK
QHEAD_TRLINK=CELL
FLB=(LBA-LBA0)>>2
REQ_LLBP1=FLB
%FINISH
CELL=NEXT CELL
!
! SEE IF THERE ANY MORE TRANSFERS AND IF THE ARE ON THE SAME CYL
!
%IF CELL=0 %THEN ->DECHAIN
REQ==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL)
%EXIT %IF I=MAXTRANS
%REPEAT
REQ_REQLINK=QHEAD_UQLINK
QHEAD_UQLINK=CELL
DECHAIN:
%IF I=0 %THEN ->DOMORE; ! ALL ABORTED CHOOSE NEXT CYL
! 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
%IF MONLEVEL&4#0 %THEN %START
DDT_STATS=DDT_STATS+I; ! UPDATE TRANSFER COUNT
%FINISH
RQB_W7=X'1E001300'
RQB_W8=CYL<<16!(20*EPAGESIZE*(FIRST SECT-1))<<8!FIRST HEAD
P_DEST=DISCSNO+2
P_SRCE=PDISCSNO+10
P_P1=ADDR(QHEAD)
P_P2=ADDR(DDT)
QHEAD_STATE=1
QHEAD_CURCYL=CYL
%IF MULTIOCP=YES %THEN QHEAD_SEMA=-1
DISC(P)
%RETURN
PDA(10): ! REPLY FORM DISC
QHEAD==RECORD(P_P1)
%IF MULTIOCP=YES %THEN %START
*LXN_QHEAD+4
*INCT_(%XNB+6); ! QHEAD_SEMA
*JCC_8,<QSEMAGOT2>
SEMALOOP(QHEAD_SEMA)
QSEMAGOT2:
%FINISH
CELL=QHEAD_TRLINK
%IF P_P2=0 %THEN %START; ! DUPLICATE CODE FOR SPEED
%WHILE CELL#0 %CYCLE
REQ==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL)
J=REQ_REQLINK
%IF REQ_REQTYPE=PTACT %THEN %START
!
! PUT THIS CODE IN LINE
!
! PTREPLY(REQ,0)
STOREX=REQ_STOREX
%IF MULTIOCP=YES %THEN %START
*INCT_(STORESEMA)
*JCC_8,<SSEMAGOT2>
SEMALOOP(STORESEMA)
SSEMAGOT2:
%FINISH
L=STORE(STOREX)_FLAGLINK
STORE(STOREX)_FLAGLINK=L&X'3FFF0000'
%IF MULTIOCP=YES %THEN STORESEMA=-1
L=L&X'FFFF'
%UNTIL L=0 %CYCLE
K=PARM(L)_LINK
FASTPON(L)
L=K
%REPEAT
! RETURN PP CELL(CELL)
%IF MULTIOCP=YES %THEN %START
*INCT_MAINQSEMA
*JCC_8,<QSEMAGOT>
SEMALOOP(MAINQSEMA)
QSEMAGOT:
%FINISH
%IF PARMASL=0 %THEN REQ_REQLINK=CELL %ELSE %START
ACELL==RECORD(PCELLSIZE*PARMASL+AD);! ==PARM(PARMASL)
REQ_REQLINK=ACELL_LINK
ACELL_LINK=CELL
%FINISH
PARMASL=CELL
%IF MULTIOCP=YES %THEN MAINQSEMA=-1
%FINISH %ELSE %START
INTEGER(ADDR(REQ)+4)=PDISCSNO; ! P_SRCE
REQ_CYLINK=0; ! P_P2== 0 FOR OK
FASTPON(CELL)
%FINISH
CELL=J
%REPEAT
QHEAD_TRLINK=0; ! NO TRANSFERS IN PROGRESS
DOMORE:
%IF QHEAD_UQLINK=0 %THEN QHEAD_UQLINK=QHEAD_LQLINK %C
%AND QHEAD_LQLINK=0
->INIT TRANSFER %IF QHEAD_UQLINK#0
QHEAD_STATE=0
%IF MULTIOCP=YES %THEN QHEAD_SEMA=-1
%RETURN
%FINISH
%IF MONLEVEL&4#0 %THEN %START
DDT==RECORD(QHEAD_DDTADDR)
DDT_STATS<-LENGTHENI(DDT_STATS)+X'00400000'
%FINISH
! UPDATE FAILURE COUNT
! WHILST AVOIDING OVERFLOW
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)=X'80' %C
%THEN FAIL=TRANWITH ERR; ! CYCLIC CHECK ONLY
CYL=QHEAD_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==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL)
QHEAD_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
%IF REQ_REQTYPE=PTACT %THEN PTREPLY(REQ,REQ_CYLINK) %ELSE %C
INTEGER(ADDR(REQ)+4)=PDISCSNO %AND 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(QHEAD_UQLINK,CELL,CYL)
LINK==QHEAD_UQLINK; *JLK_<QUEUE>
%FINISH
CELL=QHEAD_TRLINK
%REPEAT
%IF SEC STAT<0 %THEN QHEAD_STATE=2 %AND %RETURN;! DISC INOP
->DOMORE
PDA(11): ! INOP DISC NOW OPERABLE
QHEAD==QSPACE(P_P1+1); ! CURRENT DRIVE
%IF P_P1#P_P2 %START; ! IS ON A DIFFERENT DRIVE
XQHEAD==QSPACE(P_P2+1); ! PREVIOUS DRIVE
QHEAD_LQLINK=XQHEAD_LQLINK
QHEAD_UQLINK=XQHEAD_UQLINK
XQHEAD_LQLINK=0
XQHEAD_UQLINK=0
XQHEAD_STATE=0
%FINISH
QHEAD_TRLINK=0
QHEAD_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 *
!***********************************************************************
!%RECORDNAME REQ,ENTRY,NEXTREQ(REQFORM)
!%INTEGER NEXTCELL,AD
! REQ==PARM(CELL)
QUEUE:
NEXTCELL=LINK
ENTRY==RECORD(PCELLSIZE*NEXTCELL+AD);! ==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
!
! HANDCODE THE CYCLE KEEPING XNB TO ENTRY AND CTB TO NEXTREQ
! ALSOE KEEP CYL IN ACC AND COPY ADDR(PARM(0)) TO AD
!
*LXN_ENTRY+4; *LSS_CYL
*ICP_(%XNB+5); ! ENTRY_CYL
*JCC_8,<QONCYL>
QCYCLE:
*LB_(%XNB+8); ! ENTRY_REQLINK
*JAT_12,<QEXIT>
*MYB_PCELLSIZE; *ADB_AD
*LCT_%B; *ICP_(%CTB+5); ! NEXTREQ_CYL
*JCC_4,<QEXIT>
*LXN_%B; *JCC_7,<QCYCLE>; ! CC STILL SET
*J_<QONCYL>
QEXIT:
*LSS_(%XNB+8); ! ENTRY_REQLINK=NEXTCELL
*LCT_REQ+4; *ST_(%CTB+8); ! =REQ_REQLINK
*LSS_CELL; *ST_(%XNB+8)
! %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
%ROUTINE PTREPLY(%RECORDNAME REQ,%INTEGER FAIL)
!***********************************************************************
!* REPLIES TO ALL LOCAL CONTROLLERS WAITING FOR A PAGE TRANSFER *
!* USUALLY ONE ONLY BUT POSSIBLY SEVERAL. THIS CODE WILL GO INLINE *
!* FOR THE NORMAL CASE WHEN ALLTRANSFERS IN CHAIN ARE ERRORFREE *
!***********************************************************************
%RECORDNAME REP(PARMXF)
%RECORDSPEC REQ(REQFORM)
%INTEGER L,J,STOREX
STOREX=REQ_STOREX
%IF FAIL>1 %THEN %START; ! CLEAR THE PAGE
J=REQ_COREADDR
*LDTB_X'18000000'
*LDB_EPAGESIZE
*LDA_J
*MVL_%L=%DR,0,0
%FINISH
%IF MULTIOCP=YES %THEN %START
*INCT_(STORESEMA)
*JCC_8,<SSEMAGOT>
SEMALOOP(STORESEMA)
SSEMAGOT:
%FINISH
L=STORE(STOREX)_FLAGLINK
STORE(STOREX)_FLAGLINK=L&X'3FFF0000'; ! CLEAR OUT FLAGS& LINK
%IF MULTIOCP=YES %THEN STORESEMA=-1; ! FREE AS SOON AS POSS
L=L&X'FFFF'
%UNTIL L=0 %CYCLE
REP==PARM(L)
%IF FAIL#0 %THEN REP_DEST=REP_DEST!1 %AND REP_P3=FAIL
J=REP_LINK
FASTPON(L)
L=J
%REPEAT
RETURN PPCELL(CELL) %IF FAIL#2; ! HEADCELL BACK TO FREELIST
%END
%END
%IF SFC FITTED=YES %THEN %START
%EXTERNALROUTINE DRUM(%RECORDNAME P)
%ROUTINESPEC ACTIVATE(%RECORDNAME DT, ES, %INTEGERNAME Q)
!%ROUTINESPEC CLAIM(%INTEGERNAME N)
%ROUTINESPEC SERV(%RECORDNAME DTENT, %INTEGER ESEC)
%ROUTINESPEC DOBR
%ROUTINESPEC TAKE CRESPS(%RECORDNAME CTENT)
%ROUTINESPEC PSTATUS(%RECORDNAME DTENT)
%ROUTINESPEC FAIL ALL(%RECORDNAME DTENT)
%ROUTINESPEC PDATM
%ROUTINESPEC PTM(%RECORDNAME DTENT)
%CONSTSTRING(21) PTMS="port trunk mechanism"
%ROUTINESPEC REPORT(%RECORDNAME DTENT,%INTEGER ESEC, %STRING(47) S)
%ROUTINESPEC INITIALISE(%RECORDNAME P)
! first the necessary recordformats:-
%RECORDFORMAT CONTABF(%INTEGER ISCONTREG, BATCH, SEMA, MARKAD, %C
%INTEGERNAME CRESP0)
! one of these for each sfc.
! GLOBALLY DEFINED DATAFORMATS:-
%RECORDFORMAT PONOFF(%INTEGER DEST, SRCE, INTACT, EPAGE, STORI, %C
PRI, P5, P6,LINK)
%RECORDFORMAT ESQBF(%INTEGER DEST,SRCE,INTACT,EPAGE,STORI,P4,%C
%LONGINTEGER LSAW,%INTEGER Q)
! N.B. SIMILARITY OF ABOVE DELIBERATE, LATER USE PARMX RECORDS????
! PONOFF MAPS ONTO ESQBF FOR SENDING TO DISC IN EVENT OF FAILURE
! ESQBF = extended sector queue block format.
%RECORDFORMAT STRF(%LONGINTEGER LSAW,%INTEGER SRESP0,SRESP1)
! stream block within a communication area.
%RECORDFORMAT ESCBF(%INTEGER HQ, LQ, SAW0, PAWBS, ADDSTRS)
! ESCBF = Extended Sector Control block, one for each extended
! sector on each drum. HQ & LQ the high and low priority
! queues, SAW0 - everything except track for first sector
! in the extended sector, PAWBS - the bits to be inserted
! in the paw for this extended sector.
%RECORDFORMAT DTABF(%INTEGER NSECS, %HALFINTEGER PTM, %C
%BYTEINTEGER LOGI, CONTI, %C
%INTEGER SECLIM, NEXT, STATE, %C
%INTEGERNAME MARK, PAW, PIW, %C
%RECORDARRAY ESCBS(0:31)(ESCBF))
! one of theses for each drum. Allows max of 16 extended sectors per
! track i.e. 2K page minimum.
! NSECS - number of (1K) sectors used on this drum
! SECLIM - no. of (1K) sectord used on each track, max for integral
! number of esecs on track
! NEXT - address of next entry in dtable, 0=>last
! LOGI - logtab index, unique to each drum
! CONTI - contab index relevant to this drum.
! STATE - msb=0 => auto
! b 0:1 = time clock 0=> time out
! b 2:7 = no. of outstanding esecs
! %NAMES - for rapid access to relevant parts of communication area.
! ESCBS - one for each esector queue.
%RECORDFORMAT LOGTABF (%INTEGER TOT,RECOV, %HALFINTEGER FAIL,TOUTS)
%RECORDSPEC P(PONOFF); ! THE DRUM PARAMETER !!!
%OWNINTEGER IDENT=M'DRUM', IFIER=M'36AC'
! FIRST ENTRY IN DRUM TABLE REFERENCED BY:-
%OWNRECORDNAME DTAB0(DTABF)
! DEFINE THE CONTROLLER TABLE BY:-
%OWNRECORDARRAYNAME CONTABA(CONTABF)
%OWNRECORDARRAYFORMAT CONTABAF (1:8)(CONTABF)
%OWNRECORDNAME CONTAB1(CONTABF); ! ONTO 1ST(OFTEN ONLY) EL OF
! ARRAY CONTABA
%RECORDNAME CONTAB(CONTABF)
%OWNINTEGER CONTMAX; ! MAX INDEX IN CONTAB.
%OWNRECORDARRAY LOGTAB(0:15)(LOGTABF); ! I.E. MAX OF 16 DRUMS CATERED FOR ??
%RECORDNAME LOG(LOGTABF); ! FOR MAPPING ONTO LOGTAB
! MAIN ACTIVITY CONTROLLING SWITH:-
%SWITCH ACTIVITY(0:5); ! 0 => INITIALISE
! 1 => READ
! 2 => WRITE
! 3 => INTERRUPT
! 4 PERFORMANCE LOG AND RESET
! 5 = POLLING (NEEDED FOR ERRORS)
! SCALAR VARIABLES
%INTEGER BRFLAG; ! SET #0 TO INDICATE BITS ADDED TO PAWS SINCE LAST
! BATCH REQUEST
%INTEGER WBIT, DEVAD, DRUM, SECLIM, TRACK, ESEC
%INTEGER ESQBI, WQ
%RECORDNAME DTENT(DTABF)
%RECORDNAME ESCB(ESCBF)
%RECORDNAME STOR(STOREF)
%RECORDNAME ESQB(ESQBF)
%INTEGERNAME Q,Q2; ! REFERENCES EITHER HQ OR LQ
! NOW SCALARS CONCERNED WITH TERMINATION
! DETECTION
%INTEGERNAME CSEMA; ! CONTROLLER SEMAPHORE FOR DUALS
%INTEGER EPMASK, COMPLETED, MASK, PIW
%INTEGER CONTI, CREG; ! LOOK FOR CRESP FOLLOWING INTERRUPT
%INTEGER STATE; ! USED DURING CLOCK TICK
! SOME IMPORTANT OWNS:-
%OWNINTEGER EPN; ! NUMBER OF SECTORS PER EPAGE
%OWNINTEGER EPNBITS; ! EPN 1S LEFT JUSTIFIED
%CONSTINTEGER DSN=X'28'; ! SERVICE NUMBERS
%CONSTINTEGER DSNSRCE=DSN<<16; ! ABOVE<<16 FOR PON & POFF
%CONSTSTRING(8) AAD="&& DRUM "
! CONSTANTS USED AT MAIN LEVEL
%CONSTINTEGER SETWBIT=X'01000000'; ! STREAM FLAG BIT FOR WRITING
%CONSTINTEGER S=X'80000000'; ! ACTIVE INDICATOR ON Q HEADS
%CONSTINTEGER SAC CONTROL=X'40000800'; ! ADD IN PT TO GIVE CONTROL REG
%CONSTINTEGER TROUBLE=X'00490000'; ! in stream responses
%CONSTINTEGER ADV=X'00040000'; ! advisory status present
! VARIABLES USED IN TIMING FRQUENCY OF STROBES.
%CONSTLONGINTEGER INTERVAL=6000; ! APPROX HALF A REV.
%CONSTINTEGER TOUT LIMIT=5; ! MAX TIMEOUTS BEFORE ABANDONING
%OWNLONGINTEGER PAST
%LONGINTEGER PRESENT
%INTEGER I,SS,AD
%INTEGER ADPTS; ! ADDR(AMTPTS(AMTX)) FOR WRITES
BRFLAG=0; ! NO BATCH REQUEST NEEDED - YET!
%IF MONLEVEL&2#0 %AND KMON&LONGONE<<DSN#0 %THEN %C
PKMONREC("DRUM:",P)
->ACTIVITY(P_DEST&X'FFFF')
ACTIVITY(0):
INITIALISE(P); ! ONCE ONLY
P_DEST=X'A0001'; P_SRCE=0
P_INTACT=DSNSRCE+5; ! P_P1!
P_EPAGE=2; ! REQUEST A POLL EVERY 2 SECS
PON(P)
%RETURN
ACTIVITY(1):
WBIT=0; ! A READ REQUEST
ADPTS=0
->RW
ACTIVITY(2):
WBIT=SETWBIT; ! A WRITE REQUEST
ADPTS=P_PRI ;! ADDR(AMTPTS(AMTX))
RW:
DTENT==DTAB0
! DEVAD=P_EPAGE*EPN; ! A LOGICAL SECTOR ADDRESS.
! %WHILE DEVAD>=DTENT_NSECS %CYCLE
! DEVAD=DEVAD-DTENT_NSECS
! DTENT==RECORD(DTENT_NEXT); ! ?? GUARANTEE NEVER OFF LIMIT?
! %REPEAT
*LXN_P+4
*LSS_(%XNB+3); ! P_EPAGE
*IMY_EPN
*LCT_DTENT+4
WAGN: ! WHILE LABEL
*ICP_(%CTB+0)
*JCC_4,<WXIT>
*ISB_(%CTB+0)
*LCT_(%CTB+3)
*J_<WAGN>
WXIT: *ST_DEVAD
*STCT_DTENT+4
! DRUM NOW SET & DEVAD RELATIVE TO IT.
%IF DTENT_STATE<0 %START; ! DRUM NOT OPERABLE!
P_DEST=P_SRCE&(\S)
P_SRCE=DSNSRCE
P_EPAGE=-1; ! FAILED
PON(P); ! TO CALLER "NO CAN DO"
%RETURN
%FINISH %ELSE %START
%IF MULTIOCP=YES %THEN %START
CSEMA==CONTABA(DTENT_CONTI)_SEMA
*INCT_(CSEMA)
*JCC_8,<CSEMAGOT>
SEMALOOP(CSEMA)
CSEMAGOT:
%FINISH
SECLIM=DTENT_SECLIM
! TRACK=DEVAD//SECLIM
! ESEC=(DEVAD-TRACK*SECLIM)//EPN
*LSS_DEVAD; *IMDV_SECLIM; *ST_TRACK
*LSS_%TOS; *IDV_EPN; *ST_ESEC
! SET UP ESQB AND LINK INTO ESCB Q
ESCB==DTENT_ESCBS(ESEC)
ESQBI=NEWPPCELL
ESQB==PARM(ESQBI)
! COPY PONOFF VALUES TO ESQB
ESQB_INTACT=P_INTACT
ESQB_DEST=P_SRCE&(\S); ! ONLY USED IN EVENT OF FAILURE.
ESQB_SRCE=P_DEST
ESQB_EPAGE=P_EPAGE
ESQB_STORI=P_STORI
ESQB_P4=ADPTS; ! =0 FOR READ
ESQB_LSAW=LENGTHENI(ESCB_SAW0+WBIT+TRACK)<<32%C
+STORE(P_STORI)_REALAD&X'0FFFFFFF'
! PLACE ESQB IN APPROPRIATE Q.
%IF WBIT=0=P_PRI %THEN Q==ESCB_HQ %ELSE Q==ESCB_LQ
%IF Q>=0 %START; ! NO TRANSFER IN PROGRESS
ESQB_Q=Q
Q=ESQBI
%FINISH %ELSE %START
WQ=Q&(\S); ! ACTIVE Q.
Q2==PARM(WQ)_LINK
ESQB_Q=Q2
Q2=ESQBI
%FINISH
%IF ESCB_HQ!ESCB_LQ>0 %THEN ACTIVATE(DTENT,ESCB,Q)
! NOTHING WAS ACTIVE BEFORE.
%IF MULTIOCP=YES %THEN CSEMA=-1
%FINISH
! THE REQUEST IS NOW CORRECTLY ENTERED.
P_DEST=0; ! INDICATING NO REPLY ?????????
! GO ON TO LOOK FOR TERMINATIONS ONLY IF
! SIGNIFICANT TIME HAS PASSED.
SERVICE:
*RRTC_0
*SHS_1
*ST_PRESENT
%IF PRESENT<PAST+INTERVAL %START
! NOT LONG ENOUGH TO BE WORTH LOOKING
DOBR %IF BRFLAG#0
%RETURN
%FINISH
! NEXT PART SERVICES ALL DRUMS FOLLOWING
! POFF'D REQUESTS AND INTERRUPTS.
! ONLY DEAL WITH COMPLETE ESECS.
DTENT==DTAB0
%CYCLE
%IF MULTIOCP=YES %THEN %START
CSEMA==CONTABA(DTENT_CONTI)_SEMA
*INCT_(CSEMA)
*JCC_8,<CSEMAGOT2>
SEMALOOP(CSEMA)
CSEMAGOT2:
%FINISH
PIW=DTENT_PIW; ! COPY OUT PIW FOR THIS DRUM
%IF PIW#0 %THEN %START
EPMASK=EPNBITS
! COMPLETED=0
! MASK=EPMASK
! %WHILE PIW#0 %CYCLE
! %IF PIW&EPMASK=EPMASK %START
! COMPLETED=COMPLETED!MASK
! %FINISH
! MASK=MASK>>EPN
! PIW=PIW<<EPN
! %REPEAT
!
! CAN HANDCODE CUNNINGLY WITHOUT A LOOP PROVIDED THERE ARE ONLY 24
! BITS USED IN PIW . ALSOL ASSUMES EPN=4
!
*LSS_PIW; *USH_-8
*ST_%B; *USH_-2
*AND_%B; *ST_%B
*USH_-1; *AND_%B
*AND_X'00111111'; ! BTM BIT OF EACH QUARTET SET
! IF QUARTET ORIGINALLY X'F'
*IMY_15; ! (2**EPN-1)
*USH_8; *ST_COMPLETED
! COMPLETED CONTAINS BITS FOR ALL
! COMPLETED ESECS
%IF COMPLETED#0 %START
! CLAIM(DTENT_MARK)
! DTENT_PIW=DTENT_PIW!!COMPLETED
! DTENT_MARK=-1; ! RELEASE CA
*LXN_DTENT+4; ! XNB TO DTENT
*INCT_((%XNB+5)); ! DTENT_MARK
*JCC_8,<MARKGOT>
SEMALOOP(DTENT_MARK)
*LXN_DTENT+4
MARKGOT:
*LSS_COMPLETED
*NEQ_((%XNB+9))
*ST_(%DR)
*ST_PIW; ! ANY BITS LEFT OVER
*LSS_-1; *ST_((%XNB+5))
! PIW BITS CLEARED
ESEC=0
%UNTIL COMPLETED=0 %CYCLE
! SERV(DTENT,ESEC) %UNLESS COMPLETED>0
! MSB=0 => EPN MS BITS=0
! COMPLETED=COMPLETED<<EPN
!
! HANDCODE SO AS TO AVOID GOING ROUND CYCLE FOR EMPTY SECYORS
!
*LSS_COMPLETED; *SHZ_%B
*USH_4; *ST_COMPLETED
*LSS_%B; *USH_-2; *IAD_ESEC; *ST_ESEC
SERV(DTENT,ESEC)
ESEC=ESEC+1
%REPEAT
%FINISH; ! WITH THAT DRUM
%IF PAST=0 %AND PIW#0 %START; ! WAS INT BUT NOT IDLE
!
! CHECK TRANSFERS OUTSTANDING FOR FAILURES
!
AD=DTENT_ESCBS(0)_ADDSTRS+8
I=0; SS=0
%WHILE PIW#0 %CYCLE
! %WHILE PIW>0 %THEN I=I+1 %AND PIW=PIW<<1
! PIW=PIW<<1
*LSS_PIW; *SHZ_%B
*ADB_I; *STB_I
*USH_1; *ST_PIW
SS=SS!INTEGER(AD+16*I)
I=I+1
%REPEAT
%IF SS&TROUBLE#0 %THEN %START
%IF MULTIOCP=YES %THEN RESERVE LOG
PDATM; NEWLINES(2)
PRINTSTRING(PTMS); NEWLINE
PTM(DTENT); NEWLINE
PSTATUS(DTENT)
%IF MULTIOCP=YES %THEN RELEASE LOG
%IF DTENT_PAW#0 %START
BRFLAG=1
CONTABA(DTENT_CONTI)_BATCH=1
%FINISH
%FINISH
%FINISH
%FINISH
%IF MULTIOCP=YES %THEN CSEMA=-1
%EXITIF DTENT_NEXT=0
DTENT==RECORD(DTENT_NEXT)
%REPEAT
PAST=PRESENT; ! UPDATE STROBE CLOCK
! ONLYREMAINS TO ISSUE BATCH REQUEST
! IF NEEDED.
DOBR %IF BRFLAG#0
%RETURN; ! TO SUPERVISOR !!!!!!!!!!!!!!!!!!!
ACTIVITY(3): ! AN INTERRUPT HAS OCCURRED, SOME DRUM IDLE OR
! A CONTROLLER RESPONSE, FORMER DEALT WITH
! UNDER "SERVICE:".
CREG=P_INTACT<<16!SAC CONTROL
CONTI=1; CONTAB==CONTAB1
%WHILE CONTAB_ISCONTREG#CREG %CYCLE
CONTI=CONTI+1
CONTAB==CONTABA(CONTI)
%REPEAT
TAKE CRESPS(CONTAB) %IF CONTAB_CRESP0#0
PAST=0; ! FORCES CLOCK UPDATE AND STROBE
->SERVICE
ACTIVITY(4): ! Print and reset all performance counts.
%IF MONLEVEL&4#0 %THEN %START
%IF MULTIOCP=YES %THEN RESERVE LOG
NEWLINES(2)
PDATM
PRINTSTRING(" PERFORMANCE LOG")
NEWLINES(2)
PRINTSTRING(" SFC DRUM TRANSFER COUNTS")
NEWLINE
PRINTSTRING(PTMS." attempted failed recovrd timed out")
NEWLINE
! track through each entry in DTAB
DTENT==DTAB0
DRUM=0
%CYCLE
PTM(DTENT)
SPACES(7)
LOG==LOGTAB(DRUM)
PRINTSTRING(HTOS(LOG_TOT,8))
SPACES(3)
PRINTSTRING(HTOS(LOG_FAIL,4))
SPACES(5)
PRINTSTRING(HTOS(LOG_RECOV,4))
SPACES(5)
PRINTSTRING(HTOS(LOG_TOUTS,4))
NEWLINE
LOG=0; ! RESET ALL COUNTS
%EXIT %IF DTENT_NEXT=0
DTENT==RECORD(DTENT_NEXT)
DRUM=DRUM+1
%REPEAT
NEWLINE
%IF MULTIOCP=YES %THEN RELEASE LOG
%FINISH
%RETURN
ACTIVITY(5): ! PERIODIC CLOCK TICK (4SECS)
! USED FOR TIMEOUT DETECTION+ SERVICE
DTENT==DTAB0
%CYCLE
%IF MULTIOCP=YES %THEN %START
CSEMA==CONTABA(DTENT_CONTI)_SEMA
*INCT_(CSEMA)
*JCC_8,<CSEMAGOT3>
SEMALOOP(CSEMA)
CSEMAGOT3:
%FINISH
STATE=DTENT_STATE
%IF STATE&(\3)>0 %START; ! IF AUTO & ACTIVE
STATE=STATE-1; ! DECREMENT TIME CLOCK
%IF STATE&3=0 %START; ! A TIME OUT !
%IF MULTIOCP=YES %THEN RESERVE LOG
OPMESS("DRUM".HTOS(DTENT_PTM,3)." TIME OUT ")
NEWLINES(4)
PRINTSTRING("DRUM TIME OUT")
NEWLINE
! CLEAR ABNT BY READING STATUS
PSTATUS(DTENT)
! ? PAW BITS WHICH HAVE BEEN IGNORED
%IF MULTIOCP=YES %THEN RELEASE LOG
LOG==LOGTAB(DTENT_LOGI)
LOG_TOUTS=LOG_TOUTS+1
%IF LOG_TOUTS<TOUT LIMIT %START
%IF DTENT_PAW#0 %START
BRFLAG=1
CONTABA(DTENT_CONTI)_BATCH=1;! FORCE BATCH REQUEST
%FINISH
PAST=0; ! FORCE SERVICE
STATE=STATE&(\3)+2; ! RESET TIME CLOCK
%FINISH %ELSE STATE=S %AND FAIL ALL(DTENT)
%FINISH; ! DEALING WITH TIME OUT
DTENT_STATE=STATE; ! UPDATE STATE
%FINISH; ! WITH THIS DRUM AND
%IF MULTIOCP=YES %THEN CSEMA=-1
%EXIT %IF DTENT_NEXT=0
DTENT==RECORD(DTENT_NEXT)
%REPEAT
->SERVICE
%ROUTINE ACTIVATE(%RECORDNAME DTENT, ESCB, %INTEGERNAME Q)
%RECORDSPEC DTENT(DTABF)
%RECORDSPEC ESCB(ESCBF)
%RECORDNAME ESQB(ESQBF)
%LONGINTEGER LSAW; ! COPIES ESCB VALUES TO COMM AREA SAWS
%INTEGER SEC, FIRST; ! INSERTS PAW BITS
%INTEGER COUNT, ADDSTRS
%CONSTLONGINTEGER INCS=X'0001000000000400'; ! SECTOR AND MEMAD SIMULTANEOUSLY
! AND FLAGS FOR BATCH REQUEST.
FIRST=Q
ESQB==PARM(FIRST)
ADDSTRS=ESCB_ADDSTRS
LSAW=ESQB_LSAW
! COUNT=EPN
! %CYCLE
! LONGINTEGER(ADDSTRS)=LSAW
! SAW0 & SAW1
! INTEGER(ADDSTRS+8)=0
! SRESP0
! COUNT=COUNT-1
! %EXITIF COUNT=0
! LSAW=LSAW+INCS
! ADDSTRS=ADDSTRS+16
! %REPEAT
! UNROLL ABOVE LOOP FOR CASE OF EPN=4 ONLY
*LXN_ADDSTRS; ! POINT TO EL 0 OF STREAM
*LB_0
*ST_(%XNB+0); *STB_(%XNB+2)
*IAD_INCS
*ST_(%XNB+4); *STB_(%XNB+6)
*IAD_INCS
*ST_(%XNB+8); *STB_(%XNB+10)
*IAD_INCS
*ST_(%XNB+12); *STB_(%XNB+14)
! COMM AREA SAWS NOW SET UP
Q=Q!S; ! INDICATE IT IS ACTIVE.
! CLAIM(DTENT_MARK)
! DTENT_PAW=DTENT_PAW!ESCB_PAWBS
! DTENT_MARK=-1
! RELEASE
*LXN_DTENT+4
*INCT_((%XNB+5)); ! DTENT_MARK IS INTEGERNAME
*JCC_8,<MARKGOT>
SEMALOOP(DTENT_MARK)
*LXN_DTENT+4; ! RESET XNB AFTER CALL
MARKGOT:
*LCT_ESCB+4
*LSS_(%CTB+3); ! ESCB_PAWBS
*OR_((%XNB+7))
*ST_(%DR)
*LSS_-1; *ST_((%XNB+5))
DTENT_STATE=DTENT_STATE&(\3)+6; ! INCREMENT ACTIVE COUNT AND
! RESET TIME CLOCK (=2 TICKS)
CONTABA(DTENT_CONTI)_BATCH=1; ! #0 => BATCH REQUEST OUTSTANDING.
BRFLAG=1; ! DITTO
%END; ! OF ACTIVATE.
%ROUTINE SERV(%RECORDNAME DTENT, %INTEGER ESEC)
%RECORDSPEC DTENT(DTABF)
%RECORDNAME ESCB(ESCBF); ! AN ESEC TERMINATION HAS OCCURRED
%RECORDNAME ESQB(ESQBF)
%RECORDNAME LOG(LOGTABF)
%INTEGERNAME Q; ! REFERENCES HQ OR LQ AS APPROPRIATE
%INTEGER FIRST, SECOND, SRESPS, THISP, NEXTP;! INDICES IN PARMX
!%INTEGER COUNT, ADDRESP0
%RECORDNAME STOR(STOREF)
LOG==LOGTAB(DTENT_LOGI)
LOG_TOT=LOG_TOT+1
ESCB==DTENT_ESCBS(ESEC)
! WHICH QUEUE IS ACTIVE?
%IF ESCB_HQ<0 %THEN Q==ESCB_HQ %ELSE Q==ESCB_LQ
Q=Q!!S; ! CLEAR ACTIVE MARKER.
FIRST=Q
ESQB==PARM(FIRST)
SECOND=ESQB_Q; ! LINK OVERWRITTEN DURING PON.
! COUNT=EPN
! ADDRESP0=ESCB_ADDSTRS+8
! SRESPS=0
! %CYCLE
! SRESPS=SRESPS ! INTEGER(ADDRSP0)
! COUNT=COUNT-1
! %EXITIF COUNT=0
! ADDRESP0=ADDRESP0+16
! %REPEAT
! UNROLL THIS LOOP FOR THE CASE OF EPN=4 ONLY!!!!
*LXN_ESCB+4
*LCT_(%XNB+4); ! TO EL 0 ESCB_STRS
*LSS_(%CTB+2)
*OR_(%CTB+6)
*OR_(%CTB+10)
*OR_(%CTB+14)
*ST_SRESPS
! PREPARE REPLY
STOR==STORE(ESQB_STORI)
ADPTS=ESQB_P4
!
! IF DRUM DOES NOT REPLY TO PAGETURN THEN THE STORE ARRAY MUST BE UPDATED
! THIS INCLUDES THE CASE WHEN A DRUM WRITE FINISHES AND THE DISCWRITE
! IS STILL GOING AND ALL SUCCESSFUL READS WHEN REPLIES GO TO LOCAL CONT
! THE STORE ARRAY IS SEMAPHORED. TRY TO AVOID HOLDING SEMAS THROUGH
! PROCEDURE CALLS ETC
!
%IF SRESPS&TROUBLE=0 %START
%IF SRESPS&ADV#0 %START
%IF MULTIOCP=YES %THEN RESERVE LOG
REPORT(DTENT,ESEC,"ERROR RECOVERY")
%IF MULTIOCP=YES %THEN RELEASE LOG
%FINISH
%IF MULTIOCP=YES %THEN %START
*INCT_(STORESEMA)
*JCC_8,<GOT2>
SEMALOOP(STORESEMA)
GOT2:
%FINISH
THISP=STOR_FLAGLINK
%IF ADPTS#0 %AND THISP&X'80FF0000'=0 %START
! WRITEOUT NEED REPLY
%IF MULTIOCP=YES %THEN STORESEMA=-1
ESQB_EPAGE=0
FASTPON(FIRST)
%FINISH %ELSE %START
%IF ADPTS=0 %THEN %START; ! WAS READ NO REPLY TO PAGETURN
STOR_FLAGLINK=THISP&X'CFFF0000'
THISP=THISP&X'FFFF'
%IF MULTIOCP=YES %THEN STORESEMA=-1
%UNTIL THISP=0 %CYCLE
NEXTP=PARM(THISP)_LINK
FASTPON(THISP); ! REPLY TO LOCAL CONTROOLER(S)
THISP=NEXTP
%REPEAT
%FINISH %ELSE %START; ! WRITE NO REPLY
STOR_FLAGLINK=THISP&X'CFFFFFFF'
BYTEINTEGER(ADPTS)=BYTEINTEGER(ADPTS)-1
%IF MULTIOCP=YES %THEN STORESEMA=-1
%FINISH
RETURN PPCELL(FIRST)
%FINISH
%FINISH %ELSE %START
%IF MULTIOCP=YES %THEN RESERVE LOG
REPORT(DTENT,ESEC,"TRANSFER FAILURE")
PSTATUS(DTENT); ! WHICH WILL CLEAR ABNT
%IF MULTIOCP=YES %THEN RELEASE LOG
ESQB_EPAGE=-1
FASTPON(FIRST); ! TO PAGETURN FOR RECOVERY
%FINISH
DTENT_STATE=DTENT_STATE-4; ! DECREMENT ACTIVE COUNT
! UPQUEUE ON ESEC
Q=SECOND
! ACTIVATE NEW QUEUE HEAD
%IF ESCB_HQ#0 %THEN Q==ESCB_HQ %ELSE Q==ESCB_LQ
%IF Q#0 %THEN ACTIVATE(DTENT,ESCB,Q)
%END; ! OF SERV.
%ROUTINE TAKE CRESPS(%RECORDNAME CONTENT)
%RECORDSPEC CONTENT(CONTABF)
%INTEGER MN, CRESP0, CRESP1
%INTEGERNAME CSEMA
%RECORDNAME DTENT(DTABF)
! RESPONSE BITS AND MASKS
%CONSTSTRING (24) SFCE="&& DRUM CONTROLLER ERROR"
%CONSTINTEGER ATTENTIONS=X'00102000'
%CONSTINTEGER CRMNMASK=X'03000000'; ! MN BITS IN CRESP
%CONSTINTEGER SWMNMASK=X'00600000'; ! SAME IN SAW0
%CONSTINTEGER CRTOSWSHIFT=3; ! CONVERT CR SW MN POSITION
%CONSTINTEGER AUTO=X'8000'; ! AUTO => AVAILABLE BUT ??
! DEAL WITH DRUM ON & OFF LINE.
! IF OFF THEN SIMPLY :-
! CLEAR PIW, FORGET ABOUT THE MEMI SAW.
! RESET AUTO IN DTAB
! IF ON-LINE:-
! REACTIVATE ALL QUEUES
%IF MULTIOCP=YES %THEN %START
CSEMA==CONTENT_SEMA
*INCT_(CSEMA)
*JCC_8,<CSEMAGOT>
SEMALOOP(CSEMA)
CSEMAGOT:
%FINISH
CRESP0=CONTENT_CRESP0
CRESP1=INTEGER(ADDR(CONTENT_CRESP0)+4)
CONTENT_CRESP0=0; ! SFC WILL NOT OVERWRITE UNTIL 0 WRITTEN THROUGH.
! FIND FIRST DRUM ON THIS SFC
DTENT==DTAB0
%WHILE ADDR(CONTENT)#ADDR(CONTABA(DTENT_CONTI)) %CYCLE
DTENT==RECORD(DTENT_NEXT)
%REPEAT
%IF CRESP0&ATTENTIONS#ATTENTIONS %START
OPMESS(SFCE)
%IF MULTIOCP=YES %THEN RESERVE LOG
NEWLINES(2)
PRINTSTRING(SFCE." "); PDATM
NEWLINE
PRINTSTRING("controller response ")
PRINTSTRING(HTOS(CRESP0,8).HTOS(CRESP1,8)); NEWLINE
PRINTSTRING(PTMS); NEWLINE
PTM(DTENT)
NEWLINE
PSTATUS(DTENT)
%IF MULTIOCP=YES %THEN RELEASE LOG
%RETURN
%FINISH
! ESTABLISH WHICH DRUM INVOLVED
MN=(CRESP0&CRMNMASK)>>CRTOSWSHIFT
%WHILE DTENT_ESCBS(0)_SAW0&SWMNMASK#MN %CYCLE
DTENT==RECORD(DTENT_NEXT)
%REPEAT
! N.B. BOTH CYCLES WHICH SEARCH DTAB
! IN THIS ROUTINE, ARE ASSUMED TO TERMINATE ??
%IF CRESP0&AUTO#AUTO %START
OPMESS("DRUM".HTOS(DTENT_PTM,3)." NOT AUTO!!!")
FAIL ALL(DTENT)
%FINISH %ELSE %START
%IF DTENT_STATE<0 %START
OPMESS("DRUM".HTOS(DTENT_PTM,3)." AUTO AGN")
DTENT_STATE=0; ! AUTO BUT INACTIVE
DTENT_PIW=0
DTENT_PAW=0
%FINISH
%FINISH
%IF MULTIOCP=YES %THEN CSEMA=-1
%END; ! OF TAKE CRESP
%ROUTINE FAIL ALL(%RECORDNAME DTENT)
!***********************************************************************
!* DRUM NOT USABLE. FAIL ALL TRANSFERS AND SEAL IT OFF *
!* THE LONG WAIT MAY CAUSE SEMAPHORE PROBLEMS IN DUALS *
!* IGNORE PRO TEM. HOPEFULLY FAILURES WILL BE RARE *
!***********************************************************************
%RECORDSPEC DTENT(DTABF)
%INTEGER I, J, FIRST, SECOND
%INTEGERNAME Q
%RECORDNAME ESCB(ESCBF)
%RECORDARRAYNAME ESCBS(ESCBF)
OPMESS("ABANDONING DRUM".HTOS(DTENT_PTM,3))
DTENT_STATE=S; ! NOTHING ACTIVE NOW
ESCBS==DTENT_ESCBS
%CYCLE ESEC=0,1,DTENT_SECLIM//EPN-1; !!!!!!!!
ESCB==ESCBS(ESEC)
%CYCLE I=0,1,1
%IF I=0 %THEN Q==ESCB_HQ %ELSE Q==ESCB_LQ
Q=Q&(\S)
%WHILE Q#0 %CYCLE
FIRST=Q
ESQB==PARM(FIRST)
SECOND=ESQB_Q
J=ESQB_DEST
ESQB_DEST=ESQB_SRCE
ESQB_SRCE=J
FASTPON(FIRST)
Q=SECOND
%REPEAT
%REPEAT
%REPEAT
! SOME SFC FAULTS EG LOW GAS PRESSURE ALLOW TRANSFERS TO CONTINUE
! FOR AT LEAST 10 SECS AFTER ATTNT. RESULTS IN HIGHLY INCONVEIENT
! INTERRUPTS. DEAL WITH THIS HERE BY WAITING SO AS TO AVOID LENGTHENING
! PATH IN THE MAIN LOOP
WAIT(100)
DTENT_PIW=0
DTENT_PAW=0
%END
%ROUTINE DOBR
!***********************************************************************
!* PAW BITS HAVE BEEN ADDED TO FOME SFC('S) SINCE THE LAST *
!* BATCH REQUEST WAS ISSUED, COULD HAVE BEEN SWEPT IN *
!* WITH THE WASH OTHERWISE NEED ANOTHER BATCH REQUEST. *
!***********************************************************************
%RECORDNAME CONTENT(CONTABF)
%CONSTINTEGER BR=X'07000000'; ! PAW FUNCTION - BATCH REQUEST
%INTEGER CONTI, ISAD
%INTEGERNAME CSEMA
%RECORDFORMAT CAF(%INTEGER MARK,PAW,SECTS,DRUMRQ,CAW0,CAW1, %C
CRESP0,CRESP1, %LONGINTEGER LPAW01,LPAW23)
%RECORDNAME CA(CAF); ! NEED ACCESS TO PAW AND LPAW'S.
CONTI=CONTMAX
%UNTIL CONTI=0 %CYCLE
CONTENT==CONTABA(CONTI)
%IF MULTIOCP=YES %THEN %START
CSEMA==CONTENT_SEMA
*INCT_(CSEMA)
*JCC_8,<CSEMAGOT>
SEMALOOP(CSEMA)
CSEMAGOT:
%FINISH
%IF CONTENT_BATCH#0 %START
! OUTSTANDING BITS
CA==RECORD(CONTENT_MARKAD)
%IF CA_PAW=0 %START
! PREVIOUS BR HAS BEEN (IS BEING) HONOURED.
ISAD=CONTENT_ISCONTREG
! CLAIM(CA_MARK)
! %IF CA_LPAW01!CA_LPAW23#0 %START
! MUST CLAIM SEMA BEFOR CHECKING THESE AS IT IS A CONTROLLER ERROR
! TO SEND A CH FLAG WITH NO BITS SET
! CA_PAW=BR
*LXN_CA+4; ! XNB TO COMMS AREA
*INCT_(%XNB+0)
*JCC_8,<SEMAGOT>
SEMALOOP(CA_MARK)
*LXN_CA+4
SEMAGOT:
*LSD_(%XNB+8); *OR_(%XNB+10)
*JAT_4,<MISS>
*LSS_BR; *ST_(%XNB+1)
! SEN FLAG
*LB_ISAD
*LSS_1
*ST_(0+%B)
MISS: *LSS_-1; *ST_(%XNB+0)
! %FINISH
%FINISH
CONTENT_BATCH=0; ! NO LONGER OUTSTANDING
%FINISH
CONTI=CONTI-1
%IF MULTIOCP=YES %THEN CSEMA=-1
%REPEAT
%END; ! OF DOBR.
%ROUTINE PSTATUS(%RECORDNAME DTENT)
!***********************************************************************
!* READS AND PRINTS STATUS *
!* WHICH CLEARS ANY ABNORMAL TERMINATION *
!***********************************************************************
%RECORDSPEC DTENT(DTABF)
%RECORDFORMAT CAF(%INTEGER MARK, PAW, N1, N2, CAW0, CAW1, %C
CRESP0, CRESP1)
! NEED ACCESS TO ALL THESE
%CONSTINTEGER PAWFCR=X'04000000'; ! CONTROLLER REQUEST FUNCTION
%CONSTINTEGER RSTATUS=X'31000014'; ! CLEAR ABNT WITH IT.
%CONSTINTEGER NT=X'00800000'
%OWNINTEGERARRAY STATUS(-2:4)= M'SFCS',M'TATE',0(5)
! MUST BE OWN TO ENSURE PHYSICAL CONTIGUITY
%INTEGER ISA, TEMP
%RECORDNAME CA(CAF)
TEMP=DTENT_ESCBS(0)_SAW0&X'00600000'!RSTATUS
! RSTATUS, PLUS MECH NO.
SLAVESONOFF(0); ! THUS FORGET ALL ABOUT SLAVE STORES
CA==RECORD(ADDR(DTENT_MARK))
CA_PAW=PAWFCR
CA_CAW0=TEMP
CA_CAW1=REALISE(ADDR(STATUS(0)))
CA_CRESP0=0
%CYCLE TEMP=0,1,4
STATUS(TEMP)=-1
%REPEAT
ISA=CONTABA(DTENT_CONTI)_ISCONTREG;! SEND FLAG
*LB_ISA; *LSS_1; *ST_(0+%B)
TEMP=100000
%WHILE CA_CRESP0=0 %AND TEMP>0 %CYCLE
TEMP=TEMP-1
%REPEAT
SLAVESONOFF(-1); ! ALL BACK ON SFC DONE
%IF CA_CRESP0#NT %START
PRINTSTRING("read status failed, controller response")
PRINTSTRING(HTOS(CA_CRESP0,8).HTOS(CA_CRESP1,8))
NEWLINE
STATUS(4)=X'DEADDEAD'; ! ?? RECOGNIZABLE
TEMP=CONTROLLERDUMP(1,ISA>>16&255);! DUMP THE SFC
%FINISH
CA_CRESP0=0; ! CLEAR FOR FURTHER RESPONSES
PRINTSTRING("controller status: ")
%CYCLE TEMP=0,1,4
PRINTSTRING(HTOS(STATUS(TEMP),8))
SPACE
%REPEAT
NEWLINES(2)
%END; ! OF PSTATUS
%ROUTINE REPORT(%RECORDNAME DTENT, %INTEGER ESEC, %C
%STRING (47) MESS)
!***********************************************************************
!* THIS ROUTINE PRINTS OUT STREAM RESPONSES *
!* ON THIS ESEC OF THIS DRUM. *
!***********************************************************************
%RECORDSPEC DTENT(DTABF)
%CONSTSTRING(13)%ARRAY ERRS(0:31)= %C
"?", "illegal track","illegal page", "pefa",
"ifa", "FA error", "internal sfc", "?",
"NORMAL TERM", "ABNORMAL TERM","?", "?",
"FAULT", "ADVISORY", "?", "SFC detected",
"mech inop", "mech error", "addressing", "cyclic check",
"srnh", "dev ipe", "?", "?",
"?", "?", "rec adresing", "rec cyc check",
"rec srnh", "rec dev ipe", "rec trunk ipe","?"
%INTEGER BIT, SEC, SRESP0
%INTEGER ADDSTRS
%RECORDNAME STR(STRF)
%RECORDNAME LOG(LOGTABF)
MESS=AAD.MESS
OPMESS(MESS)
NEWLINE
PRINTSTRING(MESS." ")
PDATM
NEWLINES(2)
PRINTSTRING(PTMS); NEWLINE
PTM(DTENT); NEWLINE
ADDSTRS=DTENT_ESCBS(ESEC)_ADDSTRS
LOG==LOGTAB(DTENT_LOGI)
%CYCLE SEC=0,1,EPN-1
STR==RECORD(ADDSTRS)
SRESP0=STR_SRESP0
%IF SRESP0&TROUBLE#0 %START
LOG_FAIL=LOG_FAIL+1
%FINISH %ELSE %START
LOG_RECOV=LOG_RECOV+1 %IF SRESP0&ADV#0
%FINISH
PRINTSTRING(HTOS(SRESP0,8))
PRINTSTRING(" ".HTOS(STR_SRESP1,8))
BIT=0
%UNTIL SRESP0=0 %CYCLE
PRINTSTRING(" ".ERRS(BIT)) %IF SRESP0<0
SRESP0=SRESP0<<1
BIT=BIT+1
%REPEAT
NEWLINES(2)
ADDSTRS=ADDSTRS+16
%REPEAT
NEWLINE
%END; ! OF REPORT.
%ROUTINE INITIALISE(%RECORDNAME P)
%RECORDSPEC P(PONOFF)
%RECORDNAME DTENT(DTABF)
%RECORDNAME ESCB(ESCBF)
%INTEGER ESEC, LOGI, AD
DTAB0==RECORD(COM_SFCA+4)
EPN=P_INTACT; ! P_P1
EPNBITS=\((-1)>>EPN)
! HQ AND LQ OF DRUMTAB 0_ESEC(0) HAVE REL OFFSET OF CONTROLLER TABLE
! AND NO OF CONTROLLERS FROM START OF TABLE PROPER
! FISH OUT PARAMETERS WHICH DEFINE
! CONTROLLER TABLE
ESCB==DTAB0_ESCBS(0)
COM_SFCCTAD=COM_SFCA+ESCB_HQ
CONTABA==ARRAY(COM_SFCCTAD,CONTABAF)
CONTAB1==CONTABA(1)
CONTMAX=ESCB_LQ
%CYCLE LOGI=1,1,CONTMAX
CONTABA(LOGI)_SEMA=-1
%REPEAT
ESCB_HQ=0
ESCB_LQ=0
! SET UP DTAB NEXT'S AS ADDRESSES NOT DISPLACEMENTS
! AND SET UP LOGI INDEXES.
DTENT==DTAB0
LOGI=0
%CYCLE
DTENT_LOGI=LOGI
DTENT_PTM=CONTABA(DTENT_CONTI)_ISCONTREG>>12&X'FF0'! %C
DTENT_ESCBS(0)_SAW0>>21&3
AD=DTENT_NEXT
%EXIT %IF AD=0
AD=AD+P_EPAGE
DTENT_NEXT=AD
DTENT==RECORD(AD)
LOGI=LOGI+1
%REPEAT
! PLUS TIMING VARIABLE (OWN ANYWAY)
PAST=0
%END; ! OF INITIALISE
%ROUTINE PDATM; ! TIME STAMP FOR JOURNAL OUPUT
PRINTSTRING("DT: ".DATE." ".TIME)
%END; ! OF PDATM
%ROUTINE PTM(%RECORDNAME DTENT); ! PRINTS IN FORMAT:-
%RECORDSPEC DTENT(DTABF); !__P_____T_______M
%INTEGER TEMP; ! i.e. port trunk mechanism (PTMS)
TEMP=DTENT_PTM
PRINTSTRING(" ".HTOS(TEMP>>8,1));! PORT
SPACES(5)
PRINTSTRING(HTOS(TEMP>>4&15,1)); ! TRUNK
SPACES(7)
PRINTSTRING(HTOS(TEMP&3,1)); ! MECH NO.
%END; ! OF PTM
%END; ! OF DRUM !!!!!!!!!
%FINISH; ! CONDITIONAL COMPILATION OF DRUM
%EXTERNALROUTINE SEMAPHORE(%RECORDNAME P)
%RECORDSPEC P(PARMF)
%RECORDFORMAT SEMAF(%INTEGER DEST,SRCE,TOP,BTM,SEMA,P4,P5,P6,LINK)
%RECORDNAME SEMACELL(SEMAF)
%RECORDNAME WAITCELL(PARMXF)
%OWNINTEGERARRAY HASH(0:31)=0(32)
%INTEGERFNSPEC NEWSCELL
%INTEGERFNSPEC NEWWCELL
%INTEGER SEMA, HASHP, NCELL, I, WCELL
%INTEGERNAME CELLP
%SWITCH ACT(1:3)
%IF MONLEVEL&2#0 %AND KMON&1<<7#0 %THEN %C
PKMONREC("SEMAPHORE:",P)
SEMA=P_P1
%IF P_DEST&15<3 %THEN HASHP=IMOD(SEMA-SEMA//31*31) %AND %C
CELLP==HASH(HASHP)
->ACT(P_DEST&3)
!-----------------------------------------------------------------------
ACT(1): ! P OPERATION
%WHILE CELLP#0 %CYCLE
SEMACELL==PARM(CELLP)
%IF SEMA=SEMACELL_SEMA %THEN %START
I=SEMACELL_BTM
%IF I=0 %THEN %START; ! ALREADY HAD V OPERATION
SEMACELL_DEST=P_SRCE
SEMACELL_SRCE=X'70001'
FASTPON(CELLP)
CELLP=0
%FINISH %ELSE %START; ! ADD TO BTM OF QUEUE
WCELL=NEWWCELL
PARM(I)_LINK=WCELL
SEMACELL_BTM=WCELL
%FINISH
%RETURN
%FINISH
CELLP==SEMACELL_LINK
%REPEAT
!
! NO QUEUE YET
!
NCELL=NEWSCELL
CELLP=NCELL
WCELL=NEWWCELL
SEMACELL_TOP=WCELL
SEMACELL_BTM=WCELL
%RETURN
!-----------------------------------------------------------------------
ACT(2): ! V OPERATION
%WHILE CELLP#0 %CYCLE
SEMACELL==PARM(CELLP)
%IF SEMA=SEMACELL_SEMA %THEN %START
I=SEMACELL_TOP
SEMACELL_TOP=PARM(I)_LINK
FASTPON(I)
%IF SEMACELL_TOP=0 %THEN %START;! RETURN HEADCELL
I=SEMACELL_LINK
RETURN PP CELL(CELLP)
CELLP=I
%FINISH
%RETURN
%FINISH
CELLP==SEMACELL_LINK
%REPEAT
!
! P OPERATION NOT HERE YET
!
NCELL=NEWSCELL
CELLP=NCELL
%RETURN
!-----------------------------------------------------------------------
ACT(3): ! DISPLAY SEMAPHORE QUEUES
%IF MONLEVEL&2#0 %THEN %START
%CYCLE HASHP=0,1,31
%IF HASH(HASHP)#0 %THEN %START
CELLP==HASH(HASHP)
%WHILE CELLP#0 %CYCLE
SEMACELL==PARM(CELLP)
SEMA=SEMACELL_SEMA
I=SEMACELL_TOP
%WHILE I#0 %THEN OPMESS("SEMA X".HTOS(SEMA,8). %C
" Q :X".HTOS(PARM(I)_DEST>>16,3)) %C
%AND I=PARM(I)_LINK
CELLP==SEMACELL_LINK
%REPEAT
%FINISH
%REPEAT
%FINISH
%RETURN
!-----------------------------------------------------------------------
%INTEGERFN NEWWCELL
%INTEGER I
I=NEWPPCELL
WAITCELL==PARM(I)
WAITCELL_DEST=P_SRCE
WAITCELL_SRCE=X'70001'
WAITCELL_LINK=0
%IF MONLEVEL&2#0 %THEN WAITCELL_P5=M'SEMA'
%IF MONLEVEL&2#0 %THEN WAITCELL_P6=M'WAIT'
%RESULT =I
%END
!-----------------------------------------------------------------------
%INTEGERFN NEWSCELL
%INTEGER I
I=NEWPPCELL
SEMACELL==PARM(I)
SEMACELL=0
SEMACELL_SEMA=SEMA
%IF MONLEVEL&2#0 %THEN SEMACELL_P5=M'SEMA'
%IF MONLEVEL&2#0 %THEN SEMACELL_P6=M'HEAD'
%RESULT=I
%END
%END
%ENDOFFILE