%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) %ROUTINESPEC 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 DLVNADDR,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) %OWNRECORDARRAYFORMAT PROCAF(0:MAXPROCS)(PROCF) %OWNRECORDARRAYNAME PROCA(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 %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, 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&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, 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, 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, ! 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, 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, 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, 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, SEMALOOP(MAINQSEMA) SSEMAGOT: %FINISH SERV_P=SERV_P&X'7FFFFFFF' %IF SERV_L=0 %AND 0 SEMALOOP(MAINQSEMA) GOT: %FINISH %CYCLE I=0,1,3 %IF MASK&(1< SEMALOOP(MAINQSEMA) GOT: %FINISH %CYCLE I=0,1,3 %IF MASK&(1< SEMALOOP(MAINQSEMA) SSEMAGOT: %FINISH SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %THEN MAINQSEMA=-1 %AND %RETURN %IF MONLEVEL&2#0 %THEN %START %IF MULTIOCP=YES %THEN MAINQSEMA=-1;! DONT HOLD DURING O-P CELL=SERVP %UNTIL CELL=SERVP %CYCLE CELL=PARM(CELL)_LINK PKMONREC("PARM CLEARED:",PARM(CELL)) %REPEAT %IF MULTIOCP=YES %THEN %START *INCT_MAINQSEMA *JCC_8, SEMALOOP(MAINQSEMA) SSEMAGOT2: %FINISH %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 2972&76) * !*********************************************************************** %INTEGER I,J,K,SMAC %CYCLE SMAC=0,1,15 %IF 1<>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'<>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'<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'>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 BASIC PTYPE<=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 BASIC PTYPE<=3 %START; ! 2960S & 70S I=X'42086303'!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 BASIC PTYPE<=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 BASIC PTYPE<=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 %EXTERNALROUTINE MONITOR(%STRING(63)S) %IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN HALT OTHER OCP *LSS_(3); *OR_1; *ST_(3); ! MASK SE INT AS FOR SE ! THIS IS FOR IOCP & PRINT PRINTSTRING(S) %MONITOR %STOP %END %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(12)BCAST %INTEGERNAME OCP RETRY COUNT %CONSTINTEGER MIN SAC PORT=0,MAX SAC PORT=1 %CONSTINTEGER UNDUMPSEG=X'80280000',LCSTACK=0,%C RESTACK=X'80180000' 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=" BROADCAST " 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 ! FC=IP>>27&3 %IF BASIC PTYPE=4 %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( %C "SYSTEM ERROR INTERRUPT OCCURRED ".DATE." ".TIME." PARAMETER ".STRHEX(IP).BCAST." 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 BASIC PTYPE<=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 BASIC PTYPE=4 %AND IP&X'18'=X'18' %AND PHOTOAD#-1 %C %THEN RECONSTRUCT P4REGS; ! SYSTEM ERROR TIMEOUT ON P4'S %IF REGAD=-1 %AND PHOTOAD#-1 %AND BCAST="" %START 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 PT ".HTOS(FPN<<4!TRUNK,2)) 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'<>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 DEPTH(FPN)=0; ! IN CASE CONFIGURED BACK ! AFTER REPAIRS BY ENGINRS %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! *IDLE_X'F0FF' %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 *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<>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 * !*********************************************************************** %ROUTINESPEC DUMP SLAVES(%INTEGER PHOTOAD,OCP TYPE) %CONSTHALFINTEGERARRAY PHOTOL(0:6)=0,X'700'(3),X'1400',X'800'(2); ! ! 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=2972,6=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, 12, 12, 13, 13, 26, 26, 26, 35, 14, 27, 27, 27, 38, 15, 28, 28, 28, 14, 16, 40, 40, 40, 15, 17, 24, 24, 24, 36, 18, 29, 29, 29, 37, 19, 30, 30, 30, 39, 20, 21, 21, 21, 34, 21, 31, 31, 31, 34, 22, 32, 32, 32, 34, 23, 16, 16, 16, 34, 24, 33, 33, 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(-1,PHOTOAD,J) DUMP SLAVES(PHOTOAD,OCP TYPE) %RETURN %UNLESS FC=2 %IF BASIC PTYPE=3 %START; ! UNINHIBIT PHOTO *LSS_(X'6011'); *AND_X'FFFE'; *ST_(X'6011') %FINISH %IF BASIC PTYPE=4 %START *LSS_(X'4012'); *AND_X'FEFFFFFF'; *ST_(X'4012') %FINISH *LDTB_X'18000000'; *LDB_J *LDA_PHOTOAD; *MVL_%L=%DR,0,0 ! ! %ROUTINE DUMP SLAVES(%INTEGER START ADDR, OCP TYPE) %IF BASIC PTYPE=4 %THEN %START %STRING (14) %FNSPEC SLAVE TITLE(%INTEGER TYPE) %ROUTINESPEC DUMP BLOCK SLAVE(%INTEGER TYPE) %INTEGERFNSPEC TRANSFORM(%INTEGER LOCAL AD) %ROUTINESPEC PHEX CONTENTS(%INTEGER FROM, LENGTH) %INTEGERNAME LW, RW %LONGINTEGER L %INTEGERARRAY STACK CAMS(0:7) %INTEGER PSTBA, LSTBA, SEG, CAMAD, CAM, LINE, START, I, J, K, FLAG %CONSTINTEGER TOP14BITS=X'FFFC0000' %CONSTINTEGER PUBLIC=X'80000000' %CONSTINTEGER RA0=X'81000000' %CONSTSTRING (2) STAR="* " %RETURN %IF OCP TYPE<4; ! APPLIES TO P4'S ONLY ***** PSTBA=INTEGER(START ADDR+X'148')+RA0; !VA OF PSTB LSTBA=INTEGER(START ADDR+X'150')+RA0; ! VA OF LST I=ADDR(L) LW==INTEGER(I) RW==INTEGER(I+4) ! INSTRUCTION SLAVE SEG=INTEGER(START ADDR+X'190')&TOP14BITS;! PD SEG START=START ADDR+X'1A0'; ! FRAME 3 (CAMS) DUMP BLOCK SLAVE(0); ! INSTRUCTION SLAVE ! STACK SLAVE PRINTSTRING(SLAVE TITLE(2)) I=INTEGER(START ADDR+X'200')<<1; ! SSN/LNB SEG=I&TOP14BITS START=START ADDR; ! FRAME 0 %CYCLE K=0,1,7 L=LONGINTEGER(START)>>24; ! LNWN VALIDS/CAMS STACK CAMS(K)=RW START=START+8 %REPEAT K=0 %CYCLE CAM=0,1,15 %IF CAM<8 %THEN CAMAD=STACK CAMS(K)>>14 %C %ELSE CAMAD=STACK CAMS(K) CAMAD=CAMAD&X'3FFF0'!SEG PHEX CONTENTS(CAMAD,16) PRINTSTRING(STRHEX(CAMAD)) NEWLINE %IF CAM=7 %THEN K=0 %ELSE K=K+1 %REPEAT ! OPERAND SLAVE START=START ADDR+X'380'; ! FRAME 7 DUMP BLOCK SLAVE(1); ! OPERAND SLAVE ! ATU SLAVE PRINTSTRING(SLAVE TITLE(3)) CAM=0 START=START ADDR+X'288'; ! FRAME 5 (CAMS) %WHILE CAM#16 %CYCLE K=INTEGER(START+16); ! SEGS PAGED %CYCLE LINE=0,1,7 CAM=CAM+1 CAMAD=INTEGER(START)&X'FFFFF800' I=7-LINE J=K>>I&1; ! SEG PAGED IF SET %IF CAMAD&PUBLIC#0 %THEN SEG=PSTBA %ELSE SEG=LSTBA SEG=SEG+CAMAD>>15&X'FFF8' PHEX CONTENTS(SEG,8); ! SEGMENT TABLE ENTRY %IF J=1 %AND FLAG=0 %START;! GET PAGE TABLE ENTRIES IF SEGMENT PAGED I=RA0+INTEGER(SEG+4)&X'FFFFFF8'+CAMAD>>8&X'3F8' ! EVEN/ODD PAIR OF PTE'S PHEX CONTENTS(I,8); ! PAGE TABLE ENTRY %FINISH %ELSE PRINTSTRING(STAR) PRINTSTRING(STRHEX(CAMAD)) NEWLINE START=START+8 %REPEAT %IF CAM=8 %THEN START=START ADDR+X'300' ! FRAME 6 %REPEAT %INTEGERFN TRANSFORM(%INTEGER LOCAL AD) !*********************************************************************** !* TAKES A LOCAL ADDRESS AND CHANGES IT INTO A PUBLIC ONE * !*********************************************************************** %LONGINTEGER SEGT ENTRY %INTEGER I,PTAD,SEG,PTENTRY I=LOCAL AD>>18<<3+LSTBA *LDTB_X'18000008'; *LDA_I *VAL_(%LNB+1); *JCC_3, SEGT ENTRY=LONG INTEGER(I) ->INVALID %UNLESS SEGT ENTRY>>31&1#0;! UNLESS AVAILABLE PTAD=SEGT ENTRY&X'0FFFFFF0'+RA0 %IF SEGT ENTRY<<1>0 %THEN %RESULT=LOCAL AD&X'3FFFF'+PTAD ! UNPAGED SEGS PTAD=PTAD+4*(LOCAL AD>>10&255) *LDTB_X'18000004'; *LDA_PTAD *VAL_(%LNB+1); *JCC_3, PTENTRY=INTEGER(PTAD) ->INVALID %UNLESS PTENTRY<0; ! UNLESS PAGE AVAILABLE %RESULT=PTENTRY&X'0FFFFFF0'+LOCAL AD&X'3FF'+RA0 INVALID: ! PAGE NOT AVAILABLE %RESULT=0 %END %ROUTINE PHEX CONTENTS(%INTEGER FROM, LENGTH) %INTEGER I %IF FROM>0 %THEN FROM=TRANSFORM(FROM) ->INVALID %IF FROM=0 *LDTB_X'18000000' *LDB_LENGTH *LDA_FROM *VAL_(%LNB+1) *JCC_3, %CYCLE I=0,4,LENGTH-4 PRINTSTRING(STRHEX(INTEGER(FROM+I))." ") %REPEAT FLAG=0 %RETURN INVALID: PRINTSTRING(STAR) FLAG=1 %END; ! OF PHEX CONTENTS %STRING (14) %FN SLAVE TITLE(%INTEGER TYPE) %CONSTSTRING(12) %ARRAY NAME(0:3)= %C "INST","OPER","STACK","ATU" %RESULT =" ".NAME(TYPE)." SLAVE " %END; ! OF SLAVE TITLE %ROUTINE DUMP BLOCK SLAVE(%INTEGER TYPE) %INTEGER CAM, CAMAD, LINE, I PRINTSTRING(SLAVE TITLE(TYPE)) %CYCLE CAM=0,1,3<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'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, CAA, %C RQA, LBA, ALA, STATE, IW1, CONCOUNT, SENSE1, SENSE2, SENSE3, %C SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, %C %STRING (6) LAB, %BYTEINTEGER MECH, %INTEGER PROPS, %C STATS1,STATS2,%BYTEINTEGER QSTATE,PRIO,SP1,SP2,%INTEGER LQLINK, %C UQLINK,CURCYL,SEMA,TRLINK,SPR3) %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)) %CONSTBYTEINTEGERARRAY HEXDS(0:15)='0','1','2','3','4','5','6','7', '8','9','A','B','C','D','E','F' %CONSTINTEGER NORMALT=X'800000', ERRT=X'400000', %C ATTNT=X'100000', DISCSNO=X'00200000', PDISCSNO=X'210000', %C SCHEDSNO=X'30000' %OWNBYTEINTEGERARRAYFORMAT LVNF(0:99) %OWNBYTEINTEGERARRAYNAME LVN %CONSTLONGINTEGER LONGONE=1 %OWNINTEGER DITADDR, NDISCS %EXTERNALROUTINE DISC(%RECORDNAME P) %RECORDSPEC P(PARMF) %ROUTINESPEC SET PAW(%RECORDNAME DDT, %INTEGER PAW, SAW) %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 PROP(PROPFORM) %RECORDNAME LABEL(LABFORM) %RECORDNAME CCA(CCAFORM) %CONSTINTEGER HOLD=X'800',AUTO=X'8000',AUTOAVAIL=AUTO!X'400';! BITS IN ATTN BYTE %CONSTINTEGER DEAD=0,CONNIS=1,RLABIS=2,DCONNIS=3,AVAIL=4,PAGTIS=5,%C PAGSIS=6,INOP=7,RRLABIS=8,PTISLOGP=9,PAVAIL=10,PCLAIMD=11,%C PTRANIS=12,PSENIS=13,SPTRANIS=14 %CONSTINTEGER RESPX=1<>16))#0 %THEN %C PKMONREC("DISC:",P) %IF ACT>=64 %THEN ->ACT64 ->INACT(ACT) INACT(0): ! INITIALISATION ! NO LONGER ANY PARAMS %RETURN %UNLESS NDISCS=0; ! IN CASE INITIALISED TWICE NDISCS=COM_NDISCS DITADDR=COM_DITADDR LVN==ARRAY(COM_DLVNADDR,LVNF) %CYCLE I=0,1,99 LVN(I)=254 %REPEAT 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) ! PTBASE HAS A POINTER TO SLOTX. SLOTX CONTAINS 16 ENTRIES ! ONE FOR EACH STREAM AND POINTS TO THE DDT SLOT. THUS ANY DISC CAN ! BE FOUND WITHOUT SEARCHING ! I=INTEGER(COM_FPCCONFA) %IF I>MAX DFCS %THEN I=MAX DFCS %AND %C OPMESS("TOO MANY DFCS FOR DISC") %CYCLE J=1,1,I PTBASE(INTEGER(COM_FPCCONFA+4*J)>>24)=16*J %REPEAT %CYCLE J=0,1,NDISCS-1 DDT==RECORD(INTEGER(DITADDR+4*J)) PT=DDT_PTS>>4 STRM=DDT_PTS&15 PTCA(PT)<-DDT_CAA>>18; ! TO ASSOCIATE INTS SLOTX(PTBASE(PT)+STRM)=J SENSE(DDT,0) DDT_STATE=CONNIS; ! 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):- ! DEAD = 0 = NOT ON LINE OR UNLOADED ! CONNIS = 1 = CONNECT INTERFACE & SENSE ISSUED ! RLABIS = 2 = READ LABEL ISSUED ! DCONNIS = 3 = DISCONNECT (IE UNLOAD) ISSUED. MUST RECONNECT ON TERMNTN ! ! IF THE LABEL WAS VALID THE STATES THEN GO:= ! AVAIL = 4 = AVAILABLE FOR PAGED OR PRIVATE USE ! PAGTIS = 5 = PAGED TRANSFER ISSUED ! PAGSIS = 6 = PAGED TRANSFER HAS FAILED & A SENSE ISSUED ! INOP = 7 = INOPERABLE AWAITING OPERATOR RELOAD ! RRLABIS = 8 = REREAD LABEL ISSUED ! PTISLOGP = 9 = AS PAGTIS BUT READ STREAM LOG PENDING ! ! NONEXISTENT OR INVALD LABELS THEN GO ! PAVAIL = 10 = AVAILABLE FOR PRIVATE USE ! PCLAIMD = 11 = CLAIMED FOR PRIVATE USE BY SER=DDT_STATUS ! PTRANIS = 12 = PRIVATE CHAIN ISSUED ! PSENIS = 13 = PRIVATE CHAIN HAS FAILED & A SENSE ISUUED ! SPTRANIS = 14 = SPECIAL PRIVATE CHAIN ISSUED (NO SENSE ON FAILURE) ! 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=PAVAIL %OR(DDT_STATE=AVAIL %AND DDT_DLVN<0)%START DDT_STATE=PCLAIMD DDT_BASE=P_P2 ->REPLY %FINISH %ELSE ->CLAIM FAILS %FINISH %ELSE %START %IF DDT_STATE#PCLAIMD %THEN OPMESS("BUM DEV RETURNED") %C %AND %RETURN DDT_STATE=PAVAIL; DDT_REPSNO=0 RQB==RECORD(DDT_RQA); ! RESET RQB (IT MAY HAVE BEEN CHANGED) RQB_LSEGPROP=128<<18!X'C000' RQB_LSEGADDR=INTEGER(X'8004000C')&X'FFFFF80' PROP==RECORD(DDT_PROPADDR) RQB_LBPROP=X'18000000'+PROP_LBLKSIZE RQB_LBADDR=DDT_LBA RQB_ALPROP=X'18000000'+PROP_ALISTSIZE RQB_ALADDR=DDT_ALA RQB_W6=X'FF00' OPMESS(MTOS(DDT_MNEMONIC)." UNUSED") %IF P_P2<0 %THEN SENSE(DDT,0) %AND DDT_STATE=CONNIS %RETURN %FINISH REPLY: ! REPLY TO CLAIMS ONLY P_P2=DISCSNO+64+I P_P3=I P_P4=DDT_MNEMONIC STRING(ADDR(P_P5))=DDT_LAB SEND: P_DEST=P_SRCE P_SRCE=DISCSNO+1 PON(P) %RETURN CLAIM FAILS: P_P2=0; ->SEND INACT(2): ! PAGED REQUEST(_P1=DDTADDR) DDT==RECORD(P_P1) %IF DDT_STATE#AVAIL %OR P_SRCE&X'FFFF0000'#PDISCSNO %THEN ->REJECT DDT_STATE=PAGTIS; DDT_ID=P_P1 DDT_STICK=CURRTICK STRM=DDT_PTS&15; ! REAL STREAM NO J=STRM+(P_P2+1)<<24; ! STRM REQ NORMAL OR PRIORITY SET PAW(DDT,J,X'10000024') %RETURN *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 ! 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#PCLAIMD %THEN ->REJECT ! DDT_REPSNO=P_SRCE DDT_ID=P_P1; ! SAVE PRIVATE ID %IF P_P2<0 %THEN DDT_STATE=SPTRANIS %ELSE DDT_STATE=PTRANIS CCA==RECORD(DDT_CAA) 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(DDT,X'01000000'+STRM,X'10000024');! USER SAW FLAGS IGNORED PRO TEM %RETURN REJECT: ! DISC REQUESTED REJECTED %IF DDT_STATE=INOP %OR DDT_STATE=RRLABIS %THEN %C CCA==RECORD(DDT_CAA) %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 RESPX&1<TOUT %REPEAT %RETURN TOUT: ! DEVICES TIMES OUT OPMESS(MTOS(DDT_MNEMONIC)." TIMED OUT") CCA==RECORD(DDT_CAA) STRM=DDT_PTS&15 %IF CCA_PIW1&X'80000000'>>STRM#0 %THEN %START OPMESS(MTOS(DDT_MNEMONIC)." MISSING INT PONNED") P_DEST=DISCSNO+3; P_SRCE=0 P_P1=DDT_PTS>>4 PON(P) %RETURN %FINISH CCA_PAW=0; CCA_MARK=-1 %IF DDT_STATE=CONNIS %THEN DDT_STATE=DEAD %AND %RETURN; ! NO RETRY SET PAW(DDT,X'01000000'+STRM,X'10000024') 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 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(8): ! TRANSFER IN PROGRESS WHEN ZX DEV AWOKE DDT==RECORD(INTEGER(DITADDR+4*P_P1)) CCA==RECORD(DDT_CAA); ! FOR CHINT %IF PAGIO&1<REPLY INOP; ! P_P2 IS OLD DDT_STATE PT=DDT_PTS>>4 %IF PRIVIO&1<COM2 INACT(3): ! INTERRUPTS !*********************************************************************** !* DISC INTERRUPT HANDLING SEQUENCE * !*********************************************************************** PT=P_P1; ! EXTRACT PORT & TRUNK FROM INT PTR=PTCA(PT) %IF PTR=0 %THEN PRINTSTRING("NO DFC ON PT ".STRHEX(PT)."? ") %AND %RETURN CCA==RECORD(X'80000000'+PTR<<18) MORE INTS: ! SEE IF ANY MORE INTS *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8,; ! 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 SLOT=SLOTX(PTBASE(PT)+STRM) PTS=PT<<4+STRM DDT==RECORD(INTEGER(DITADDR+4*SLOT)) %IF DDT_PTS#PTS %THEN OPMESS("DISC TABLES ????") %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 NINT(AVAIL):FINT(AVAIL): NINT(PAVAIL):FINT(PAVAIL): NINT(PCLAIMD):FINT(PCLAIMD): NINT(DEAD):FINT(DEAD): ! DEAD DISC TERINATES? PRINTSTRING("DISC INT STATE ".STRINT(DDT_STATE)." ????? ") ->CHINT NINT(CONNIS): ! SENSE TERMINATES %IF DDT_MNEMONIC>>16=ZXDEV %START; ! THE KRAKEN WAKES! J=DDT_PROPS K=M'ED'<<16+HEXDS(J>>20&15)<<8+HEXDS(J>>16&15); ! REAL MNEMONIC %CYCLE I=0,1,NDISCS-1; ! FIND OLD SLOT XDDT==RECORD(INTEGER(DITADDR+4*I)) %IF XDDT_MNEMONIC=K %START XDDT_MNEMONIC=XDDT_MNEMONIC&X'FFFF'!ZXDEV<<16 %IF RESPX&1<>24=X'35' %THEN DDT_PROPADDR=DDT_PROPADDR+PROPLEN; ! EDS200 %FINISH 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=RLABIS %FINISH %ELSE DDT_STATE=DEAD ->CHINT NINT(RRLABIS): ! LABEL ON REMOUNTED DISC READ NINT(RLABIS): ! 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=RRLABIS %THEN DDT_LAB=PREVLAB %AND ->REMOUNT ! WRONG DISC REMOUNTED LVN(I)=SLOT DDT_DLVN=I!X'80000000' DDT_STATE=AVAIL %FINISH %ELSE %START %IF DDT_STATE=RRLABIS %THEN ->REMOUNT;! WRONG DISC REMOUNTED DDT_BASE=0 DDT_STATE=PAVAIL DDT_DLVN=-1 S=" FRGN" %FINISH DDT_STATS1=0 DDT_STATS2=0 LOAD MESS: OPMESS(MTOS(DDT_MNEMONIC)." LOADED ".DDT_LAB.S) ->CHINT DUPLICATE: ! DISC WITH SAME LVN MOUNTED ! MAY BE REMOUNT OF REQD DISC ! ON SAME OR DIFFERENT DRIVE XDDT==RECORD(INTEGER(DITADDR+4*LVN(I)));! ON OLDMOUNT SLOT %UNLESS XDDT_STATE=INOP %OR XDDT_STATE=RRLABIS %START;! NOT AWAITING REMOUNT OPMESS("DUPLICATE DISC LVN ") DDT_DLVN=-1; ! DONT CLEAR LVN WHEN UNLOADING UNLOAD(DDT) DDT_STATE=DCONNIS; ->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_STATS1=XDDT_STATS1; ! INCLUDING FCHK&CLODING BITS DDT_STATS2=XDDT_STATS2 DDT_CONCOUNT=XDDT_CONCOUNT %IF XDDT_PTS=COM_IPLDEV %THEN COM_IPLDEV=DDT_PTS; ! FOR AUTO IPL XDDT_STATS1=0; XDDT_STATS2=0; XDDT_STATE=DEAD XDDT_CONCOUNT=0 LVN(I)=SLOT %FINISH DDT_STATE=AVAIL PON(P) ->LOADMESS SENSE TIMEOUT: FINT(CONNIS): ! SENSE FAILS DDT_STATE=DEAD; ->CHINT FINT(RLABIS): ! READ LABEL FAILS LABREAD ENDS DDT_LAB="NOLABL" DDT_DLVN=-1 DDT_STATE=PAVAIL OPMESS(MTOS(DDT_MNEMONIC)." LOADED NO LABEL") DDT_BASE=0 ->CHINT NINT(DCONNIS):FINT(DCONNIS): ! UNLOAD COMPLETE SENSE(DDT,0); ! RECONNECT INTERFACE DDT_STATE=CONNIS UNLDED:OPMESS(MTOS(DDT_MNEMONIC)." UNLOADED") %IF DDT_DLVN#-1 %THEN LVN(DDT_DLVN&255)=255 ->CHINT AINT(RLABIS): LABREAD ENDS AINT(DEAD):AINT(CONNIS): ! ATTENTION WHILE INITIALISING PRINTSTRING("ATTNTN WHILE INITNG ".HTOS(PTS,3)." ". %C STRHEX(SIW1).STRHEX(SIW2)." ") %CYCLE I=1,1,5000 %IF CCA_PIW1&(X'80000000'>>STRM)#0 %THEN ->CHINT %REPEAT DDT_STATE=CONNIS SENSE(DDT,1); ! START SEQUENCE AGAIN AINT(DCONNIS): ! EXTRA ATTENTION CAUSED BY UNLOAD ->CHINT AINT(AVAIL):AINT(PAVAIL): ! ATTENTION WHILE IDLE %IF SIW1&AUTOAVAIL=AUTOAVAIL %START; ! GRATUITOUS 'AUTO & AVAILABLE' PRINTSTRING("SURPRISE ATTNTN ON ".HTOS(PTS,3)." ". %C STRHEX(SIW1).STRHEX(SIW2)." ") ->CHINT %FINISH AINT(PAGTIS):AINT(PAGSIS):AINT(PTISLOGP): ! ATTENTION WHILE PAGING %IF SIW1&HOLD#0 %THEN %START; ! HOLD WAS PRESSED %IF DDT_STATE=PAVAIL %OR %C (DDT_STATE=AVAIL %AND DDT_CONCOUNT=0) %START ! NOT IN SYSTEM USE CAN UNLOAD UNLOAD(DDT) DDT_STATE=DCONNIS %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=PAVAIL %OR %C (DDT_STATE=AVAIL %AND DDT_CONCOUNT=0) %START DDT_STATE=DEAD ->UNLDED %FINISH REMOUNT: ! DEMAND RELOAD OF DEMOUNTED DISC OPMESS("RELOAD ".DDT_LAB." NOW!!!".TOSTRING(17)) DDT_STATE=INOP ->CHINT AINT(INOP): ! ATTENTION WHILE WAITING REMOUNT %IF SIW1&AUTO#0 %START; ! DRIVE NOW RELOADED READ DLABEL(DDT); ! CHECK ITS RIGHT DISC LABREADS=LABREADS+1 DDT_STATE=RRLABIS %FINISH ->CHINT AINT(RRLABIS): FINT(RRLABIS): ! FAILED TO READ LABEL LABREAD ENDS OPMESS(MTOS(DDT_MNEMONIC)." LABEL READ FAILS") ->REMOUNT NINT(INOP):FINT(INOP): ! TRANSFERS & SENSES GOING WHEN ! DISC WENT INOP HAVE NOW FINISHED REPLY INOP: ! TELL PDISC DISC IS INOP P_P3=ERRT; ! TRANSFER FAILED ON LB 0 P_P4=0 P_P5=NORMALT; ! SENSE WORKED P_DEST=PDISCSNO+10 P_SRCE=DISCSNO DDT_ID=ADDR(DDT) 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 FINT(SPTRANIS): ! SPECIAL PRIVAT CHAIN FAILS ! DO A CONTROLLER SENSE ONLY ! SO AS TO LEAVE STATUS CCA==RECORD(DDT_CAA) CCA_CSAW2=ADDR(DDT_SENSE1) SET PAW(DDT,X'04000000',X'11000008') ! DONT WAITFOR INT NINT(PTRANIS): ! PRIVATE CHAIN OK NINT(SPTRANIS): ! SPECIAL 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=PCLAIMD ->CHINT FINT(PTISLOGP): ! PAGE REQUEST FAILS DDT_STATE=PAGTIS; ! ABANDON PENDING LOGGING READ FINT(PAGTIS): ! PAGED REQUEST FAILS FINT(PTRANIS): ! PRIVATE CHAIN FAILS DDT_IW1=SIW1 DDT_SENSE1=SIW2 DDT_STATE=DDT_STATE+1 SENSE(DDT,2) ->CHINT NINT(PTISLOGP): ! PAGE TRAN OK STREAM LOG(DDT); ! DEAL WITH PENDING LOGGING ! REQUEST BEFORE REPLYING NINT(PAGTIS): ! PAGED TRANSFER OK P_DEST=PDISCSNO+10 P_SRCE=DISCSNO+2 P_P1=DDT_ID P_P2=0 DDT_STATE=AVAIL PDISC(P); ! CALL NOT PON FOR EFFICIENCY ->CHINT NINT(PAGSIS): ! PAGED SENSE OK FINT(PAGSIS): ! PAGED SENSE FAILS P_DEST=PDISCSNO+10 P_SRCE=DISCSNO+2 DDT_STATE=AVAIL ->COM1 NINT(PSENIS): ! PRIVATE SENSE OK FINT(PSENIS): ! PRIVATE SENSE FAILS (!???) P_DEST=DDT_REPSNO P_SRCE=DISCSNO+64+DDT_PTS&15 DDT_STATE=PCLAIMD 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(PCLAIMD):AINT(PTRANIS):AINT(PSENIS): ! 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) %INTEGER STRM STRM=DDT_PTS&15 RQB==RECORD(DDT_RQA) RQB_W7=X'80001300' RQB_W8=0 SET PAW(DDT,X'01000000'+STRM,X'10000024') %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) %INTEGER LBA,ALA,STRM LBA=DDT_LBA ALA=DDT_ALA STRM=DDT_PTS&15 DDT_STICK=CURRTICK RQB==RECORD(DDT_RQA) ! 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(DDT,X'01000000'+STRM,X'10000024') %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 * !* & READ PROPCODES (INTO DDT_PROPS) * !* A SENSE IS ALWAYS KEPT BELOW THE FALSE FLOOR IN LBLOACK &ALIST * !*********************************************************************** %RECORDNAME RQB(RQBFORM) %RECORDSPEC DDT(DDTFORM) %INTEGER LBA,ALA,STRM LBA=DDT_LBA-12+4*VAL ALA=DDT_ALA-16 STRM=DDT_PTS&15 DDT_STICK=CURRTICK RQB==RECORD(DDT_RQA) RQB_LBADDR=LBA RQB_ALADDR=ALA RQB_W7=X'02001300'; ! DO CHAIN SET PAW(DDT,X'01000000'+STRM,X'10000024') %END %ROUTINE SET PAW(%RECORDNAME DDT,%INTEGER PAW,SAW) !*********************************************************************** !* GRAB SEMA AND SET ACTIVATION WORDS. THEN FIRE IO * !*********************************************************************** %RECORDNAME CCA(CCAFORM) %RECORDSPEC DDT(DDTFORM) %INTEGER W,OLDPAW CCA==RECORD(DDT_CAA) %CYCLE W=1,1,5 *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CCA_MARK) GOTSEMA: OLDPAW=CCA_PAW %IF OLDPAW=0 %THEN ->FIRE ! ! RATHER THAN WAIT TRY TO FORM A BATCH REQUEST ! ! DUMPTABLE(0,ADDR(CCA),512) %IF OLDPAW>>24<=2 %THEN OLDPAW=X'07000000' + %C (X'8000'>>(OLDPAW&15)) %IF OLDPAW>>24=7 %AND PAW>>24<=2 %THEN %C PAW=OLDPAW!(X'8000'>>(PAW&15)) %AND ->FIRE %IF W<3 %THEN %START CCA_MARK=-1 *LXN_DDT+4; *LB_(%XNB+31) *LSS_1; *ST_(0+%B) WAIT(1) %FINISH %REPEAT PRINTSTRING(" DFC--PAW NOT CLEARED") FIRE: CCA_PAW=PAW %IF PAW=X'04000000' %THEN CCA_CSAW1=SAW %ELSE %C INTEGER(ADDR(CCA)+32+16*(DDT_PTS&15))=SAW CCA_MARK=-1 *LXN_DDT+4 *LB_(%XNB+31); ! CH FLAG IS ADDRESS *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_CAA,288);! COMMS AREA DUMPTABLE(61,DDT_LBA,600); ! LBS & ADDRESS LISTS %FINISH %ELSE %START *LB_ISA; *LSS_2; *ST_(0+%B); ! MASTER CLEAR %FINISH %IF R#X'0080' %START; ! MCLEAR WILL HAVE STARTED ALD AUTOLD=SLOT<<16!25; ! ALLOW 3*25=75 SECS OPMESS("TRYING TO AUTOLD DFC") %RETURN %FINISH WAIT(1000); ! A SEC TO SETTLE DOWN PART2: SLAVESONOFF(0); ! TURN OFF SLAVES INIT_W0=((INTEGER(X'80040008')&X'FFFC'+X'80')//8-1)<<18! %C X'80000000' INIT_W1=INTEGER(X'8004000C')&X'0FFFFF80' INIT_W2=DDT_CAA; ! W2 TO COMMS AREA ADDRESS ! ! INIT W0&W1 HAVE SIZE&BASE 0F PST. NOW SET UP REAL0 AS COMMAREA ! CCA0==RECORD(REAL0ADDR) CCA0_MARK=-1 CCA0_PAW=X'04000000'; ! DO CONTROLLER REQ CCA0_CSAW1=X'12000014'; ! 20 BYTES OF INIT INFO CCA0_CSAW2=REALISE(ADDR(INIT)) *LB_ISA; *LSS_1; *ST_(0+%B) WAIT(5) %IF DUMPS=0 %THEN %START DUMPTABLE(64,REAL0ADDR,127) DUMPTABLE(65,DDT_CAA,127) %FINISH %IF CCA0_PAW=0 %THEN OPMESS("DFC REINITIALISED") %AND DUMPS=-1 %C %ELSE OPMESS("FAILED TO AUTOLOAD DFC") CCA==RECORD(DDT_CAA) CCA_CRESP1=0; ! DELETE INITIALISE RESPONSE CCA_PAW=0 %CYCLE I=0,1,NDISCS-1 DDT==RECORD(INTEGER(DITADDR+4*I)) %IF DDT_PTS>>4=PT %AND RESPX&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_STATS2,9); ! PAGES TRANSFERRED WRITE(DDT_STATS1,9); ! PAGES THAT FAILED TO TRANSFER PRINTSTRING(" ".DDT_LAB) %IF DDT_BASE=X'800' %THEN PRINTSTRING(" (IPL VOL)") DDT_STATS1=0; DDT_STATS2=0 %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_STATS1,8) WRITE(DDT_STATS2,9) PRINTSTRING(" SENSE DATA (RESP=".STRHEX(P_P5).") ") 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 %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 REQFORM(%INTEGER DEST, %BYTEINTEGER FAULTS, FLB, %C LLBP1, REQTYPE, %INTEGER IDENT, CYLINK, COREADDR, CYL, %C TRKSECT, STOREX, REQLINK) %RECORDSPEC P(PARMF) %RECORDNAME DDT,XDDT(DDTFORM) !%RECORDNAME PROP(PROPFORM) %RECORDNAME RQB(RQBFORM) %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 !%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, PRIO 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 ! %CYCLE I=0,1,NDISCS-1 DDT==RECORD(INTEGER(DITADDR+4*I)) DDT_QSTATE=0 DDT_LQLINK=0 DDT_UQLINK=0 DDT_TRLINK=0 DDT_CURCYL=0 %IF MULTIOCP=YES %THEN DDT_SEMA=-1 %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 ->REJECT %IF UNIT>99 J=P_P2&X'FFFFFF'; ! FSYS RELATIVE PAGE LUNIT=LVN(UNIT) ->REJECT %IF LUNIT>=NDISCS DDT==RECORD(INTEGER(DITADDR+4*LUNIT)) ! PROP==RECORD(DDT_PROPADDR) ! I=J//PROP_PPERTRK ! SECT=J-I*PROP_PPERTRK+1 ! CYL=I//PROP_TRACKS ! TRACK=I-CYL*PROP_TRACKS ! %IF CYL>PROP_CYLS %THEN ->REJECT *LCT_DDT+4 *LXN_(%CTB+2); ! XNB TO PROPS RECORD *LSS_J *IMDV_(%XNB+2); ! _PPERTRK *IMDV_(%XNB+0); ! PROP_TRACKS *ST_CYL *LB_%TOS *STB_TRACK *LB_%TOS *ADB_1 *STB_SECT *ICP_(%XNB+1); ! PROP_CYLS *JCC_2, ! %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_DDT+4 *INCT_(%XNB+29); ! DDT_SEMA *JCC_8, SEMALOOP(DDT_SEMA) QSEMAGOT1: %FINISH %IF DDT_QSTATE=0 %OR CYL>=DDT_CURCYL %THEN %START ! QUEUE(DDT_UQLINK,CELL,CYL) LINK==DDT_UQLINK; *JLK_ %FINISH %ELSE %START ! QUEUE(DDT_LQLINK,CELL,CYL) LINK==DDT_LQLINK; *JLK_ %FINISH ->INIT TRANSFER %IF DDT_QSTATE=0; ! UNIT IDLE %IF MULTIOCP=YES %THEN DDT_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 CELL=DDT_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 ! DDT_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; PRIO=1 %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 REQ_REQTYPE#PTACT %THEN PRIO=0 %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=DDT_TRLINK DDT_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=DDT_UQLINK DDT_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_STATS2=DDT_STATS2+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(DDT) P_P2=PRIO DDT_QSTATE=1 DDT_CURCYL=CYL %IF MULTIOCP=YES %THEN DDT_SEMA=-1 DISC(P) %RETURN PDA(10): ! REPLY FORM DISC DDT==RECORD(P_P1) %IF MULTIOCP=YES %THEN %START *LXN_DDT+4 *INCT_(%XNB+29); ! DDT_SEMA *JCC_8, SEMALOOP(DDT_SEMA) QSEMAGOT2: %FINISH CELL=DDT_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 DDT_TRLINK=0; ! NO TRANSFERS IN PROGRESS DOMORE: %IF DDT_UQLINK=0 %THEN DDT_UQLINK=DDT_LQLINK %C %AND DDT_LQLINK=0 ->INIT TRANSFER %IF DDT_UQLINK#0 DDT_QSTATE=0 %IF MULTIOCP=YES %THEN DDT_SEMA=-1 %RETURN %FINISH %IF MONLEVEL&4#0 %THEN %START DDT_STATS1=DDT_STATS1+1 %FINISH ! UPDATE FAILURE COUNT ! WHILST AVOIDING OVERFLOW ERRLBE=P_P3&255 %IF P_P5&NORMALT=0 %THEN SEC STAT=0 %ELSE 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=DDT_CURCYL ! ! NOTE RECOVERED ERRORS STOP THE CHAIN ON THE NON-FAILING LBE WHICH ! IS NORMALLY THE PAGE TRANSFER LBE. THIS BLOCK HAS TRANSFERED OK ! THE NEXT TRANSFERS HAVE NOT BEEN STARTED. THEREFORE UP THE LBE COUNT ! BY ONE AND REFRAIN FROM TAGGING ANY TRANSFER AS HAVING FAILED ! THUS ALL NECESSARY REQUEING SHOULD BE DONE INCLUDING THE CASE WHEN ! THE RECOVERY IS ON THE SEARCH ! %WHILE CELL#0 %CYCLE REQ==RECORD(PCELLSIZE*CELL+AD);! ==PARM(CELL) DDT_TRLINK=REQ_REQLINK %IF REQ_LLBP1<=ERRLBE %OR REQ_FAULTS>RETRIES %START %IF REQ_LLBP1<=ERRLBE %THEN REQ_CYLINK=TRAN OK %ELSE %C REQ_CYLINK=FAIL %IF REQ_CYLINK#0 %THEN %START PKMONREC("PDISC TRANSFER FAILS",P) %FINISH %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=DDT_TRLINK %REPEAT %IF SEC STAT<0 %THEN DDT_QSTATE=2 %AND %RETURN;! DISC INOP ->DOMORE PDA(11): ! INOP DISC NOW OPERABLE DDT==RECORD(INTEGER(DITADDR+4*P_P1)) ! CURRENT DRIVE VIA DDT_QHDAD %IF P_P1#P_P2 %START; ! IS ON A DIFFERENT DRIVE XDDT==RECORD(INTEGER(DITADDR+4*P_P2));! PREVIOUS DRIVE DDT_LQLINK=XDDT_LQLINK DDT_UQLINK=XDDT_UQLINK XDDT_LQLINK=0 XDDT_UQLINK=0 XDDT_QSTATE=0 %FINISH DDT_TRLINK=0 DDT_CURCYL=0 ->DOMORE !%ROUTINE QUEUE(%INTEGERNAME LINK,%INTEGER CELL,CYL) !*********************************************************************** !* QUEUES REQUEST IN ASCENDING PAGE(IE CYL) ORDER SO SEEK TIMES * !* ARE MINIMISED. PRIO=0 TRANSFERS ALWAYS GO TO FRONT HOWEVER * !* APART FROM DEMAND PAGES AT HEAD THIS IS THE OPTIMAL ALGORITHM * !* FOR QUEUES UP TO 32 IN CACM.15.3 MAR 1972 PP177 ET SEQ * !*********************************************************************** !%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 %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<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 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< 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 %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, 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_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 %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, 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, 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, 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) ! 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