%EXTERNALSTRING (15) %FNSPEC STRINT(%INTEGER N) %EXTERNALSTRING (8) %FNSPEC STRHEX(%INTEGER N) %EXTERNALSTRING(8) %FNSPEC HTOS(%INTEGER VALUE,PLACES) %EXTERNALROUTINESPEC PTREC(%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) !* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20A ONWARDS * %RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C DCODEDA,SUPLVN,WASKLOKCORRECT,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,DPTADDR,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:2015)(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>0 %THEN %START %EXTRINSICLONGINTEGER KMON %FINISH !----------------------------------------------------------------------- %ROUTINE PUTONQ(%INTEGER SERVICE) %RECORDNAME PROC(PROCF) %RECORDNAME SERV, SERVQ(SERVF) %INTEGERNAME RUNQ SERV==SERVA(SERVICE) %IF LOCSN0 %RETURN ON: %REPEAT PRINTSTRING(" SEMA FORCED FREE AT ".STRHEX(ADDR(SEMA))) SEMA=0 %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 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>1 %AND SERVICE>MAXSERV %C %THEN PRINT STRING('INVALID PON:') %AND PTREC(P) %C %AND %RETURN %IF MULTIOCP=YES %THEN %START *INCT_MAINQSEMA *JCC_8, 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, 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>1 %AND SERVICE>MAXSERV %C %THEN PRINT STRING('INVALID DPON:') %AND PTREC(P) %C %AND WRITE(DELAY,4) %AND %RETURN %IF DELAY<=0 %THEN PON(P) %AND %RETURN %IF MULTIOCP=YES %THEN %START *INCT_MAINQSEMA *JCC_8, 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 ELAPSED INT(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>0 %AND KMON&1<<12#0 %THEN %C PRINT STRING('DPONPUTONQ:') %AND PTREC(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, 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>0 %AND(SERVICE<0 %OR SERVICE>MAXSERV) %C ! %THEN PRINT STRING('INVALID POFF:') %AND PTREC(P) %C ! %AND P_DEST=0 %AND %RETURN ! %IF MULTIOCP=YES %THEN %START ! *INCT_MAINQSEMA ! *JCC_8, ! 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 SERVP=SERV_P&X'3FFFFFFF' SCELL==PARM(SERVP) CELL=SCELL_LINK CCELL==PARM(CELL) P<-CCELL %IF MULTIOCP=YES %THEN %START *INCT_MAINQSEMA *JCC_8, SEMALOOP(MAINQSEMA) PSEMAGOT: %FINISH %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, 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>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, 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>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, SEMALOOP(MAINQSEMA) SSEMAGOT: %FINISH SERV_P=SERV_P&X'7FFFFFFF' %IF SERV_L=0 %AND 0 SEMALOOP(MAINQSEMA) SSEMAGOT: %FINISH SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %THEN MAINQSEMA=-1 %AND %RETURN %IF MONLEVEL>1 %THEN %START CELL=SERVP %UNTIL CELL=SERVP %CYCLE CELL=PARM(CELL)_LINK PRINT STRING('PARM CLEARED:') PTREC(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 HAM2980(%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<>16; I=I&X'FFFF' J=J!!(-1) *LB_I; *LSS_(0+%B) *AND_J; *ST_(0+%B) %IF COM_OCPTYPE=4 %OR COM_OCPTYPE=6 %THEN HAM2980(0) %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 (00 %AND 1<<10&KMON# 0 %THEN %C PRINTSTRING("ELAPSED INT:") %AND PTREC(P) ->ACT(I) %IF 0<=I<=2 %IF MONLEVEL>1 %AND I>2 %THEN %C PRINTSTRING("ELAPSED INT REJECTS: ") %AND PTREC(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'>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 %EXTERNALROUTINE SYSERR(%INTEGER STK, IP) !*********************************************************************** !* CALLED AFTER RECOVERED AND UNRECOVERED SYSTEM ERRORS * !* IP=SYTEM ERROR INTERUPT PARAMETER. STACK =INTERUPTED SSN * !*********************************************************************** %ROUTINESPEC PRINT PHOTO %ROUTINESPEC STORE ERROR(%INTEGER FC) %CONSTSTRING(19)%ARRAY FCODE(0:3)="SOFTWARE ERROR", "IRRECOVERABLE ERROR","SUCCESSFUL RETRY","UNSUCCESSFUL RETRY" ! 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:39)="", "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", "SCHEDULER FAIL", "UNDOCMTD ERROR?", "SCU ERROR", "ENGINE ERROR", "SCHEDULER ERROR", "SAU ERROR", "COMMS 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, 35, 13, 26, 34, 26, 36, 14, 27, 34, 27, 37, 15, 28, 34, 28, 38, 16, 24, 34, 24, 16, 17, 29, 34, 29, 16, 18, 30, 34, 30, 39, 19, 21, 34, 21, 34, 20, 31, 34, 31, 13, 21, 32, 34, 32, 34, 22, 16, 34, 16, 34, 23, 14, 34, 14, 34, 24, 34, 34, 34, 34, 25, 34, 34, 34, 34, 34, 34, 34, 34; %INTEGER I, J, K, FC, FPN, SACREG, TRUNK, ACT0, ACT1, ACT2, ACT3, %C PHOTOAD, REGAD, REGPHOTO OFFSET %OWNBYTEINTEGERARRAY DEPTH(0:3) %CONSTINTEGER STORE ERR COUNT=8 %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 ! ! 2980 HAS DIFFERENT FAILURE CODE TO 2970&2960. TRANSPOSE FC TO 70 MODE ! %IF COM_OCPTYPE=4 %OR COM_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 %IF MIN SAC PORT<=FPN<=MAX SAC PORT %START I=X'44000200'!FPN<<20 *LB_I ; *LSS_(0+%B) ; *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 %FINISH PRINT STRING(" 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 COM_OCPTYPE<=3 %THEN %START;! P2 & P3 %IF IP&X'20000'=0 %THEN REGAD=STK+X'40000' %IF IP&X'40000'=0 %THEN PHOTOAD=X'81000100' %AND %C REGPHOTOOFFSET=X'3000'; ! NB P3 HAS PHOTO IN SMAC1 OPTION ! BUT EMAS DOES NOT ENABLE IT SO ! CAN FORGET IT. P2 HASNT OPTION %FINISH %ELSE %START; ! P4S (INCL 2972 &2976) %IF IP&X'30000'=X'10000' %THEN REGAD=STK+X'40000' %IF IP&X'20000'#0 %THEN %C PHOTOAD=X'81000100'+IP&X'10000'<<6 %AND %C REGPHOTO OFFSET=X'580' %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 %THEN %START PRINTSTRING("SSN+1 SET UP FROM PHOTO ! ") MOVE(64,PHOTOAD+REGPHOTO OFFSET,STK+X'40000') %FINISH %IF FC=2 %THEN %START; ! RETRY WAS SUCCESFUL %IF IP&X'C000'#0 %THEN STORE ERROR(FC) %ELSE PRINT PHOTO RETRY COUNT=RETRY COUNT+1 %IF IP&X'20000'#0 %THEN RFLAGS=RFLAGS!1 %IF RETRY COUNT>=STORE ERR COUNT %THEN %START RFLAGS=RFLAGS!2 J=COM_INHSSR K=J>>16; J=J&X'FFFF' *LB_J; *LSS_(0+%B) *OR_K; *ST_(0+%B); ! SHUT UP ERROR REPORTING %IF COM_OCPTYPE=4 %OR COM_OCPTYPE=6 %THEN HAM2980(-1) %FINISH DEPTH(FPN)=0 *ACT_ACT0 ; ! RESUME INTERRUPTED PROCESS %FINISH %ELSE %START %IF FC=1 %AND IP&X'C000'#0 %START; ! HARD STORE ERROR STORE ERROR(FC); ! MIGHT HELP ENGINEERS ! %FINISH %FINISH PRINT PHOTO ! ! IF THE OLD STACK WAS SUPERVISOR OR LOCAL CONTROLLER THEN FAULT WAS ! EITHER UNRECOVERABLE HARDWARE ERROR OF MASKED PROGRAM ERROR. IN ! NEITHER CASE CAN WE CONTINIUE SO FORCE DIAGNOSTICS AND A CRAPOUT ! IF THE OLD STACK WAS A USER STACK THEN IT MUST HAVE BEEN A H-W ERROR ! SINCE PROGRAM ERRORS ARE UNMASKED. IN THIS CASE USE AN OUT (OUT 28) ! TO PASS CONTROL TO THE LOCAL CONTROLLER. ! %UNLESS STK<0 %OR STK=LCSTACK %START INTEGER(STK!X'40044')=IP; ! STORE SEIP INWORD 17 OF SSN+1 DEPTH(FPN)=0 *OUT_28; ! TO LOCAL CONTROLLER %FINISH 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 *LSS_I *ST_(%LNB+0) ; ! TO FRIG %MONITOR PRINTSTRING("DISASTER ") %MONITOR %IF HANDKEYS&X'FFFF'#0 %START ACT3=RESTACK *ACT_ACT0 %FINISH HOOT(7) RECURSIVE: *IDLE_X'DEAD' %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<>I#0 %THEN %C PRINTSTRING(SEMESS(SWSEPTR(I))) %REPEAT %FINISH %ELSE %START; ! HARDWARE ERRORS %CYCLE I=16,1,30 %IF IP&X'80000000'>>I#0 %THEN %C PRINTSTRING(SEMESS(HWSEPTR(COM_OCPTYPE,I))) %REPEAT %FINISH %FINISH %ELSE %START; ! SAC ERROR 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 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)) DEPTH(FPN)=0 *ACT_ACT0 %FINISH %IF PHOTOAD<0 %THEN %RETURN; ! NO PHOTO TAKEN PRINTSTRING("PHOTOGRAPH AREA ") DUMP TABLE(0,PHOTOAD,X'700') %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 JSW(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'A3780000'); ! 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 ") 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>0 %AND KMON&(LONGONE<<(DISCSNO>>16))#0 %THEN %C PRINTSTRING("DISC:") %AND PTREC(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 INHIBIT(SCHEDSNO>>16) ! ! 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 ! 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<=PTRHIT %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, 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 ! IF THE REQUEST HAS COME VIA A LOCAL CONTOLLER THEN P_P3&4 ! DEFINE AN AREA WHICH L-C HAS LOCKED DOWN. ALSOL P_P5&6 HAS ! THE USERS LOCAL SEGMENT BASE. THIS MUST BE PUT INT THE RQB ! 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 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) %RETURN REJECT: ! DISC REQUESTED REJECTED %IF 7<=DDT_STATE<=8 %THEN DDT_ID=P_P1 %AND ->REPLY INOP PRINTSTRING('*** DISC REJECTS ') PTREC(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<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 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<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,; ! GET SEMAPHORE SEMALOOP(CCA_MARK) *LXN_CCA+4 SGOT: *LSS_(%XNB+2); *ST_PIW *JAT_4, *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) P_DEST=X'0032000B'; PON(P); ! TURN OFF FLASHING MESSAGE ->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 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, 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=X'0080'; ! MP 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!21; ! ALLOW 3*21=63 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< 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 DDT_STATS=0; ! CLEAR OUT WITH LOGGING INF %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) 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>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 %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'(2) %CONSTINTEGER RETRIES=7, MAXTRANS=12 %CONSTINTEGER IGNORELB=X'400000' %CONSTINTEGER TRANOK=0, TRANWITHERR=1, TRANREJECT=2, %C NOTTRANNED=3, PTACT=5 %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>0 %AND KMON&(LONGONE<<(PDISCSNO>>16))#0 %THEN %C PRINTSTRING("PDISC:") %AND PTREC(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(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, ! %IF MULTIOCP=YES %THEN %START *INCT_MAINQSEMA *JCC_8, 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, SEMALOOP(QHEAD_SEMA) QSEMAGOT1: %FINISH %IF QHEAD_STATE=0 %OR CYL>=QHEAD_CURCYL %THEN %START ! QUEUE(QHEAD_UQLINK,CELL,CYL) LINK==QHEAD_UQLINK; *JLK_ %FINISH %ELSE %START ! QUEUE(QHEAD_LQLINK,CELL,CYL) LINK==QHEAD_LQLINK; *JLK_ %FINISH ->INIT TRANSFER %IF QHEAD_STATE=0; ! UNIT IDLE %IF MULTIOCP=YES %THEN QHEAD_SEMA=-1 %RETURN REJECT: ! REQUEST INVALID PRINTSTRING('*** PDISC REJECTS ') PTREC(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 QHEAD_CURCYL=CYL %IF CYL=0 %THEN XTRA=IGNORELB %ELSE XTRA=0 FIRST HEAD=REQ_TRKSECT>>16 CURR HEAD=FIRST HEAD FIRST SECT=REQ_TRKSECT>>8&255 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 %CYCLE I=1,1,MAXTRANS 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 ! J=REQ_CYLINK REQ_REQLINK=QHEAD_TRLINK QHEAD_TRLINK=CELL FLB=(LBA-LBA0)>>2 REQ_LLBP1=FLB CELL=J ! ! 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) 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 %REPEAT REQ_REQLINK=QHEAD_UQLINK QHEAD_UQLINK=CELL DECHAIN: ! 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 DDT_STATS=DDT_STATS+I; ! UPDATE TRANSFER COUNT 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 %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, 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, 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, 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 DDT==RECORD(QHEAD_DDTADDR) DDT_STATS<-LENGTHENI(DDT_STATS)+X'00400000' ! UPDATE FAILURE COUNT ! WHILST AVOIDING OVERFLOW ERRLBE=P_P3&255 SEC STAT=INTEGER(P_P6+4) 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 PRINTSTRING("PDISC TRANSFER FAILS :-") PTREC(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 %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 QCYCLE: *LB_(%XNB+8); ! ENTRY_REQLINK *JAT_12, *MYB_PCELLSIZE; *ADB_AD *LCT_%B; *ICP_(%CTB+5); ! NEXTREQ_CYL *JCC_4, *LXN_%B; *JCC_7,; ! CC STILL SET *J_ 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, 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 %OWNINTEGER DSN, DSSN; ! SERVICE NUMBERS %OWNINTEGER DSNSRCE, DSSNSRCE; ! 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>0 %AND KMON&LONGONE<<(P_DEST>>16)#0 %THEN %C PRINTSTRING("DRUM: ") %AND PTREC(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, *ISB_(%CTB+0) *LCT_(%CTB+3) *J_ 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, 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 SEMALOOP(CSEMA) CSEMAGOT2: %FINISH %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< 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<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 PDATM; NEWLINES(2) PRINTSTRING(PTMS); NEWLINE PTM(DTENT); NEWLINE PSTATUS(DTENT) %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. NEWLINES(2) PDATM PRINTSTRING(" PERFORMANCE LOG") NEWLINES(2) PRINTSTRING( %C " 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 %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, 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 ! 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 LOG==LOGTAB(DTENT_LOGI) LOG_TOUTS=LOG_TOUTS+1 %IF LOG_TOUTSSERVICE %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, 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 REPORT(DTENT,ESEC,"ERROR RECOVERY") %IF SRESPS&ADV#0 %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, 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 REPORT(DTENT,ESEC,"TRANSFER FAILURE") PSTATUS(DTENT); ! WHICH WILL CLEAR ABNT 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, 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) 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) %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, 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, SEMALOOP(CA_MARK) *LXN_CA+4 SEMAGOT: *LSD_(%XNB+8); *OR_(%XNB+10) *JAT_4, *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) DSN=P_DEST>>16 DSSN=DSN+1 DSNSRCE=DSN<<16 DSSNSRCE=DSSN<<16 ! 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>0 %AND KMON&1<<7#0 %THEN %C PRINT STRING('SEMAPHORE:') %AND PTREC(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>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 ".STRINT(SEMA). %C " QUEUE :".HTOS(PARM(I)_DEST>>16,2)) %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>0 %THEN WAITCELL_P5=M'SEMA' %IF MONLEVEL>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>0 %THEN SEMACELL_P5=M'SEMA' %IF MONLEVEL>0 %THEN SEMACELL_P6=M'HEAD' %RESULT=I %END %END %ENDOFFILE