!* !* Communications record format - extant from CHOPSUPE 22A onwards * !* %RECORDFORMAT COMF(%INTEGER OCPTYPE,SLIPL,SBLKS,SEPGS,NDISCS,DLVNADDR, %C (%INTEGER GPCTABSIZE,GPCA %OR %INTEGER DCUTABSIZE,DCUA), %C %INTEGER SFCTABSIZE,SFCA,SFCK,DIRSITE, %C DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, %C TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, %C %BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C NOCPS,RESV2,OCPPORT1,OCPPORT0,%INTEGER ITINT,CONTYPEA, %C (%INTEGER GPCCONFA %OR %INTEGER DCUCONFA), %C %INTEGER FPCCONFA,SFCCONFA,BLKADDR,RATION, %C (%INTEGER SMACS %OR %INTEGER SCUS), %C %INTEGER TRANS,%LONGINTEGER KMON, %C %INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, %C MAXCBT,PERFORMAD,SP1,SP2,SP3,SP4,SP5,SP6, %C LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, %C HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, %C SDR4,SESR,HOFFBIT,BLOCKZBIT,BLKSHIFT,BLKSIZE,END) !----------------------------------------------------------------------- ! PON & POFF etc. declarations %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) %CONSTLONGINTEGER NONSLAVED=X'2000000000000000' %CONSTINTEGER PCELLSIZE=36; ! PARM cell size %CONSTINTEGER MARGIN=48; ! margin of unformatted cells %RECORDFORMAT PDOPEF(%INTEGER CURRMAX, MAXMAX, FIRST UNALLOC, %C LAST UNALLOC, NEXTPAGE, S1, S2, S3, S4) %EXTERNALINTEGER PARMASL=0,MAINQSEMA=-1 %RECORDFORMAT PARMXF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK) %CONSTRECORD(PARMXF)%ARRAYNAME PARM=PARM0AD %CONSTRECORD(PDOPEF)%NAME PARMDOPE=PARM0AD %EXTERNALLONGINTEGER PARMDES %OWNLONGLONGREAL GETNEWPAGE %CONSTRECORD(COMF)%NAME COM=X'80C00000' %RECORDFORMAT STOREF(%INTEGER FLAGLINK,BFLINK,REALAD) %CONSTRECORD(STOREF)%ARRAYNAME STORE=STORE0AD %CONSTINTEGERNAME STORESEMA=STORE0AD+8;! use STORE(0)_REALAD as SEMA %CONSTSTRINGNAME DATE=X'80C0003F' %CONSTSTRINGNAME TIME=X'80C0004B' %CONSTINTEGER TRANSIZE=1024*EPAGESIZE %CONSTINTEGER LOCSN1=LOCSN0+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 inter OCP lockout %CONSTRECORD(SERVF)%ARRAYNAME SERVA=SERVAAD ! 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) %OWNRECORD(PROCF)%ARRAYFORMAT PROCAF(0:MAXPROCS) %OWNRECORD(PROCF)%ARRAYNAME PROCA %IF MONLEVEL&2#0 %THEN %START %EXTERNALLONGINTEGERSPEC KMON %FINISH %EXTERNALSTRING (15) %FNSPEC STRINT(%INTEGER N) %EXTERNALSTRING (8) %FNSPEC STRHEX(%INTEGER N) %EXTERNALSTRING(8) %FNSPEC HTOS(%INTEGER VALUE,PLACES) %EXTERNALROUTINESPEC PKMONREC(%STRING(20)TEXT,%RECORD(PARMF)%NAME P) %EXTERNALROUTINESPEC OPMESS(%STRING (63) S) %ROUTINESPEC MONITOR(%STRING (63) S) %EXTERNALROUTINESPEC DUMP TABLE(%INTEGER T, A, L) %ROUTINESPEC ELAPSED INT(%RECORD(PARMF)%NAME P) %SYSTEMROUTINESPEC MOVE(%INTEGER L,F,T) %SYSTEMROUTINESPEC ETOI(%INTEGER A, L) %ROUTINESPEC PDISC(%RECORD(PARMF)%NAME P) %EXTERNALROUTINESPEC HOOT(%INTEGER NHOOTS) %EXTERNALROUTINESPEC WAIT(%INTEGER MSECS) %EXTERNALINTEGERFNSPEC HANDKEYS %EXTERNALINTEGERFNSPEC REALISE(%INTEGER PUBVIRTADDR) %EXTERNALROUTINESPEC SLAVESONOFF(%INTEGER ONOFF) %EXTERNALINTEGERFNSPEC SAFE IS READ(%INTEGER ISAD,%INTEGERNAME VAL) %EXTERNALINTEGERFNSPEC SAFE IS WRITE(%INTEGER ISAD,%INTEGER VAL) %IF MULTIOCP=YES %THEN %START %EXTERNALROUTINESPEC RESERVE LOG %EXTERNALROUTINESPEC RELEASE LOG %FINISH !----------------------------------------------------------------------- %ROUTINE PUTONQ(%INTEGER SERVICE) %RECORD(PROCF)%NAME PROC %RECORD(SERVF)%NAME SERV, SERVQ %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 ! %IF MULTI OCP=YES %START *LSS_(3); *USH_-26 *AND_3; *ST_I; ! OCP port PRINTSTRING("Sema forced free at ". %C STRHEX(ADDR(SEMA))." (OCP".STRINT(I).") ") %FINISH %ELSE PRINTSTRING("Sema forced free at ". %C STRHEX(ADDR(SEMA))." ") %REPEAT %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 ! ! %FOR I=0,1,EPAGESIZE-1 %CYCLE INTEGER(PTAD+4*I)=REALAD+1024*I %REPEAT ! ! Adjust param area descriptor and format up new bit of parmlist ! CMAX=CMAX+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+EPAGESIZE CELLS=CELLS-MARGIN %FOR I=FIRST,1,CELLS-1 %CYCLE 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(%RECORD(PARMF)%NAME P) %RECORD(SERVF)%NAME SERV,SERVQ %RECORD(PARMXF)%NAME ACELL, SCELL, NCELL %INTEGER SERVICE, NEWCELL, SERVP, I SERVICE=P_DEST>>16 %IF MONLEVEL&2#0 %AND (SERVICE>MAXSERV %OR SERVICE=0)%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 %RECORD(SERVF)%NAME SERV,SERVQ %RECORD(PARMXF)%NAME CCELL, SCELL 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(%RECORD(PARMF)%NAME P, %INTEGER DELAY) !*********************************************************************** !* As for PON except for a delay of "DELAY" seconds. Zero delays * !* are allowed. ELAPSED INT is used to kick DPONPUTONQ * !*********************************************************************** %RECORD(PARMF) POUT %RECORD(PARMXF)%NAME ACELL, NCELL %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(%RECORD(PARMF)%NAME P) !*********************************************************************** !* Scond part of DPON. The delay has elapsed and P_DACT has the * !* number of a PPCELL set up ready for fastponning * !*********************************************************************** %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 %RECORD(PARMXF)%NAME ACELL %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(%RECORD(PARMF)%NAME 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 * !!*********************************************************************** !%RECORD(SERVF)%NAME SERV !%RECORD(PARMXF)%NAME ACELL, CCELL, SCELL !%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(%RECORD(SERVF)%NAME SERV,%RECORD(PARMF)%NAME P) !*********************************************************************** !* A more efficient POFF for supervisor * !* assumes vital checks have been done * !*********************************************************************** %CONSTLONGINTEGER PARMDR=X'1800002400000000'+PARM0AD %CONSTLONGINTEGER LINKDR=X'2B00000900000020';! WORD UNSC BCI %RECORD(PARMXF)%NAME ACELL, CCELL, SCELL %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 *LCT_SERV+4; *LSS_(%CTB+0) *AND_X'3FFFFFFF'; *ST_SERVP; ! SERVP=SERV_P&X'3FFFFFFF' *IMY_X'24'; *IAD_PARM0AD *ST_SCELL+4; ! SCELL==PARM(SERVP) *LD_LINKDR; *LSS_(%DR+SCELL+4) *ST_%B; ! CELL=SCELL_LINK *IMYD_X'24'; *IAD_PARMDR *ST_CCELL; ! CCELL==PARM(CELL) *SLD_P; *MV_%L=32; ! P<-CCELL ! %IF CELL=SERVP %THEN SERV_P=SERV_P&X'C0000000' %C %ELSE SCELL_LINK=CCELL_LINK *LD_%TOS *CPB_SERVP; *JCC_7,8 *LSS_(%CTB+0); *NEQ_SERVP *ST_(%CTB+0); ! SERV_P=SERV_P&X'C0000000' *J_5 *LSS_(%DR+CCELL+4) *ST_(%DR+SCELL+4); ! 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 *LSS_PARMASL; *JAF_4,5; ! USES XNB! *STB_(%DR+CCELL+4); *J_11; ! CCELL_LINK=CELL *IMY_X'24'; *IAD_PARM0AD *ST_ACELL+4; ! ACELL==PARM(PARMASL) *LSS_(%DR+ACELL+4); *ST_(%DR+CCELL+4);! CCELL_LINK=ACELL_LINK *STB_(%DR+ACELL+4); ! ACELL_LINK=CELL *STB_PARMASL %IF MULTIOCP=YES %THEN MAINQSEMA=-1 %END !----------------------------------------------------------------------- %EXTERNALROUTINE RETURN PPCELL(%INTEGER CELL) !*********************************************************************** !* Returns a cell suplied for other purposes via NEWPPCELL * !*********************************************************************** %RECORD(PARMXF)%NAME ACELL, CCELL 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 * !*********************************************************************** %RECORD(SERVF)%NAME SERV %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 * !*********************************************************************** %RECORD(SERVF)%NAME SERV %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 %FOR I=0,1,3 %CYCLE %IF MASK&(1< SEMALOOP(MAINQSEMA) GOT: %FINISH %FOR I=0,1,3 %CYCLE %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 !----------------------------------------------------------------------- %IF SSERIES=NO %START; ! not S series protem %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 %FOR SMAC=0,1,15 %CYCLE %IF 1<>3&3)) WAITCOUNT=10*LAPSED MINS ERRORS OFF=ERRORS OFF!RFLAGS&X'18' %FINISH %IF RFLAGS&X'C00'#0 %START; ! one or both OCPs off OPMESS("REPORTING OFF ".OMESS(RFLAGS>>10&3)) WAITCOUNT=10*LAPSED MINS ERRORS OFF=ERRORS OFF!RFLAGS&X'C00' %FINISH RFLAGS=0 %FINISH %IF WAITCOUNT#0 %THEN %START %IF P_DEST&15=1 %THEN WAITCOUNT=WAITCOUNT-1 %C %ELSE WAITCOUNT=0 %IF WAITCOUNT=0 %START %IF SSERIES=NO %AND ERRORS OFF&2#0 %START; ! turn hamming on OPMESS("HAMMING REPORTING ON") STORE RETRY COUNT=0 HAMMING(0) ERRORS OFF=ERRORS OFF&(\2) %FINISH %IF SSERIES=NO %AND ERRORS OFF&X'18'#0 %START; ! turn SAC reporting back on OPMESS("REPORTING ON ".SMESS(ERRORS OFF>>3&3)) %IF ERRORS OFF&8#0 %THEN SAC0 RETRY COUNT=0 %IF ERRORS OFF&X'10'#0 %THEN SAC1 RETRY COUNT=0 ERRORS OFF=ERRORS OFF&(\X'18') %FINISH ! check following stuff for S3s *LSS_(3); *USH_-26 *AND_3; *ST_MYPORT %IF SSERIES=YES %THEN MYPORT=2; !***S3 PROTEM %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 %RECORD(QF)%NAME Q 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 SSERIES=NO %AND MULTIOCP=YES %START; ! minimal code for S series protem %EXTERNALROUTINE HALT OTHER OCP %INTEGER I,HISPORT *LSS_(3); *USH_-26 *AND_3; *NEQ_1 *ST_HISPORT %IF BASIC PTYPE<=3 %THEN %START *LSS_0; *ST_(X'6009'); ! suppress BSE 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 *LSS_(X'4013'); *AND_X'FFFF7FFB'; *ST_(X'4013'); ! clear MULT & DD %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 %EXTERNALROUTINE 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 *LSS_(X'4013'); *OR_X'8004'; *ST_(X'4013'); ! reset MULT & DD 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 routine %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 duals *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 %IF SSERIES=NO %START %ROUTINESPEC RECONSTRUCT P4REGS %ROUTINESPEC STORE ERROR(%INTEGER FC) %FINISH %ROUTINESPEC RESUME(%INTEGER MODE) %IF SSERIES=YES %START %CONSTSTRING(19)%ARRAY FCODE(0:3)="SOFTWARE ERROR", "HARDWARE ERROR","OCP LOGGING INT.","L64 LOGGING INT." %FINISH %ELSE %START %CONSTSTRING(19)%ARRAY FCODE(0:4)="SOFTWARE ERROR", "IRRECOVERABLE ERROR","SUCCESSFUL RETRY","UNSUCCESSFUL RETRY",%C "SAC ERROR" %CONSTSTRING(7)%ARRAY CONT(0:3)="NOTHING"," SFC "," FPC2 "," GPC "; %CONSTINTEGER MIN SAC PORT=0,MAX SAC PORT=1 %INTEGER SACREG,TRUNK,CONTYPE %FINISH %SWITCH FAILURE(0:3) %INTEGER I, J, K, FC, FPN, ACT0, ACT1, ACT2, ACT3, %C PHOTOAD, REGAD, REGPHOTO OFFSET, OCPTYPE, MYPORT %OWNBYTEINTEGERARRAY DEPTH(0:3) %CONSTINTEGER ERR COUNT=8 %STRING(12)BCAST %INTEGERNAME RETRY COUNT %CONSTINTEGER UNDUMPSEG=X'80280000',LCSTACK=0,%C RESTACK=X'80180000' FPN=IP>>29 %IF SSERIES=YES %THEN FPN=0; ! bits 0-2 reserved ->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 ! bits 2-5 now relevant? (see PSD 2.5.1) 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 ! ! for 2966: 0=S/W, 1=H/W, 2 & 3=logging (recovered?) ! FC=IP>>27&3 %IF SSERIES=NO %AND BASIC PTYPE=4 %THEN FC=(X'1320'>>(4*FC))&15 %IF SSERIES=NO %START SACREG=0 TRUNK=0 %FINISH I=COM_LSTL *LB_I ; *LSS_(0+%B) *ST_ACT0 I=COM_LSTB *LB_I ; *LSS_(0+%B) *ST_ACT1 ACT2=0 ACT3=STK %IF SSERIES=NO %AND MIN SAC PORT<=FPN<=MAX SAC PORT %START %IF ERRORS OFF&(8<>20&15)) PRINTSTRING(" OLD STACK=".STRHEX(STK)) I=INTEGER(X'8000017C'+FPN<<18) %IF I>0 %THEN PRINTSTRING(" USER=".PROCA(I)_USER) NEWLINE ! ! 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. ! %IF SSERIES=NO %START; ! omit rest of diags protem ! 'till relevant info obtained! 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 recoverable provided ! the SAC sys int reg can be read and cleared. Otherwise the int ! remains pending and will screw SAFE IS OP Etc. ! %IF MIN SAC PORT<=FPN<=MAX SAC PORT %START I=X'44000000'!FPN<<20 *LB_I; *ADB_X'200' *LSS_(0+%B); *ST_SACREG PRINTSTRING(" SAC SYS INT=".STRHEX(SACREG)) %IF SAFE IS READ(I,J)=0 %THEN %C PRINTSTRING(" SAC PER INT=".STRHEX(J)) %IF SAFE IS READ(I+X'400',J)=0 %THEN %C PRINTSTRING(" SAC STATUS =".STRHEX(J)) %IF SACREG>>16#0 %THEN %START J=X'80000000' %FOR I=0,1,15 %CYCLE %IF SACREG&J#0 %THEN %EXIT J=J>>1 %REPEAT TRUNK=I CONTYPE=BYTEINTEGER(COM_CONTYPEA+TRUNK) PRINTSTRING(" TRUNK ".STRINT(TRUNK)." HAS ".CONT(CONTYPE)." ON IT") I=X'40000000'!FPN<<20!TRUNK<<16 %IF SAFE IS READ(I,J)=0 %THEN %C PRINTSTRING(" TRUNK ADDR REG - 0XX=".STRHEX(J)) %IF SAFE IS READ(I+X'800',J)=0 %THEN %C PRINTSTRING(" TRUNK CONTROL REG - 8XX=".STRHEX(J)) %IF SAFE IS READ(I+X'C00',J)=0 %THEN %C PRINTSTRING(" TRUNK STATUS REG - CXX=".STRHEX(J)) %IF SAFE IS READ(I+X'D00',J)=0 %THEN %C PRINTSTRING(" TRUNK DIAG STATUS REG - DXX=".STRHEX(J)." ") %FINISH %IF SACREG&2#0 %THEN STORE ERROR(0); ! bit 30 = SMAC fail %IF BASIC PTYPE=4 %START; ! engineers say print photo area %IF OCPTYPE=4 %START; ! 2980 only PRINTSTRING(" PHOTOGRAPH AREA ") ! SAC0 dump at X900, SAC1 dump at XD00 - but print everything anyway DUMPTABLE(-1,X'81000100',X'1400') %FINISH %FINISH %IF FPN=0 %THEN RETRY COUNT==SAC0 RETRY COUNT %C %ELSE RETRY COUNT==SAC1 RETRY COUNT RETRY COUNT=RETRY COUNT+1 %IF RETRY COUNT>=ERR COUNT %THEN RFLAGS=RFLAGS!(8<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 RETRY COUNT==OCP3 RETRY COUNT %C %ELSE RETRY COUNT==OCP2 RETRY COUNT RETRY COUNT=RETRY COUNT+1 %IF 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): ! unrecoverable 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 %IF PRODUCTION=YES %OR COM_SLIPL<0 %THEN RESUME(1) %ELSE RESUME(0);! continue or crash %FINISH 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 %IF SSERIES=NO %START %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,STATUS,ENGSTATUS,CONFIG,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") %FOR SMAC=0,1,15 %CYCLE %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 byte error reporting * !*********************************************************************** %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 %FOR I=16,1,25 %CYCLE %IF IP&X'80000000'>>I#0 %THEN %C PRINTSTRING(SEMESS(SWSEPTR(I))) %AND NEWLINE %REPEAT %FINISH %ELSE %START; ! HARDWARE ERRORS %FOR I=16,1,30 %CYCLE %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 %FOR K=0,1,7 %CYCLE L=LONGINTEGER(START)>>24; ! LNWN VALIDS/CAMS STACK CAMS(K)=RW START=START+8 %REPEAT K=0 %FOR CAM=0,1,15 %CYCLE %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 %FOR LINE=0,1,7 %CYCLE 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, %FOR I=0,4,LENGTH-4 %CYCLE 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)) %FOR 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 %FOR I=1,1,WAITLOOP %CYCLE; %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 %FOR I=1,1,WAITLOOP %CYCLE; %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 %FOR I=1,1,127 %CYCLE; ! 64 32 BIT REGISTERS %CYCLE ! 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 %FOR K=0,1,J %CYCLE 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 ! %FOR I=1,1,2 %CYCLE %FOR J=0,1,15 %CYCLE 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') %FOR I=1,1,4 %CYCLE DWRITE16(X'A4D80000') DWRITE16(X'A4C10000') %REPEAT %FOR I=0,1,3 %CYCLE DWRITE16(X'A4CE0000') %FOR J=0,1,7 %CYCLE DWRITE16(X'A40C0080') DAT(J)=READ16(X'54D4')>>16 %REPEAT PRINT(8*I,7,4) DWRITE16(X'A40C0080') DWRITE16(X'A4C90000') %REPEAT DWRITE16(X'A1080000'); ! WRITE INDIRECT TO REG 108 ! ZEROS TO CLEAR SYSERR %IF CONFUSED#0 %THEN %START DWRITE16(X'A10E0000') DWRITE16(X'A1230000') DWRITE16(X'A1800000') DWRITE16(X'A1810000') DWRITE16(X'A1820000') DWRITE16(X'A1830000') DWRITE16(X'A1D70000') MPLDREG=0 %FINISH 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 %FOR I=1,1,3 %CYCLE 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 %FOR I=0,1,15 %CYCLE CHANGE STREAM(I) %FOR J=0,1,15 %CYCLE; ! 15 REGS FOR EACH STRM %FOR K=0,1,8 %CYCLE 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") %FOR I=FIRST,1,LAST %CYCLE %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 %FOR I=0,1,12 %CYCLE 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 %FOR I=0,1,N %CYCLE 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 %FOR I=FIRST,1,LAST %CYCLE 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 %FOR J=0,1,15 %CYCLE WRITE(J,2) %FOR I=FIRST,1,LAST %CYCLE SPACES(2) PRINTSTRING(HTOS(ATUS(16*(I&7)+J),8)) %REPEAT NEWLINE %REPEAT %END %ROUTINE SEQREG(%INTEGER FIRST,STEP,LAST,SHFT,PL, %C %INTEGERFN GET(%INTEGER I)) !*********************************************************************** !* READ A SEQENCE OF REGISTER AND PRINT THEM . FN GET OBTAINS REG * !* SHIFT AND PL CONCERN MANIPULATING AND PRINTING RESULT * !*********************************************************************** %INTEGER COUNT,SAVE,I COUNT=0 %FOR I=FIRST,STEP,LAST %CYCLE %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 %FINISH %OWNLONGINTEGER VSN=X'4641535420563432';! M'FAST V42' %CONSTINTEGER REAL0ADDR=X'81000000' %IF SSERIES=YES %START %EXTERNALROUTINESPEC GDC(%RECORD(PARMF)%NAME P) %RECORDFORMAT DDTFORM(%INTEGER %C SER, PTSM, PROPADDR, STICK, CAA, GRCB AD, %C %BYTE %INTEGER LAST ATTN, DACTAD, %HALF %INTEGER HALFSPARE, %C %INTEGER LAST TCB ADDR, %C STATE,IW1,CONCOUNT, SENSE1, SENSE2, SENSE3, SENSE4, %C REPSNO, BASE, ID, DLVN, MNEMONIC, %C %STRING (6) LAB, %BYTE %INTEGER HWCODE, %C %INTEGER ENTSIZE, URCB AD, SENSDAT AD, LOGMASK, UASTE, %C UA SIZE, UA AD, TIMEOUT,PROPS,STATS1,STATS2, %C %BYTEINTEGER QSTATE,PRIO,SP1,SP2, %C %INTEGER LQLINK,UQLINK,CURCYL,SEMA,TRLINK,SLOT) %RECORDFORMAT TCBF(%INTEGER CMD,STE,DATA LEN,DATA AD,NEXT TCB,RESP, %C (%BYTEINTEGER INIT MECH,INIT CMASK,INIT SMASK,INIT MODE,INIT FN,INIT SEG, %C %HALFINTEGER INIT CYL,%BYTEINTEGER INIT HEAD,INIT HDLIMIT, %C %HALFINTEGER INIT SCYL,INIT SHEAD,%BYTEINTEGER INIT SECT,INIT OFFSET %C %OR %INTEGER PRE0,PRE1,PRE2,PRE3), %C %INTEGER POST0,POST1,POST2,POST3,POST4,POST5,POST6,POST7) %CONSTINTEGER DCU SNO=X'300000' %CONSTINTEGER MAX TRANS=13; ! + 1 for sense %CONSTINTEGER TCB SIZE=4*18 %FINISH %ELSE %START %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,CHISA) %RECORDFORMAT CCAFORM(%INTEGER MARK,PAW,PIW1,PIW2,CSAW1,CSAW2,%C CRESP1,CRESP2,%LONGLONGREALARRAY STRMS(0:15)) %RECORDFORMAT RQBFORM(%INTEGER LSEGPROP, LSEGADDR, LBPROP, %C LBADDR, ALPROP, ALADDR, W6, W7, W8) %OWNINTEGER AUTOLD=0 %OWNBYTEINTEGERARRAY PTCA(0:31); ! max=port 1, trunk f %OWNBYTEINTEGERARRAY PTBASE(0:31)=255(32) %CONSTINTEGER MAX DFCS=4; ! max DFCs coped with %OWNBYTEINTEGERARRAY SLOTX(0:16*MAXDFCS)=0(*) %FINISH !* %RECORDFORMAT PROPFORM(%INTEGER TRACKS, CYLS, PPERTRK, BLKSIZE %C , TOTPAGES, RQBLKSIZE, LBLKSIZE, ALISTSIZE, KEYLEN, %C SECTINDX) !* %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=0, NDISCS=0 !* %EXTERNALROUTINE DISC(%RECORD(PARMF)%NAME P) !* %ROUTINESPEC READ DLABEL(%RECORD(DDTFORM)%NAME DDT) %ROUTINESPEC LABREAD ENDS %ROUTINESPEC UNLOAD(%RECORD(DDTFORM)%NAME DDT) %STRING (4) %FNSPEC MTOS(%INTEGER M) %ROUTINESPEC SENSE(%RECORD(DDTFORM)%NAME DDT, %INTEGER VAL) %ROUTINESPEC DREPORT(%RECORD(DDTFORM)%NAME DDT, P) %IF SSERIES=YES %START %ROUTINESPEC FIRE CHAIN(%RECORD(DDTFORM)%NAME DDT) %RECORD(TCBF)%NAME TCB %FINISH %ELSE %START %ROUTINESPEC SET PAW(%RECORD(DDTFORM)%NAME DDT,%INTEGER PAW,SAW) %ROUTINESPEC REINIT DFC(%INTEGER SLOT,PART) %ROUTINESPEC STREAM LOG(%RECORD(DDTFORM)%NAME DDT) %RECORD(RQBFORM)%NAME RQB %RECORD(CCAFORM)%NAME CCA %INTEGER K,STRM,PIW,PT %FINISH %RECORD(DDTFORM)%NAME DDT,XDDT %RECORD(DDTFORM) SDDT %RECORD(PROPFORM)%NAME PROP %RECORD(LABFORM)%NAME LABEL %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,RLABSIS=15 %CONSTINTEGER RESPX=1<>16))#0 %THEN %C PKMONREC("DISC:",P) %IF ACT>=64 %THEN ->ACT64 ->INACT(ACT) INACT(0): ! initialisation %RETURN %UNLESS NDISCS=0; ! in case initialised twice NDISCS=COM_NDISCS DITADDR=COM_DITADDR LVN==ARRAY(COM_DLVNADDR,LVNF) %FOR I=0,1,99 %CYCLE LVN(I)=254 %REPEAT INITINH=1 !* ! ! For P series then:- ! ! Set up two arrays to avoid searching the DDT ! PTCA has the commnctns area public seg no for each controller(as p/t) ! PTBASE has a pointer to SLOTX. SLOTX contains 16 entries ! one for each stream and points to the DDT slot. Thus any disc can ! be found without searching ! ! For S series DCU supplies the slot address ! %IF SSERIES=NO %START I=INTEGER(COM_FPCCONFA) %IF I>MAX DFCS %THEN I=MAX DFCS %AND %C OPMESS("Too many DFCS for DISC") %FOR J=1,1,I %CYCLE PTBASE(INTEGER(COM_FPCCONFA+4*J)>>24)=16*J %REPEAT %FINISH %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF SSERIES=YES %START DDT_UASTE=INTEGER(PST VA+4+DDT_UA AD<<1>>19<<3) DDT_SLOT=J %FINISH %ELSE %START PT=DDT_PTS>>4 STRM=DDT_PTS&15 PTCA(PT)<-DDT_CAA>>18; ! to associate ints SLOTX(PTBASE(PT)+STRM)=J %FINISH SENSE(DDT,0) DDT_STATE=CONNIS; ! read vol labels %REPEAT P_DEST=PDISCSNO PDISC(P) 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) ! RLABSIS = 15 = read label failed & sense issued ! INACT(1): ! claim for dedicated use ! ! Input request ! P_P1 = returnable ! P_P2 = service no for replies (o=release -1=unload--no reply) ! P_P3 = slot no or mnemonic or %STRING(6) vol label ! ! Replies ! P_P2 = 0 claim fails else service no for private requests ! P_P3 = slot no ! P_P4 = mnemonic ! P_P5& 6 = %STRING(6) vol label ! PTR=P_P3; I=PTR %UNLESS 0<=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 mapped on right slot %IF P_P2>0 %START %IF DDT_STATE=PAVAIL %OR(DDT_STATE=AVAIL %AND DDT_DLVN<0)%START DDT_STATE=PCLAIMD DDT_REPSNO=P_P2 ->REPLY %FINISH %ELSE ->CLAIM FAILS %FINISH %ELSE %START %IF DDT_STATE#PCLAIMD %THEN OPMESS("Bum dev returned") %C %AND %RETURN DDT_STATE=PAVAIL; DDT_REPSNO=0 %IF SSERIES=NO %START 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' %FINISH OPMESS(MTOS(DDT_MNEMONIC)." unused") %IF P_P2<0 %THEN SENSE(DDT,0) %AND DDT_STATE=CONNIS %RETURN %FINISH REPLY: ! reply to claims only P_P2=DISCSNO+64+I P_P3=I P_P4=DDT_MNEMONIC STRING(ADDR(P_P5))=DDT_LAB SEND: P_DEST=P_SRCE P_SRCE=DISCSNO+1 PON(P) %RETURN CLAIM FAILS: P_P2=0; ->SEND INACT(2): ! paged request(_P1=DDTADDR) DDT==RECORD(P_P1) %IF DDT_STATE#AVAIL %OR P_SRCE&X'FFFF0000'#PDISCSNO %THEN ->REJECT DDT_STATE=PAGTIS; DDT_ID=P_P1 DDT_STICK=CURRTICK %IF SSERIES=YES %START FIRE CHAIN(DDT) %FINISH %ELSE %START CCA==RECORD(DDT_CAA) ! PT=DDT_PTS STRM=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) %FINISH %RETURN ACT64: ! private chains ! ! Private chaining section ! ======= ======== ======= ! The users has set up his chain using the area provided at grope time. ! P_P1 has a returnable ident ! P_P2 inhibit sense if <0 ! P_P5&6 LSTBR ! SLOT=ACT&63 DDT==RECORD(INTEGER(DITADDR+4*SLOT)) %IF DDT_STATE#PCLAIMD %THEN ->REJECT ! DDT_REPSNO=P_SRCE DDT_ID=P_P1; ! save private id %IF P_P2<0 %THEN DDT_STATE=SPTRANIS %ELSE DDT_STATE=PTRANIS DDT_STICK=CURRTICK %IF SSERIES=YES %START FIRE CHAIN(DDT) %FINISH %ELSE %START CCA==RECORD(DDT_CAA) RQB==RECORD(DDT_RQA) RQB_LSEGPROP=P_P5&X'FFFF0000'!X'C000'; ! ACR 0 protem RQB_LSEGADDR=P_P6 STRM=DDT_PTS&15 SET PAW(DDT,X'01000000'+STRM,X'10000024'); ! user SAW flags ignored protem %FINISH %RETURN REJECT: ! disc requested rejected %IF DDT_STATE=INOP %OR DDT_STATE=RRLABIS %START %IF SSERIES=NO %THEN CCA==RECORD(DDT_CAA) ->REPLY INOP %FINISH PKMONREC("*** DISC rejects",P) P_DEST=P_SRCE P_P2=-1 P_SRCE=DISCSNO+64+SLOT PON(P) %RETURN INACT(4): ! note lvn P_P1 now checked I=P_P1; J=LVN(I) %IF J>=NDISCS %THEN %RETURN; ! crap lvn DDT==RECORD(INTEGER(DITADDR+4*J)) DDT_DLVN=DDT_DLVN&255 ! KY 17Jul81 DDT_CONCOUNT=1; ! should be 0 after testing! %RETURN INACT(5): ! clocktick ! DCU to timeout S discs protem %IF SSERIES=NO %START %IF AUTOLD#0 %START; ! a DFC being autoloaded AUTOLD=AUTOLD-1 %IF AUTOLD&255=0 %THEN REINIT DFC(AUTOLD>>16,2) %AND %C AUTOLD=0 %RETURN %FINISH CURRTICK=CURRTICK+1 %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF CURRTICK-DDT_STICK>2 %AND RESPX&1<TOUT %IF CURRTICK-DDT_STICK>100 %AND DDT_STATE=INOP %AND %C COM_SLIPL<0 %START; ! disc inop for 5 mins & unmanned P_DEST=X'30063' P_P1=99 PON(P); ! PON 3 99 %FINISH %REPEAT %RETURN TOUT: ! device times out OPMESS(MTOS(DDT_MNEMONIC)." timed out") CCA==RECORD(DDT_CAA) STRM=DDT_PTS&15 %IF CCA_PIW1&X'80000000'>>STRM#0 %THEN %START OPMESS(MTOS(DDT_MNEMONIC)." missing int PONned") P_DEST=DISCSNO+3; P_SRCE=0 P_P1=DDT_PTS>>4 PON(P) %RETURN %FINISH CCA_PAW=0; CCA_MARK=-1 %IF DDT_STATE=CONNIS %THEN DDT_STATE=DEAD %AND %RETURN; ! no retry SET PAW(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) %FINISH %RETURN INACT(6): ! read stream log P_P1=bitmask %IF SSERIES=YES %THEN ->ROUT %ELSE %START %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 read seeks srnh woff sker ster corrn") PRINTSTRING(" strbe hdoff media pagemoves pagefails") %FOR J=0,1,NDISCS-1 %CYCLE %IF P_P1&1<0 PPROFILE %RETURN %FINISH INACT(7): ! reconfigure SAC(P_P2=SAC) %IF SSERIES=YES %START; ! or DCU rejects fire chain PKMONREC("DISC fire fails:",P);! should not happen!! DUMP TABLE(0,P_P3,1304); ! DDT %RETURN %FINISH %ELSE %START I=P_P2 P_P2=0 %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF DDT_PTS>>8=I %START; ! SAC (possibly) in use %UNLESS DDT_STATE=DEAD %START %UNLESS DDT_STATE=PAVAIL %OR %C (DDT_STATE=AVAIL %AND DDT_CONCOUNT=0) %START; ! in use P_P2=4<<24!DDT_MNEMONIC>>8 P_P3=DDT_MNEMONIC<<24 %EXIT %FINISH %UNLESS DDT_DLVN=-1 %THEN LVN(DDT_DLVN&255)=255 DDT_STATE=DEAD %FINISH %FINISH %REPEAT ->ROUT %FINISH INACT(8): ! transfer in progress when ZX dev awoke %IF SSERIES=YES %THEN ->DUFFACT %ELSE %START 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(9): ! for testing facilities %IF SSERIES=NO %THEN I=CONTROLLER DUMP(P_P1,P_P2) ! need some sort of DCU dump for S series %RETURN INACT(10): ! REINIT DFC (P_P1=PT,P_P2=OLD PT IF >=0) %IF SSERIES=YES %THEN ->DUFFACT %ELSE %START PT=P_P1 %IF COM_NSACS=1 %AND COM_SACPORT0#PT>>4 %THEN ->BADPT %IF P_P2>=0 %AND PT#P_P2 %START; ! SAC SWITCH %IF 0<=PT<=X'1F' %AND 0<=P_P2<=X'1F' %C %AND PTCA(PT)=0 %AND PTCA(P_P2)>0 %C %AND BYTEINTEGER(COM_CONTYPEA+PT)=0 %AND %C BYTEINTEGER(COM_CONTYPEA+P_P2)=2 %START; ! CONSISTENT BYTEINTEGER(COM_CONTYPEA+P_P2)=0 BYTEINTEGER(COM_CONTYPEA+PT)=2; ! DFC PTCA(PT)=PTCA(P_P2) PTCA(P_P2)=0 PTBASE(PT)=PTBASE(P_P2) PTBASE(P_P2)=0 %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) I=DDT_PTS %IF I>>4=P_P2 %START %IF AUTOLD>>16=J %THEN AUTOLD=0 DDT_PTS=(I&15)!PT<<4 %IF I=COM_SLIPL&X'FFF' %THEN %C COM_SLIPL=COM_SLIPL>>16<<16!DDT_PTS DDT_CHISA=X'40000800'!PT<<16 %FINISH %REPEAT %FINISH %ELSE ->BADPT %FINISH %IF 0<=PT<=X'1F' %AND PTCA(PT)>0 %AND %C SAFE IS WRITE(X'40000800'!PT<<16,2)=0 %START WAIT(1000); ! after master clear REINIT DFC(PT,3) %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF DDT_PTS>>4=PT %AND DDT_STATE=DEAD %START SENSE(DDT,0) DDT_STATE=CONNIS %FINISH %REPEAT %FINISH %ELSE OPMESS("Cannot reinit DFC ".HTOS(PT,2)) ->ROUT %FINISH BADPT: OPMESS("DFC old/new pt???") ->ROUT INACT(11): ! entry from SHUTDOWN routine ! P_P1 = pt %IF SSERIES=YES %THEN ->DUFFACT %ELSE %START; ! not S series protem PT=P_P1 %IF COM_NSACS=1 %AND COM_SACPORT0#PT>>4 %THEN ->ROUT; ! SAC gone %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF DDT_PTS>>4=PT %THEN UNLOAD(DDT); ! disconnect %REPEAT WAIT(100) ->ROUT %FINISH ROUT: %UNLESS P_SRCE=0 %START I=P_SRCE P_SRCE=P_DEST P_DEST=I PON(P) %FINISH %RETURN %IF SSERIES=YES %START DUFFACT: PKMONREC("DISC act?",P) %RETURN %FINISH INACT(3): ! interrupts !*********************************************************************** !* Disc interrupt handling sequence * !*********************************************************************** %IF SSERIES=YES %START DDT==RECORD(P_P3) SLOT=DDT_SLOT PTS=DDT_PTSM>>8; ! really DCU/stream SIW1=P_P1 SIW2=P_P2 %FINISH %ELSE %START PT=P_P1; ! extract port & trunk from int PTR=PTCA(PT) %IF PTR=0 %THEN PRINTSTRING("No DFC on PT ".STRHEX(PT)."? ") %AND %RETURN CCA==RECORD(X'80000000'+PTR<<18) MORE INTS: ! see if any more ints *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8,; ! 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 ????") %FINISH %IF SIW1&NORMALT#0 %THEN ->NINT(DDT_STATE) %IF SIW1&ERRT#0 %THEN ->FINT(DDT_STATE) %IF SIW1&ATTNT#0 %AND SIW1&X'1000'=0 %THEN ->AINT(DDT_STATE) CHINT:%IF SSERIES=NO %AND CCA_PIW1#0 %THEN ->MORE INTS %RETURN %IF SSERIES=NO %START CONTINT: ! int from controller or spurious SIW1=CCA_CRESP1; SIW2=CCA_CRESP2 CCA_CRESP1=0; CCA_MARK=-1 %IF SIW1#0 %THEN PRINTSTRING("Disc controller int (". %C HTOS(PT,2).") :".STRHEX(SIW1)." ".STRHEX(SIW2)."?? ") %RETURN %FINISH ! NINT(AVAIL):FINT(AVAIL): NINT(PAVAIL):FINT(PAVAIL): NINT(PCLAIMD):FINT(PCLAIMD): NINT(DEAD):FINT(DEAD): ! dead disc terinates? PRINTSTRING("Disc int (".HTOS(PTS,3).") state ". %C STRINT(DDT_STATE)." ????? ") ->CHINT NINT(CONNIS): ! sense terminates LRSTATE=RLABIS; ! for read label %IF SSERIES=NO %AND DDT_MNEMONIC>>16=ZXDEV %START; ! the kraken wakes! J=DDT_PROPS K=M'ED'<<16+HEXDS(J>>20&15)<<8+HEXDS(J>>16&15); ! real mnemonic %FOR I=0,1,NDISCS-1 %CYCLE; ! find old slot XDDT==RECORD(INTEGER(DITADDR+4*I)) %IF XDDT_MNEMONIC=K %START %IF MULTI OCP=YES %START *LXN_XDDT+4; ! grab slot sema *INCT_(%XNB+29) *JCC_8, SEMALOOP(XDDT_SEMA) KSEMAGOT: %FINISH XDDT_MNEMONIC=XDDT_MNEMONIC&X'FFFF'!ZXDEV<<16 DDT_PROPADDR=XDDT_PROPADDR %IF RESPX&1<=0 %AND J>>24=X'35' %START; ! no old slot & EDS200 DDT_PROPADDR=DDT_PROPADDR+PROPLEN; ! default is EDS100 %FINISH %FINISH %IF SSERIES=YES %START TCB==RECORD(DDT_UA AD+MAXTRANS*TCB SIZE) DDT_SENSE1=TCB_POST0 DDT_SENSE2=TCB_POST1 DDT_SENSE3=TCB_POST2 DDT_SENSE4=TCB_POST6 %FINISH %ELSE %START I=DDT_ALA+128 DDT_SENSE1=INTEGER(I) DDT_SENSE2=INTEGER(I+4) DDT_SENSE3=INTEGER(I+8) DDT_SENSE4=INTEGER(I+40) ! ! Reset the RQB so that the pointers point above the false floor ! of the logic block and address list. The false floor conceals a ! sense which is always set up ! RQB==RECORD(DDT_RQA) RQB_LBADDR=DDT_LBA RQB_ALADDR=DDT_ALA %FINISH I=DDT_PROPS>>24 %IF I>X'35' %THEN I=1 %ELSE I=8 %IF DDT_SENSE4&I<<28#0 %START ! protem - 'till properties table, etc re-vamped READ DLABEL(DDT) LABREADS=LABREADS+1 DDT_STATE=LRSTATE; ! RLABIS or RRLABIS %FINISH %ELSE DDT_STATE=DEAD ->CHINT NINT(RRLABIS): ! label on remounted disc read NINT(RLABIS): ! label read successfully LABREAD ENDS %IF SSERIES=YES %THEN LABEL==RECORD(DDT_UA AD+TCB SIZE) %ELSE %C LABEL==RECORD(DDT_ALA+72) ETOI(ADDR(LABEL),6) PREVLAB=DDT_LAB %FOR I=0,1,5 %CYCLE BYTEINTEGER(ADDR(DDT_LAB)+1+I)=LABEL_VOL(I) %REPEAT LENGTH(DDT_LAB)=6 ! the following label & base code for S series is protem until ! IPL discs are standardised %IF (SSERIES=YES %AND '0'<=LABEL_VOL(4)<='9' %C %AND '0'<=LABEL_VOL(5)<='9') %C %OR (SSERIES=NO %AND LABEL_ACCESS= X'C5' %C %AND '0'<=LABEL_VOL(4)<='9' %AND '0'<=LABEL_VOL(5)<='9') %START %IF SSERIES=YES %THEN DDT_BASE=X'800' %ELSE %START %FOR I=0,1,3 %CYCLE BYTEINTEGER(ADDR(DDT_BASE)+I)=LABEL_POINTER(I) %REPEAT %FINISH S=" EMAS" I=(LABEL_VOL(4)&X'F')*10+LABEL_VOL(5)&X'F' %IF LVN(I)<254 %START %UNLESS SLOT=LVN(I) %AND DDT_STATE#RRLABIS %THEN ->DUPLICATE %FINISH %IF DDT_STATE=RRLABIS %THEN DDT_LAB=PREVLAB %AND ->REMOUNT ! wrong disc remounted LVN(I)=SLOT DDT_DLVN=I!X'80000000' DDT_STATE=AVAIL %FINISH %ELSE %START %IF DDT_STATE=RRLABIS %THEN ->REMOUNT;! wrong disc remounted DDT_BASE=0 DDT_STATE=PAVAIL DDT_DLVN=-1 S=" frgn" %FINISH DDT_STATS1=0 DDT_STATS2=0 LOAD MESS: OPMESS(MTOS(DDT_MNEMONIC)." loaded ".DDT_LAB.S) ->CHINT DUPLICATE: ! disc with same lvn mounted ! may be remount of reqd disc ! on same or different drive XDDT==RECORD(INTEGER(DITADDR+4*LVN(I)));! on oldmount slot %UNLESS XDDT_STATE=INOP %OR XDDT_STATE=RRLABIS %START;! not awaiting remount OPMESS("Duplicate disc lvn ") DDT_DLVN=-1; ! dont clear lvn when unloading UNLOAD(DDT) DDT_STATE=DCONNIS; ->CHINT %FINISH ! ! Set up P for PONning to PDISC ! P_DEST=PDISCSNO+11 P_SRCE=DISCSNO I=LVN(I); ! old slot - will become new slot P_P1=I %IF I#SLOT %START; ! reloaded on different drive %IF XDDT_MNEMONIC>>16#ZXDEV %AND DDT_STATE=RRLABIS %C %THEN J=1 %ELSE J=0; ! J=1 if DDT slot is awaiting another disc %IF MULTI OCP=YES %START *LXN_XDDT+4; ! grab slot sema *INCT_(%XNB+29) *JCC_8, SEMALOOP(XDDT_SEMA) XSEMAGOT: %UNLESS J=0 %START; ! need both semas *LXN_DDT+4; ! shouldn't cause an embrace (I hope!!) *INCT_(%XNB+29) *JCC_8, SEMALOOP(DDT_SEMA) DSEMAGOT: %FINISH %FINISH SDDT=DDT; ! save lest disc 'swap' DDT_DLVN=XDDT_DLVN; ! copy across vital fields DDT_STATS1=XDDT_STATS1; ! including fchk&closing bits DDT_STATS2=XDDT_STATS2 DDT_CONCOUNT=XDDT_CONCOUNT DDT_LQLINK=XDDT_LQLINK DDT_UQLINK=XDDT_UQLINK DDT_QSTATE=XDDT_QSTATE %IF SSERIES=NO %AND XDDT_PTS=COM_SLIPL&X'FFF' %THEN COM_SLIPL=COM_SLIPL>>16<<16!DDT_PTS; ! for AUTO IPL ! not S series protem %UNLESS J=0 %START; ! awaiting another disc XDDT_DLVN=SDDT_DLVN XDDT_STATS1=SDDT_STATS1 XDDT_STATS2=SDDT_STATS2 XDDT_CONCOUNT=SDDT_CONCOUNT XDDT_LQLINK=SDDT_LQLINK XDDT_UQLINK=SDDT_UQLINK XDDT_QSTATE=SDDT_QSTATE %FINISH %ELSE %START XDDT_STATS1=0; XDDT_STATS2=0; XDDT_STATE=DEAD XDDT_CONCOUNT=0 XDDT_LQLINK=0;XDDT_UQLINK=0;XDDT_QSTATE=0 %FINISH %IF SSERIES=NO %START SLOTX(PTBASE(DDT_PTS>>4)+DDT_PTS&15)=I; ! swap SLOTX ptrs SLOTX(PTBASE(XDDT_PTS>>4)+XDDT_PTS&15)=SLOT %FINISH SDDT=DDT; DDT=XDDT; XDDT=SDDT; ! swap slots %IF MULTI OCP=YES %START XDDT_SEMA=-1 %UNLESS J=0 DDT_SEMA=-1 %FINISH DDT==RECORD(ADDR(XDDT)); ! remap slot %FINISH DDT_STATE=AVAIL PON(P) ->LOADMESS FINT(CONNIS): ! sense fails DDT_STATE=DEAD; ->CHINT FINT(RLABIS): ! read label fails LABREAD ENDS DDT_IW1=SIW1 DDT_SENSE1=SIW2 DDT_STATE=RLABSIS SENSE(DDT,2) ->CHINT NINT(RLABSIS):FINT(RLABSIS): ! SENSE AFTER LABREAD DDT_LAB="nolabl" DDT_DLVN=-1 DDT_STATE=PAVAIL OPMESS(MTOS(DDT_MNEMONIC)." loaded no label") DDT_BASE=0 P_DEST=0 ->COM1 NINT(DCONNIS):FINT(DCONNIS): ! unload complete SENSE(DDT,0); ! reconnect interface DDT_STATE=CONNIS UNLDED:OPMESS(MTOS(DDT_MNEMONIC)." unloaded") %IF DDT_DLVN#-1 %THEN LVN(DDT_DLVN&255)=255 ->CHINT AINT(RLABIS): LABREAD ENDS AINT(DEAD):AINT(CONNIS): ! attention while initialising AINT(RLABSIS): PRINTSTRING("Attntn while initng ".HTOS(PTS,3)." ". %C STRHEX(SIW1).STRHEX(SIW2)." ") %IF SSERIES=NO %START %FOR I=1,1,5000 %CYCLE %IF CCA_PIW1&(X'80000000'>>STRM)#0 %THEN ->CHINT %REPEAT %FINISH DDT_STATE=CONNIS SENSE(DDT,1); ! start sequence again AINT(DCONNIS): ! extra attention caused by unload ->CHINT AINT(AVAIL):AINT(PAVAIL): ! attention while idle AINT(PAGTIS):AINT(PAGSIS):AINT(PTISLOGP): ! attention while paging %IF SIW1&HOLD#0 %THEN %START; ! hold was pressed %IF DDT_STATE=PAVAIL %OR %C (DDT_STATE=AVAIL %AND DDT_CONCOUNT=0) %START ! not in system use can unload UNLOAD(DDT) DDT_STATE=DCONNIS %FINISH %ELSE %START OPMESS(DDT_LAB." still needed ".STRINT(DDT_STATE)) %FINISH ->CHINT %FINISH %IF SIW1&AUTOAVAIL=AUTOAVAIL %START; ! gratuitous 'auto & available' PRINTSTRING("Surprise attntn on ".HTOS(PTS,3)." ". %C STRHEX(SIW1).STRHEX(SIW2)." ") ->CHINT %FINISH ! ! If attnt wasnt hold,surprise or log overflow(already dealt with) then it ! must have been not auto or not available. Abandon disc if possible ! otherwise demand it back and wait ! %IF DDT_STATE=PAVAIL %OR %C (DDT_STATE=AVAIL %AND DDT_CONCOUNT=0) %START DDT_STATE=DEAD ->UNLDED %FINISH REMOUNT: ! demand reload of demounted disc OPMESS("Reload ".DDT_LAB." now!!!".TOSTRING(17)) I=DDT_STATE DDT_STATE=INOP DDT_STICK=CURRTICK %IF RESPX&1<REPLY INOP %IF PRIVIO&1<PRIV INOP %FINISH ->CHINT AINT(INOP): ! attention while waiting remount %IF SIW1&AUTO#0 %START; ! drive now reloaded %IF SSERIES=NO %AND DDT_MNEMONIC>>16=ZXDEV %START; ! switch/labread fails/switch K=M'ED'<<16!DDT_MNEMONIC&X'FFFF' %FOR I=NDISCS-1,-1,0 %CYCLE; !find old slot XDDT==RECORD(INTEGER(DITADDR+4*I)) %IF XDDT_MNEMONIC=K %START XDDT_MNEMONIC=ZXDEV<<16!K&X'FFFF'; ! swap back mnem. XDDT_STATE=DEAD XDDT_LAB="" %EXIT %FINISH %REPEAT DDT_MNEMONIC=K %FINISH READ DLABEL(DDT); ! check its right disc LABREADS=LABREADS+1 DDT_STATE=RRLABIS %FINISH ->CHINT AINT(RRLABIS): FINT(RRLABIS): ! failed to read label LABREAD ENDS OPMESS(MTOS(DDT_MNEMONIC)." label read fails") ->REMOUNT NINT(INOP):FINT(INOP): ! transfers & senses going when ! disc went inop have now finished REPLY INOP: ! tell PDISC disc is inop P_P3=ERRT; ! transfer failed P_P4=0 P_P5=NORMALT; ! sense worked P_DEST=PDISCSNO+10 P_SRCE=DISCSNO DDT_ID=ADDR(DDT) DDT_SENSE2=X'80800000'; ! inop in 2ndry & 3ry status %IF SSERIES=YES %START TCB==RECORD(DDT_UA AD) TCB_POST1=DDT_SENSE2 %FINISH %ELSE %START INTEGER(DDT_ALA+132)=DDT_SENSE2 PT=DDT_PTS>>4; ! in case more ints incarea %FINISH ->COM2 FINT(SPTRANIS): ! special privat chain fails ! do a controller sense only ! so as to leave status %IF SSERIES=NO %START; ! not S series protem CCA==RECORD(DDT_CAA) CCA_CSAW2=ADDR(DDT_SENSE1) SET PAW(DDT,X'04000000',X'11000008') WAIT(5); ! modest wait for int. *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CCA_MARK) GOTSEM: %IF CCA_CRESP1#0 %AND CCA_PIW1=0 %THEN CCA_CRESP1=0; ! clear controller response CCA_MARK=-1 %FINISH NINT(PTRANIS): ! private chain ok NINT(SPTRANIS): ! special private chain ok P_DEST=DDT_REPSNO P_SRCE=DISCSNO+64+SLOT; ! was 64+STRM ! needs to be slot I think P_P1=DDT_ID P_P2=0; ! flag for normal termination P_P3=SIW1; P_P4=SIW2 PON(P) DDT_STATE=PCLAIMD ->CHINT FINT(PTISLOGP): ! page request fails DDT_STATE=PAGTIS; ! abandon pending logging read FINT(PAGTIS): ! paged request fails FINT(PTRANIS): ! private chain fails DDT_IW1=SIW1 DDT_SENSE1=SIW2 DDT_STATE=DDT_STATE+1 SENSE(DDT,2) ->CHINT NINT(PTISLOGP): ! page tran ok %IF SSERIES=NO %THEN STREAM LOG(DDT); ! deal with pending logging ! request before replying NINT(PAGTIS): ! paged transfer ok P_DEST=PDISCSNO+10 P_SRCE=DISCSNO+2 P_P1=DDT_ID P_P2=0 DDT_STATE=AVAIL PDISC(P); ! CALL not PON for efficiency ->CHINT NINT(PAGSIS): ! paged sense ok FINT(PAGSIS): ! paged sense fails P_DEST=PDISCSNO+10 P_SRCE=DISCSNO+2 DDT_STATE=AVAIL ->COM1 NINT(PSENIS): ! private sense ok FINT(PSENIS): ! private sense fails (!???) P_DEST=DDT_REPSNO P_SRCE=DISCSNO+64+SLOT; ! was + STRM ! DDT_STATE=PCLAIMD COM1: P_P3=DDT_IW1 P_P4=DDT_SENSE1 P_P5=SIW1 %IF SSERIES=YES %START TCB==RECORD(DDT_UA AD+MAXTRANS*TCBSIZE) DDT_SENSDAT AD=ADDR(TCB_POST0) DDT_SENSE1=TCB_POST0 DDT_SENSE2=TCB_POST1 DDT_SENSE3=TCB_POST2 DDT_SENSE4=TCB_POST6 %FINISH %ELSE %START I=DDT_ALA+128 DDT_SENSE1=INTEGER(I) DDT_SENSE2=INTEGER(I+4) DDT_SENSE3=INTEGER(I+8) DDT_SENSE4=INTEGER(I+40) %FINISH COM2: ! inoperable replies join here ! ! If P series then: ! reset the RQB so that the pointers point above the false floor ! of the logic block and address list. The false floor conceals a ! sense which is always set up ! %IF SSERIES=NO %START RQB==RECORD(DDT_RQA) RQB_LBADDR=DDT_LBA RQB_ALADDR=DDT_ALA %FINISH P_P1=DDT_ID P_P2=1; ! transfer fails P_P6=ADDR(DDT_SENSE1) DREPORT(DDT,P) PON(P) %UNLESS P_DEST=0 ->CHINT AINT(PCLAIMD):AINT(PTRANIS):AINT(PSENIS): ! private attentions P_DEST=DDT_REPSNO; P_SRCE=DDT_SER+64 P_P1=0; P_P2=0 P_P3=SIW1; P_P4=SIW2 PON(P) %UNLESS P_DEST=0 %RETURN !* %STRING(4)%FN MTOS(%INTEGER M) %INTEGER I,J I=4; J=M %RESULT=STRING(ADDR(I)+3) %END %ROUTINE UNLOAD(%RECORD(DDTFORM)%NAME DDT) !*********************************************************************** !* Performs a disconnect interface which unloads the disc * !*********************************************************************** %IF SSERIES=YES %START %RECORD(TCBF)%NAME TCB TCB==RECORD(DDT_UA AD) TCB_CMD=X'2C004008'; ! unload ignore shrt & long TCB_STE=DDT_UASTE TCB_DATA LEN=4 TCB_DATA AD=ADDR(TCB_PRE0) TCB_NEXT TCB=0 TCB_RESP=0 P_DEST=DCU SNO+12 P_SRCE=DISC SNO+7 P_P1=ADDR(TCB) P_P2=DDT_SER P_P4=M'UNLD' PON(P) %FINISH %ELSE %START %RECORD(RQBFORM)%NAME RQB %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') %FINISH %END %ROUTINE READ DLABEL(%RECORD(DDTFORM)%NAME DDT) !*********************************************************************** !* Reads sector 0 head 0 cyl 0 which should be 80 byte vol label * !*********************************************************************** %IF SSERIES=YES %START %RECORD(TCBF)%NAME TCB %INTEGER I TCB==RECORD(DDT_UA AD) TCB=0 TCB_STE=DDT_UASTE TCB_INIT SMASK=X'FE'; ! mask nowt TCB_INIT FN=X'20'; ! restore TCB_CMD=X'2000C012' TCB_DATA LEN=80 TCB_DATA AD=DDT_UA AD+TCBSIZE P_DEST=DCU SNO+12 P_SRCE=DISC SNO+7 P_P1=ADDR(TCB) P_P2=DDT_SER P_P4=M'RLAB' PON(P) %FINISH %ELSE %START %RECORD(RQBFORM)%NAME RQB %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') %FINISH %END %ROUTINE LABREAD ENDS !*********************************************************************** !* Called at end of read label to unihibit if needed * !*********************************************************************** LABREADS=LABREADS-1 %IF INITINH=1 %AND LABREADS=0 %THEN %C INITINH=0 %AND UNINHIBIT(SCHEDSNO>>16) %END %ROUTINE SENSE(%RECORD(DDTFORM)%NAME DDT,%INTEGER VAL) !*********************************************************************** !* Perform a sense on device whose DDT slot is DDT.VAL=0 for initial* !* sense. Sense to be preceeded by a connect stream. * !* If P series then: * !* preceed sense by read propcodes (into DDT_PROPS) * !* a sense is always kept below the false floor in lbloack &alist * !*********************************************************************** %IF SSERIES=YES %START %RECORD(TCBF)%NAME TCB TCB==RECORD(DDT_UA AD+MAX TRANS*TCB SIZE) TCB_CMD=X'2C004004'; ! sense ignore shrt & long TCB_STE=DDT_UASTE TCB_DATA LEN=32 TCB_DATA AD=ADDR(TCB_POST0) TCB_NEXT TCB=0 TCB_RESP=0 P_DEST=DCU SNO+12 P_SRCE=DISC SNO+7 P_P1=ADDR(TCB) P_P2=DDT_SER P_P4=M'SNSE' !PON(P) GDC(P); ! reply PONned on failure %FINISH %ELSE %START %RECORD(RQBFORM)%NAME RQB %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') %FINISH %END !* %IF SSERIES=YES %START !* %ROUTINE FIRE CHAIN(%RECORD(DDTFORM)%NAME DDT) %RECORD(TCBF)%NAME TCB TCB==RECORD(DDT_UA AD) P_DEST=DCU SNO+12 P_SRCE=DISC SNO+7 P_P1=ADDR(TCB) P_P2=DDT_SER !PON(P) GDC(P); ! reply PONned on failure ! should not happen!!! %END !* %FINISH %ELSE %START %ROUTINE SET PAW(%RECORD(DDTFORM)%NAME DDT,%INTEGER PAW,SAW) !*********************************************************************** !* GRAB SEMA AND SET ACTIVATION WORDS. THEN FIRE IO * !*********************************************************************** %RECORD(CCAFORM)%NAME CCA %INTEGER W,OLDPAW CCA==RECORD(DDT_CAA) %FOR W=1,1,5 %CYCLE *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 * !*********************************************************************** %RECORDFORMAT INITFORM(%INTEGER W0,W1,W2,W3,W4) %OWNRECORD(INITFORM) INIT %RECORD(DDTFORM)%NAME DDT %RECORD(CCAFORM)%NAME CCA,CCA0 %OWNINTEGER DUMPS=-1 %INTEGER ISA,R,PT,CAA %IF PART<3 %START; ! part3 is from INACT(10) DDT==RECORD(INTEGER(DITADDR+4*SLOT)) PT=DDT_PTS>>4 %FINISH %ELSE PT=SLOT ISA=X'40000800'!PT<<16 CAA=X'80000000'+PTCA(PT)<<18; ! commarea addr ->PART2 %IF PART>1 R=0; ! MP not loaded in DFC DUMPS=DUMPS+1 %IF DUMPS<=1 %START R=CONTROLLER DUMP(2,PT) DUMPTABLE(60,CAA,288);! comms area DUMPTABLE(61,DDT_LBA,600); ! LBs & address lists %FINISH *LB_ISA; *LSS_2; *ST_(0+%B); ! master clear %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=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 %AND PART<3 %THEN %START DUMPTABLE(64,REAL0ADDR,127) DUMPTABLE(65,CAA,127) %FINISH %IF CCA0_PAW=0 %START OPMESS("DFC ".HTOS(PT,2)." reinitialised") DUMPS=-1 %FINISH %ELSE %START OPMESS("Failed to autoload DFC") %IF DUMPS>5 %AND COM_SLIPL<0 %START P_DEST=X'30063' P_P1=99 PON(P); ! PON 3 99 %FINISH %FINISH CCA==RECORD(CAA) CCA_CRESP1=0; ! delete initialise response CCA_PAW=0 %FOR I=0,1,NDISCS-1 %CYCLE 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 READ 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 %FINISH %ROUTINE DREPORT(%RECORD(DDTFORM)%NAME DDT,%RECORD(PARMF)%NAME P) !*********************************************************************** !* Prints out a failure report in a readable form * !*********************************************************************** %IF SSERIES=YES %START %CONSTINTEGER TCBPSIZE=40; ! bytes of TCB to be dumped %CONSTSTRING(8)%ARRAY SENSEM(0:7)="S0T1T2T3","T4T5T6T7", "T8T9TAC0","C1C2C3C4","C5C6M0M1", "M2M3M4M5","M6M7M8M9","MAXXXXXX"; %RECORD(TCBF)%NAME FTCB %INTEGER I,J,N %UNLESS DDT_LAST TCB ADDR=0 %THEN FTCB==RECORD(DDT_LAST TCB ADDR) %C %ELSE FTCB==RECORD(DDT_UA AD); ! protem? PRINTSTRING("&& DISC TRANSFER ".DDT_LAB." ON ". %C MTOS(DDT_MNEMONIC)." (".HTOS(DDT_PTSM>>8,6).") FAILS "%C .STRING(ADDR(COM_DATE0)+3)." ".STRING(ADDR(COM_TIME0)+3)) PRINTSTRING(" TCB response =".HTOS(FTCB_RESP,8)." sense data ") %FOR I=0,1,7 %CYCLE PRINTSTRING(SENSEM(I)." ".STRHEX(INTEGER(DDT_SENSDAT AD+4*I))) NEWLINE %REPEAT PRINTSTRING(" complete chain of TCBs before failure ") N=(ADDR(FTCB)-DDT_UA AD)//TCBSIZE %FOR J=0,4,TCBPSIZE-4 %CYCLE %FOR I=0,1,N %CYCLE PRINTSTRING(HTOS(INTEGER(DDT_UAAD+I*TCBSIZE+J),8)) %IF J=0 %AND I#N %THEN PRINTSTRING("->") %ELSE SPACES(2) %REPEAT NEWLINE %REPEAT NEWLINE %FINISH %ELSE %START %CONSTSTRING(3)%ARRAY SENSEM(0:11)=" C0"," S0"," T3"," T7", "T11","T15","T19","T23", "T27","T31"," M0"," M4"; %RECORD(PROPFORM)%NAME PROP %INTEGER I,J,K,A0,A1,FLB,AAL,LBE PROP==RECORD(DDT_PROPADDR) %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 %FOR I=0,1,11 %CYCLE PRINTSTRING(SENSEM(I)." ".STRHEX(INTEGER(K+4*I))." ") %REPEAT PRINTSTRING(" RQB LBLOCK ADDRESS LIST ID ") FLB=P_P3&255 I=FLB+2 %IF I<8 %THEN I=8 %FOR J=0,4,4*I %CYCLE %IF J<=32 %THEN PRINTSTRING(STRHEX(INTEGER(DDT_RQA+J))." ") %C %ELSE PRINTSTRING(" ") LBE=INTEGER(DDT_LBA+J) PRINTSTRING(STRHEX(LBE)) %IF 4*FLB=J %THEN PRINTSYMBOL('*') %ELSE SPACE AAL=(LBE&255)*4; ! BYTES FROM START OF AL PRINTSTRING("-> ") %IF AAL>8&255=X'69' %AND A0=5 %AND A1<0 %START;! PRINT ID IF PUBLIC %FOR K=0,1,4 %CYCLE PRINTSTRING(HTOS(BYTEINTEGER(A1+K),2)) %REPEAT %FINISH %FINISH %ELSE PRINTSTRING("NOT VALID") NEWLINE %REPEAT NEWLINE %IF MULTIOCP=YES %THEN RELEASE LOG %FINISH %END %END %EXTERNALROUTINE PDISC(%RECORD(PARMF)%NAME P) !*********************************************************************** !* Receives paged disc transfers. Organises all queuing and * !* generates the ccws which are the passed to disc for execuition * !*********************************************************************** %IF SSERIES=YES %START %RECORD(TCBF)%NAME TCB %CONSTINTEGERARRAY CMD(1:6)=X'2040C012', X'2040C013'(2),X'2040C212',X'2040C012',X'2040C013' ! ! Error recovery consists of making retries with strobe normal,early ! and late and the following head offsets:- ! 0,+12,-12,+24,-24,+36,-36 ! this gives 21 additional reads. The first retry in normal as advised ! the array corrn contains mode,function&offset bytes in btm 24 bits ! %CONSTINTEGERARRAY CORRN(0:22)=0, X'001C00',X'204C00',X'104C00', X'004C0C',X'204C0C',X'104C0C', X'004C8C',X'204C8C',X'104C8C', X'004C18',X'204C18',X'104C18', X'004C98',X'204C98',X'104C98', X'004C24',X'204C24',X'104C24', X'004CA4',X'204CA4',X'104CA4', X'008C00'; %FINISH %ELSE %START %RECORD(RQBFORM)%NAME RQB %CONSTINTEGERARRAY CCW(1:6)=X'04002202', X'84002302',X'84002302',X'24002202',X'04002202', X'84002302'; %CONSTINTEGER IGNORELB=X'400000' %FINISH %RECORDFORMAT REQFORM(%INTEGER DEST, %BYTEINTEGER FAULTS, FLB, %C LLBP1, REQTYPE, %INTEGER IDENT, CYLINK, COREADDR, CYL, %C TRKSECT, STOREX, REQLINK) %RECORD(DDTFORM)%NAME DDT,XDDT %RECORD(PROPFORM)%NAME PROP %RECORD(PARMXF)%NAME ACELL %RECORD(REQFORM)%NAME REQ,ENTRY %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(%RECORD(REQFORM)%NAME REQ,%INTEGER FAIL) %SWITCH PDA(0:11) %OWNINTEGER INIT=0 %INTEGERNAME LINK %IF SSERIES=YES %START %INTEGER NEXT SEEK,TCBA,SECTINDX,STEAD %CONSTINTEGER RETRIES=21,PAGED=X'40000000' %FINISH %ELSE %START %INTEGER LBA,ALA,XTRA,CURRHEAD,FIRSTHEAD,FIRST SECT,LBA0,ALA0 %CONSTINTEGER RETRIES=7,MAXTRANS=12 %FINISH %INTEGER I,J,K,ACT,UNIT,LUNIT,CYL,TRACK,SECT,CELL,SECSTAT %INTEGER ERRLBE,UNRECOVERED,NEXTCELL,SRCE,FAIL,FLB,STOREX,L,PRIO !* ACT=P_DEST&X'FFFF' %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 ! %FOR I=0,1,NDISCS-1 %CYCLE 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 %IF UNIT>99 %THEN ->REJECT; ! prevent bound chk on crap da 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==PARM(PARMASL) CELL=ACELL_LINK REQ==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==PARM(CELL) ! ! Assume all transfers on this cyl will be carried out and arrange ! linking accordingly. Correct linking at repeat if not so ! DDT_UQLINK=REQ_REQLINK CYL=REQ_CYL %IF SSERIES=YES %START %IF CYL=DDT_CURCYL#0 %THEN NEXT SEEK=X'C' %ELSE NEXT SEEK=X'1C' ! X'10' = seek cyl TCBA=DDT_UA AD PROP==RECORD(DDT_PROPADDR) SECTINDX=PROP_SECTINDX %FINISH %ELSE %START %IF CYL=0 %THEN XTRA=IGNORELB %ELSE XTRA=0 ALA=DDT_ALA ALA0=ALA LBA=DDT_LBA LBA0=LBA RQB==RECORD(DDT_RQA) %FINISH ! ! The IPL cyl (0) is nonstandard in 2 ways ! firstly it has overflow formats and secondly track 0 has no keys ! disc tries to hide this so that the bulkmover etc can be used ! to move chopsupe to the worksite ! FLB=0; I=0; 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 SSERIES=YES %START TCB==RECORD(TCBA) TCBA=TCBA+TCBSIZE TCB=0 TCB_INIT SMASK=X'FE'; ! nothing masked TCB_INIT FN=NEXT SEEK; ! seek cyl,head & seg J=REQ_TRKSECT>>8&255 TCB_INIT SECT=J TCB_INIT SEG=SECTINDX*EPAGESIZE*(J-1) J=REQ_TRKSECT>>16 TCB_INIT HEAD=J TCB_INIT SHEAD=J TCB_INIT CYL=CYL TCB_INIT SCYL=CYL %IF REQ_FAULTS#0 %START; ! are retrying not transfering J=CORRN(REQ_FAULTS) TCB_INIT MODE<-J>>16 TCB_INIT FN<-J>>8 TCB_INIT OFFSET<-J NEXT SEEK=X'8C'; ! clear offset %FINISH %ELSE NEXT SEEK=X'C'; ! is this necessary? TCB_CMD=CMD(REQ_REQTYPE&255) STEAD=PST VA+REQ_COREADDR<<1>>19<<3 TCB_STE=INTEGER(STEAD+4) %IF INTEGER(STEAD)&PAGED#0 %THEN TCB_STE=TCB_STE!2 TCB_NEXT TCB=TCBA TCB_DATA AD=REQ_CORE ADDR TCB_DATA LEN=TRANSIZE %FINISH %ELSE %START %IF I=0 %THEN %START FIRST HEAD=REQ_TRKSECT>>16 CURR HEAD=FIRST HEAD FIRST SECT=REQ_TRKSECT>>8&255 %FINISH %ELSE %START; ! select hd§or J=REQ_TRKSECT>>16; ! head for this transfer %IF J#CURR HEAD %OR CYL=0 %START CURR HEAD=J INTEGER(LBA)=X'86000000'+J; ! select head LBA=LBA+4 %FINISH K=REQ_TRKSECT>>8&255; ! rotational sector INTEGER(LBA)=X'86001000'+20*EPAGESIZE*(K-1); ! set sector for k LBA=LBA+4 %FINISH REQ_FLB=FLB J=(LBA-LBA0)>>2; ! logic block no for tic K=(ALA-ALA0)>>2; ! start of relevant bit of alist INTEGER(LBA)=X'84106900'+K; ! search id = INTEGER(LBA+4)=X'01000000'+J;! tic to search id INTEGER(LBA+8)=CCW(REQ_REQTYPE)!XTRA+K INTEGER(ALA)=5 INTEGER(ALA+4)=ADDR(REQ)+22;! ADDR(REQ_CYL)+2 INTEGER(ALA+8)=TRANSIZE INTEGER(ALA+12)=REQ_COREADDR LBA=LBA+12 ALA=ALA+16 %FINISH I=I+1 ! ! Move the cell from the request queu to transferinprogress queu ! REQ_REQLINK=DDT_TRLINK DDT_TRLINK=CELL %IF SSERIES=YES %THEN FLB=(TCBA-DDT_UA AD)>>2 %ELSE %C FLB=(LBA-LBA0)>>2 REQ_LLBP1=FLB %FINISH CELL=NEXT CELL ! ! See if there any more transfers and if the are on the same cyl ! %IF CELL=0 %THEN ->DECHAIN REQ==PARM(CELL) %EXIT %IF I=MAXTRANS %REPEAT REQ_REQLINK=DDT_UQLINK DDT_UQLINK=CELL DECHAIN: %IF I=0 %THEN ->DOMORE; ! all aborted choose next cyl %IF SSERIES=YES %START TCB_NEXT TCB=0; ! unchain TCBs TCB_CMD=TCB_CMD&X'FFBFFFFF' %FINISH %ELSE %START ! INTEGER(LBA-4)=INTEGER(LBA-4)&X'FBFFFFFF' *LD_X'18000001FFFFFFFC'; ! one byte/-4 *INCA_LBA; ! to LBA-4 *MVL_%L=1,251,0; ! X'FB',0 clear chain bit RQB_W7=X'1E001300' RQB_W8=CYL<<16!(20*EPAGESIZE*(FIRST SECT-1))<<8!FIRST HEAD %FINISH %IF MONLEVEL&4#0 %THEN DDT_STATS2=DDT_STATS2+1; ! update transfer count 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 from 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==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==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 ! see if the following error code works for DCU discs protem 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==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 %START; ! disc inop DDT_QSTATE=2 %IF MULTI OCP=YES %THEN DDT_SEMA=-1 %RETURN %FINISH ->DOMORE PDA(11): ! inop disc now operable DDT==RECORD(INTEGER(DITADDR+4*P_P1)) %IF MULTI OCP=YES %START; ! grab sema *LXN_DDT+4 *INCT_(%XNB+29) *JCC_8, SEMALOOP(DDT_SEMA) ISEMAGOT: %FINISH ! current drive via DDT_QHDAD DDT_TRLINK=0 DDT_CURCYL=0 ->DOMORE !%ROUTINE QUEUE(%INTEGERNAME LINK,%INTEGER CELL,CYL) !*********************************************************************** !* Queues request in ascending page(ie cyl) order so seek times * !* are minimised. Prio=0 transfers always go to front however * !* apart from demand pages at head this is the optimal algorithm * !* for queues up to 32 in CACM.15.3 MAR 1972 pp177 et seq * !*********************************************************************** !%RECORD(REQFORM)%NAME REQ,ENTRY,NEXTREQ !%INTEGER NEXTCELL,AD ! REQ==PARM(CELL) QUEUE: NEXTCELL=LINK ENTRY==PARM(NEXTCELL) ! ! Put this transfer at head of the queue if:- ! A) the queue is empty ! B) this transfer lies between current cyl and first transfer. ! this case includes all transfers arriving on current cyl since ! CURRENt head posn is kept as trck 0 page 0 of current cyl %IF NEXTCELL=0 %OR CYL QCYCLE: *LB_(%XNB+8); ! ENTRY_REQLINK *JAT_12, *MYB_PCELLSIZE; *ADB_PARM0AD *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(%RECORD(REQFORM)%NAME 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 * !*********************************************************************** %RECORD(PARMXF)%NAME REP %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 %RECORDFORMAT PONOFF(%INTEGER DEST,SRCE, %C (%INTEGER P1,P2,P3,P4 %OR %C %INTEGER INTACT,EPAGE,STORI,PRI), %C %INTEGER P5,P6,LINK) %EXTERNALROUTINE DRUM(%RECORD(PONOFF)%NAME 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 ESQBF(%INTEGER DEST,SRCE,INTACT,EPAGE,STORI,P4,%C %LONGINTEGER LSAW,%INTEGER Q) ! 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 %RECORD(ESCBF)%ARRAY ESCBS(0:31)) ! 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) %RECORDFORMAT COMAF(%INTEGER MARK, PAW, COUNTS, DRUMRQ, CSAW1, %C CSAW2, CRESP1, CRESP2, %INTEGERARRAY PAWS, PIWS(0:7)) %RECORD(COMAF)%NAME CCA,CCA0 %ROUTINESPEC ACTIVATE(%RECORD(DTABF)%NAME DT,%RECORD(ESCBF)%NAME ES, %C %INTEGERNAME Q) !%ROUTINESPEC CLAIM(%INTEGERNAME N) %ROUTINESPEC SERV(%RECORD(DTABF)%NAME DTENT, %INTEGER ESEC) %ROUTINESPEC DOBR %ROUTINESPEC TAKE CRESPS(%RECORD(CONTABF)%NAME CTENT) %ROUTINESPEC PSTATUS(%RECORD(DTABF)%NAME DTENT) %ROUTINESPEC FAIL ALL(%RECORD(DTABF)%NAME DTENT) %ROUTINESPEC PDATM %ROUTINESPEC PTM(%RECORD(DTABF)%NAME DTENT) %CONSTSTRING(21) PTMS="port trunk mechanism" %ROUTINESPEC REPORT(%RECORD(DTABF)%NAME DTENT, %C %INTEGER ESEC, %STRING(47) S) %ROUTINESPEC INITIALISE(%RECORD(PARMF)%NAME P) %ROUTINESPEC LOAD MPROG(%INTEGER PT) %OWNINTEGER IDENT=M'DRUM', IFIER=M'36AC' ! FIRST ENTRY IN DRUM TABLE REFERENCED BY:- %OWNRECORD(DTABF)%NAME DTAB0 ! DEFINE THE CONTROLLER TABLE BY:- %OWNRECORD(CONTABF)%ARRAYNAME CONTABA %OWNRECORD(CONTABF)%ARRAYFORMAT CONTABAF (1:8) %OWNRECORD(CONTABF)%NAME CONTAB1; ! ONTO 1ST(OFTEN ONLY) EL OF ! ARRAY CONTABA %RECORD(CONTABF)%NAME CONTAB %OWNINTEGER CONTMAX=0; ! MAX INDEX IN CONTAB. %OWNRECORD(LOGTABF)%ARRAY LOGTAB(0:15); ! I.E. MAX OF 16 DRUMS CATERED FOR ?? %RECORD(LOGTABF)%NAME LOG; ! FOR MAPPING ONTO LOGTAB ! MAIN ACTIVITY CONTROLLING SWITH:- %SWITCH ACTIVITY(0:10); ! 0 => INITIALISE ! 1 => READ ! 2 => WRITE ! 3 => INTERRUPT ! 4 PERFORMANCE LOG AND RESET ! 5 = POLLING (NEEDED FOR ERRORS) ! 6 = SPARE ! 7 = SAC RECONFIGURE ! 8 spare ! 9 = 5 minute tick after format ! 10 = reinit SFC ! 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 %RECORD(DTABF)%NAME DTENT %RECORD(ESCBF)%NAME ESCB %RECORD(STOREF)%NAME STOR %RECORD(ESQBF)%NAME ESQB %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=0; ! NUMBER OF SECTORS PER EPAGE %OWNINTEGER EPNBITS=0; ! EPN 1S LEFT JUSTIFIED %CONSTINTEGER DSN=X'28'; ! SERVICE NUMBERS %CONSTINTEGER DSNSRCE=DSN<<16; ! ABOVE<<16 FOR PON & POFF %CONSTSTRING(8) AAD="&& DRUM " %STRING(6) SFCPT ! 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 NT=X'00800000' %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=0 %LONGINTEGER PRESENT %INTEGER I,J,SS,AD,PT,PTX %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 ACTIVITY(7): ! reconfigure SAC (P_P2=SAC) I=P_P2 P_P2=0 DTENT==DTAB0 %CYCLE %IF DTENT_PTM>>8=I %AND DTENT_STATE>=0 %START; ! auto FAIL ALL(DTENT); ! abandon drum %FINISH %EXIT %IF DTENT_NEXT=0 DTENT==RECORD(DTENT_NEXT) %REPEAT ->ROUT ACTIVITY(10): ! reinit SFC (P_P1=pt,P_P2=old pt if >=0) SFCPT="SFC ".HTOS(P_P1,2) PT=P_P1 PTX=P_P2 %IF PTX>=0 %AND PTX#PT %START; ! SAC switch %UNLESS 0<=PT<=X'1F' %AND 0<=PTX<=X'1F' %C %AND BYTEINTEGER(COM_CONTYPEA+PT)=0 %AND %C BYTEINTEGER(COM_CONTYPEA+PTX)=1 %THEN %C OPMESS("SFC old/new pt???") %AND ->ROUT %FINISH %ELSE %START %UNLESS 0<=PT<=X'1F' %AND BYTEINTEGER(COM_CONTYPEA+PT)=1 %C %THEN OPMESS("Cannot reinit ".SFCPT) %AND ->ROUT %FINISH DTENT==DTAB0 J=-1 %CYCLE %IF DTENT_PTM>>4=PT %START %IF DTENT_STATE>=0 %THEN FAIL ALL(DTENT); ! abandon drum if auto %IF PTX>=0 %AND PTX#PT %THEN DTENT_PTM=DTENT_PTM&15!PT<<4; ! SAC switch J=DTENT_CONTI; ! remember controller %FINISH %EXIT %IF DTENT_NEXT=0 DTENT==RECORD(DTENT_NEXT) %REPEAT %IF J<0 %THEN OPMESS("No drums on ".SFCPT) %AND ->ROUT %IF PTX>=0 %AND PTX#PT %START; ! SAC switch CONTABA(J)_ISCONTREG=SAC CONTROL!PT<<16; ! reset IS reg BYTEINTEGER(COM_CONTYPEA+PT)=1 BYTEINTEGER(COM_CONTYPEA+PTX)=0 %FINISH %IF P_P3>=0 %START; ! reload microprogram LOAD MPROG(PT) OPMESS(SFCPT." mprog loaded") %FINISH I=SAC CONTROL!PT<<16 *LB_I; *LSS_2; *ST_(0+%B); ! master clear WAIT(1) SLAVESONOFF(0); ! slaves off J=CONTABA(J)_MARKAD CCA0==RECORD(REAL0ADDR) CCA0_MARK=-1 CCA0_PAW=X'04000000'; ! do controller req CCA0_CSAW1=X'32000004' CCA0_CSAW2=REALISE(J) CCA0_CRESP1=0 *LXN_REAL0ADDR; *INCT_(%XNB); *TDEC_(%XNB) CCA==RECORD(J) CCA_MARK=-1 WAIT(1) *LXN_J L1: *INCT_(%XNB); *JCC_7, CCA_PAW=X'04000000' CCA_CRESP1=0 *LB_I; *LSS_1; *ST_(0+%B) *LXN_J; *TDEC_(%XNB) WAIT(5) %IF CCA0_PAW#0 %THEN OPMESS("Failed to reinit ".SFCPT) %AND ->ROUT CCA=0 CCA_MARK=-1 DTENT==DTAB0; ! mark drums auto & inactive %CYCLE %IF DTENT_PTM>>4=PT %START *LXN_CCA+4; ! connect interface *INCT_(%XNB+0) *JCC_8, SEMALOOP(CCA_MARK) ISEMAGOT: J=(DTENT_PTM&15)<<21 CCA_PAW=X'04000000' CCA_CSAW1=X'3A000004'!J CCA_DRUMRQ=X'05000000'!J CCA_CRESP1=0 *LB_I; *LSS_1; *ST_(0+%B) CCA_MARK=-1 %FOR PTX=1,1,COM_INSPERSEC %CYCLE %EXIT %IF CCA_CRESP1#0 %REPEAT %IF CCA_CRESP1#NT %THEN OPMESS(SFCPT." connect fails") %C %AND ->ROUT %IF P_P4>0 %START; ! format drum *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CCA_MARK) FSEMAGOT: CCA_PAW=X'04000000' CCA_CSAW1=X'3A000000'!J+DTENT_NSECS CCA_DRUMRQ=X'01000000'!J CCA_CRESP1=0 *LB_I; *LSS_1; *ST_(0+%B) CCA_MARK=-1 %FOR J=1,1,COM_INSPERSEC*250*10 %CYCLE %EXIT %IF CCA_CRESP1#0 %REPEAT %IF CCA_CRESP1#NT %THEN OPMESS(SFCPT." format fails") %C %AND ->ROUT OPMESS(SFCPT." formatted OK") %FINISH *LXN_CCA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CCA_MARK) FSEMAGOT1: CCA_CRESP1=0 CCA_PAW=0 CCA_CSAW1=0 CCA_DRUMRQ=0 CCA_MARK=-1 DTENT_STATE=0 %UNLESS P_P4>0; ! wait for active mem. timeout after format DTENT_PIW=0 DTENT_PAW=0 %FINISH %EXIT %IF DTENT_NEXT=0 DTENT==RECORD(DTENT_NEXT) %REPEAT SLAVESONOFF(-1); ! slaves back on OPMESS(SFCPT." reinitialised ok") %IF P_P4>0 %START; ! formatted so wait a while P_DEST=X'A0002' P_P1=DSNSRCE!9 P_P2=300; ! 5 minutes P_P3=PT PON(P) %FINISH %RETURN ACTIVITY(9): ! tick after format DTENT==DTAB0 %CYCLE %IF DTENT_PTM>>4=P_P1 %AND DTENT_STATE<0 %THEN DTENT_STATE=0; ! release drum %EXIT %IF DTENT_NEXT=0 DTENT==RECORD(DTENT_NEXT) %REPEAT OPMESS("SFC ".HTOS(P_P1,2)." back in service") %RETURN ROUT: %UNLESS P_SRCE=0 %START I=P_SRCE P_SRCE=P_DEST P_DEST=I PON(P) %FINISH %RETURN %ROUTINE LOAD MPROG(%INTEGER PT) %ROUTINESPEC WAITAFB(%INTEGER ISDIAG); ! WAIT FOR ACKNOWLEDGE FROM B ! SFC MICROPROGRAM VERSION 941 DATED 29NOV78 ! ! THIS VERSION FIRST USED IN CHOPSUPE 18E ! PREVIOUSLY VSN 940 USED FROM 15JAN78 %ENDOFLIST %CONSTINTEGERARRAY UPA(0:X'200')=%C X'3006E841',X'0C829041',X'00018782',X'00032C22', X'00014003',X'00031874',X'22601141',X'0001D041',X'86803951', X'86858041',X'22601141',X'A0103941',X'00029041',X'0001004C', X'86803901',X'0881E841',X'A0136841',X'0F00E8C1',X'22605041', X'0002DF62',X'00051844',X'00000044',X'0000F4A3',X'00028042', X'8004F462',X'80801157',X'2260417A',X'86803941',X'30003906', X'00008841',X'0000907E',X'A00B3840',X'0000A879',X'0000115E', X'0810E87B',X'0000A876',X'00010079',X'0002E876',X'0000A873', X'0000A872',X'0002780B',X'0001D07D',X'00050873',X'0000F072', X'0000F871',X'0000A86C',X'0000A86B',X'0000A86A',X'50003941', X'0002C041',X'00001940',X'00031846',X'A0705815',X'0000EA7D', X'00028003',X'00031F42',X'000284E7',X'000004E7',X'0DE00034', X'2260212C',X'0C81C833',X'0001D82F',X'0001B823',X'81040041', X'0E024041',X'00012041',X'000209C1',X'84040041',X'0001E9E8', X'00000040',X'0001B045',X'0001E045',X'000251C5',X'0001F9C6', X'000201C6',X'86803961',X'64103960',X'8406D041',X'6390395E', X'8400395D',X'84003941',X'00032AC1',X'0002F84A',X'8400393A', X'000000C1',X'80000041',X'00000402',X'0000F83E',X'2260111A', X'0DE00041',X'00008042',X'0000E87C',X'0000F056',X'00000482', X'00000071',X'0002C041',X'00000040',X'0001D045',X'0000116F', X'00004171',X'0002E87C',X'80802174',X'06808841',X'00000764', X'00027041',X'20E00041',X'00091841',X'0000800F',X'0002E483', X'0002F841',X'00032861',X'00026841',X'0002C02B',X'80048036', X'22604149',X'00036040',X'22601136',X'86050852',X'000249CF', X'3007003B',X'2260113B',X'0001003F',X'0001084D',X'0002F0C1', X'80000041',X'0001EC02',X'0000020C',X'80802141',X'000000C1', X'00000442',X'0002C00F',X'00000204',X'00011812',X'84050841', X'0001E9C1',X'22601141',X'0001D041',X'86803941',X'A0103941', X'00023041',X'00023841',X'0000A041',X'20E0113B',X'00008841', X'0DE00036',X'00026041',X'80003941',X'00026839',X'000080C1', X'80026841',X'0F80003A',X'0000115A',X'0000803C',X'0000A8E5', X'0000FAC1',X'00031041',X'0003302A',X'0000A02B',X'0000F82C', X'0D900007',X'00044141',X'820CE841',X'090890C6',X'2262E483', X'81840041',X'00011816',X'00044141',X'000C00C1',X'8006C041', X'0C826840',X'00015007',X'00016008',X'81857782',X'00011815', X'00014041',X'0001200C',X'000518BF',X'00014841',X'0002E484', X'00000024',X'0002C041',X'00003940',X'84826802',X'00015805', X'00016806',X'0000EF82',X'00000022',X'0001400A',X'00048838', X'00051820',X'20E33442',X'00002143',X'80800241',X'00002128', X'000D98C1',X'80040041',X'80801141',X'50003941',X'0F03852D', X'00005AC1',X'00033840',X'0901004D',X'0900F04C',X'0900F04B', X'0900F84A',X'0900F849',X'0900E848',X'0900E847',X'09822038', X'84003941',X'0002383A',X'30040034',X'00007041',X'0000833B', X'8106F841',X'0E024041',X'8186C041',X'0E021040',X'00000020', X'0000833D',X'A0600908',X'00026841',X'A060110D',X'0003304C', X'80808040',X'00002152',X'00002146',X'20E10027',X'00000001', X'20E10829',X'0000A062',X'00006288',X'20E2E8C1',X'0000CC42', X'00002142',X'0000580B',X'20E128C1',X'0002AE87',X'0000B662', X'20E0213F',X'80801141',X'50003941',X'20E00035',X'000231FA', X'0000EF67',X'00042141',X'000D4841',X'848490C1',X'80022041', X'00000405',X'0000F044',X'80801141',X'50003941',X'00001916', X'60100041',X'0C880402',X'00028841',X'00015786',X'0002C041', X'0000B040',X'0DE13014',X'00031841',X'0000A5AE',X'22614012', X'20E23041',X'00001141',X'84003941',X'0002380E',X'0D9220C1', X'C1E01141',X'8206F041',X'30003941',X'21E01141',X'0001C041', X'86803941',X'30003941',X'8504C041',X'20E04141',X'00014841', X'44B2F041',X'0C840402',X'850400C2',X'00029001',X'20E01141', X'00015742',X'00028041',X'60303919',X'00000545',X'00000443', X'000231CC',X'00000545',X'80802149',X'00000443',X'80801141', X'50003904',X'0000002A',X'00000041'(3),X'0000A54F',X'000231C1', X'8402B765',X'5D09E841',X'0E857CE3',X'8500B841',X'000404C2', X'0002380A',X'22200041',X'209890C1',X'0006FC42',X'00004147', X'0000A4E3',X'80802141',X'A0100084',X'20E230C1',X'00001141', X'8400391D',X'22100041',X'0004E0C1',X'09002141',X'80040041', X'00011CF3',X'0E021D22',X'0F0080C2',X'30048038',X'8004F6E2', X'0DE22039',X'0880A041',X'85055D66',X'44B00583',X'00022841', X'0000E843',X'0C89A041',X'00016041',X'20E23041',X'00001141', X'84003941',X'0000D041',X'80801141',X'50003944',X'818220C1', X'00001141',X'8000395F',X'A0636841',X'00019841',X'0002D841', X'000197A8',X'8106C041',X'00017840',X'00001943',X'A0500941', X'00007041',X'8504BCD8',X'8080EAC2',X'81057805',X'00031041', X'00033341',X'00002141',X'0001E841',X'000000C1',X'00016C47', X'8584A5B4',X'44B08041',X'5C895DF0',X'81040041',X'0E90062F', X'81801142',X'00002108',X'8584D841',X'61603941',X'64B17041', X'0C86C041',X'000160C0',X'0000A079',X'800402C1',X'08800070', X'2220F041',X'20980051',X'0904A032',X'0E840041',X'C1E01151', X'81801141',X'00008615',X'64B005C7',X'0C840041',X'C2E17041', X'669AC041',X'61183940',X'0000A06A',X'0000000F',X'C162C041', X'66983940',X'0000A066',X'00000013',X'808802C1',X'00031041', X'0003306D',X'30003941',X'21E01141',X'0001C041',X'86803941', X'0001F041',X'80040046',X'0002C041',X'81003940',X'00000007', X'82001141',X'80003909',X'0880C1C1',X'84003941',X'85854841', X'20E04141',X'44B17041',X'0C855C02',X'858550C2',X'00029001', X'20E01141',X'60303941',X'44B00742',X'00028041',X'0C86C041', X'000162C0',X'00000047',X'82000763',X'00000642',X'0002F82F', X'00001141',X'81003941',X'00022041',X'0000A041',X'20E23041', X'00001141',X'84003941',X'80801141',X'50003941',X'00001941', X'00031841',X'00023CE7',X'00009442',X'A0104144',X'808004E4', X'00002141',X'00000084',X'221000C3',X'00031B41',X'0000ED65', X'00051B41',X'00002141',X'00000041',X'80056CE6',X'0E021D28', X'0F01E8C1',X'00031EE2',X'300485CC',X'00000569',X'8201E8C1', X'00001141',X'80003956',X'3005E841',X'0000E0C1',X'0DE22041', X'0E908041',X'C2601141',X'30003941',X'22601141',X'0002F041', X'0001C041',X'86803941',X'30003941',X'8504C041',X'20E04141', X'00014841',X'44B00041',X'0C856841',X'850550C1',X'20E01141', X'60303941',X'0002F742',X'00028041',X'00031AC1',X'0000ED69', X'00000000'(28),X'00D20941',X'84640616',X'84640716',X'F2B24B72' %LIST %INTEGER I,SPT,ISA,DATA,COMM,DCM FAIL %INTEGER MSH,LSH %CONSTINTEGER CONTROL=X'800' %CONSTINTEGER DIAGSTAT=X'D00' %CONSTINTEGER ISDIAG=X'E00' %CONSTINTEGER MCLEAR=2 %CONSTINTEGER DCMBIT=X'400' %CONSTINTEGER NOTDCM=\DCMBIT %CONSTINTEGER AFB=X'800' %CONSTINTEGER CLEARTOSEND=X'E80' %CONSTINTEGER CLEAR FOR NEXT=X'E00' %CONSTINTEGER UH=X'FFFF0000' %CONSTINTEGER WIDCOM=X'A200' SPT=(X'4000'!PT)<<16; ! SAC control ISA=SPT+CONTROL *LB_ISA; *LSS_MCLEAR; *ST_(0+%B) ISA=SPT+DIAGSTAT; ! into direct control mode *LB_ISA *LSS_(0+%B); *OR_DCMBIT; *ST_(0+%B) ISA=SPT+ISDIAG; ! write microprogram DCM FAIL=0 %FOR I=0,1,511 %CYCLE DATA=UPA(I) MSH=DATA&UH!CLEAR TO SEND LSH=DATA<<16!CLEAR TO SEND COMM=(WIDCOM+I)<<16!CLEAR TO SEND *LB_ISA; *LSS_COMM *ST_(0+%B); WAITAFB(ISA) *LB_ISA; *LSS_MSH *ST_(0+%B); WAITAFB(ISA) *LB_ISA; *LSS_LSH *ST_(0+%B); WAITAFB(ISA) %REPEAT ! set mprog loaded indicator COMM=(WIDCOM+X'200')<<16!CLEAR TO SEND *LB_ISA; *LSS_COMM *ST_(0+%B); WAITAFB(ISA) *LB_ISA; *LSS_CLEARTOSEND *ST_(0+%B); WAITAFB(ISA) *LB_ISA; *LSS_CLEARTOSEND *ST_(0+%B); WAITAFB(ISA) %UNLESS DCM FAIL=0 %THEN %C PRINTSTRING("SFC ".HTOS(PT,2)." mprog flags=". %C HTOS(DCM FAIL,4)." ") *LB_ISA; *LSS_CLEAR FOR NEXT; *ST_(0+%B); ! clear FBs ISA=SPT+DIAGSTAT; !unset DCM *LB_ISA *LSS_(0+%B); *AND_NOTDCM; *ST_(0+%B) %ROUTINE WAITAFB(%INTEGER ISDIAG) %INTEGER I AGAIN: *LB_ISDIAG *LSS_(0+%B) *ST_I *AND_AFB *JAT_4, DCM FAIL=DCM FAIL!(I&X'1FF'); ! all FFBS and parity fails %END; ! OF WAITAFB %END; ! OF LOAD UPROG %ROUTINE ACTIVATE(%RECORD(DTABF)%NAME DTENT,%RECORD(ESCBF)%NAME ESCB, %C %INTEGERNAME Q) %RECORD(ESQBF)%NAME ESQB %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(%RECORD(DTABF)%NAME DTENT, %INTEGER ESEC) %RECORD(ESCBF)%NAME ESCB; ! AN ESEC TERMINATION HAS OCCURRED %RECORD(ESQBF)%NAME ESQB %RECORD(LOGTABF)%NAME LOG %INTEGERNAME Q; ! REFERENCES HQ OR LQ AS APPROPRIATE %INTEGER FIRST, SECOND, SRESPS, THISP, NEXTP;! INDICES IN PARMX !%INTEGER COUNT, ADDRESP0 %RECORD(STOREF)%NAME STOR 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(%RECORD(CONTABF)%NAME CONTENT) %INTEGER MN, CRESP0, CRESP1 %INTEGERNAME CSEMA %RECORD(DTABF)%NAME DTENT ! 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) %UNLESS DTENT_STATE=S; ! already dead %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(%RECORD(DTABF)%NAME 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 * !*********************************************************************** %INTEGER I, FIRST, SECOND %INTEGERNAME Q %RECORD(ESCBF)%NAME ESCB %RECORD(ESCBF)%ARRAYNAME ESCBS OPMESS("Abandoning drum ".HTOS(DTENT_PTM,3)) DTENT_STATE=S; ! NOTHING ACTIVE NOW ESCBS==DTENT_ESCBS %FOR ESEC=0,1,DTENT_SECLIM//EPN-1 %CYCLE; !!!!!!!! ESCB==ESCBS(ESEC) %FOR I=0,1,1 %CYCLE %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 ESQB_EPAGE=-1; ! indicate failure!! 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. * !*********************************************************************** %RECORD(CONTABF)%NAME CONTENT %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) %RECORD(CAF)%NAME CA; ! 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(%RECORD(DTABF)%NAME DTENT) !*********************************************************************** !* READS AND PRINTS STATUS * !* WHICH CLEARS ANY ABNORMAL TERMINATION * !*********************************************************************** %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. %OWNINTEGERARRAY STATUS(-2:4)= M'SFCS',M'TATE',0(5) ! MUST BE OWN TO ENSURE PHYSICAL CONTIGUITY %INTEGER ISA, TEMP, PAW %RECORD(CAF)%NAME CA 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)) ! CLAIM(CA_MARK) *LXN_CA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) SEMAGOT: PAW=CA_PAW; ! SAVE PAW CA_PAW=PAWFCR CA_CAW0=TEMP CA_CAW1=REALISE(ADDR(STATUS(0))) CA_CRESP0=0 CA_MARK=-1 %FOR TEMP=0,1,4 %CYCLE 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 ! CLAIM(CA_MARK) *LXN_CA+4 *INCT_(%XNB+0) *JCC_8, SEMALOOP(CA_MARK) SEMAGOT2: CA_CRESP0=0; ! CLEAR FOR FURTHER RESPONSES CA_PAW=PAW; ! RESTORE PAW CA_MARK=-1 PRINTSTRING("controller status: ") %FOR TEMP=0,1,4 %CYCLE PRINTSTRING(HTOS(STATUS(TEMP),8)) SPACE %REPEAT NEWLINES(2) %END; ! OF PSTATUS %ROUTINE REPORT(%RECORD(DTABF)%NAME DTENT, %INTEGER ESEC, %C %STRING (47) MESS) !*********************************************************************** !* THIS ROUTINE PRINTS OUT STREAM RESPONSES * !* ON THIS ESEC OF THIS DRUM. * !*********************************************************************** %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 %RECORD(STRF)%NAME STR %RECORD(LOGTABF)%NAME LOG 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) %FOR SEC=0,1,EPN-1 %CYCLE 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(%RECORD(PONOFF)%NAME P) %RECORD(DTABF)%NAME DTENT %RECORD(ESCBF)%NAME ESCB %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 %FOR LOGI=1,1,CONTMAX %CYCLE 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(%RECORD(DTABF)%NAME DTENT); ! PRINTS IN FORMAT:- %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(%RECORD(PARMF)%NAME P) %RECORDFORMAT SEMAF(%INTEGER DEST,SRCE,TOP,BTM,SEMA,TICK,P5,P6,LINK) %RECORD(SEMAF)%NAME SEMACELL %RECORD(PARMXF)%NAME WAITCELL %OWNINTEGERARRAY HASH(0:31)=0(32) %OWNINTEGER TICKS=0 %INTEGERFNSPEC NEWSCELL %INTEGERFNSPEC NEWWCELL %INTEGER SEMA, HASHP, NCELL, I, WCELL %INTEGERNAME CELLP %SWITCH ACT(1:4) %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&7) !----------------------------------------------------------------------- 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 SEMACELL_TICK=TICKS; ! RECORD V OPERATION I=SEMACELL_TOP %IF I#0 %START; ! IN CASE 2 V OPERATIONS SEMACELL_TOP=PARM(I)_LINK PARM(I)_SRCE=P_SRCE; ! if a timeout P_SRCE = X'70004' ! this SRCE enables director to reset faulty SEMA FASTPON(I) %FINISH %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 %FOR HASHP=0,1,31 %CYCLE CELLP==HASH(HASHP) %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) SEMA=SEMACELL_SEMA I=SEMACELL_TOP %WHILE I#0 %CYCLE OPMESS("SEMA X".HTOS(SEMA,8). %C " Q :X".HTOS(PARM(I)_DEST>>16,3)) I=PARM(I)_LINK %REPEAT CELLP==SEMACELL_LINK %REPEAT %REPEAT %FINISH %RETURN !----------------------------------------------------------------------- ACT(4): ! TEN SECOND TICK TICKS=TICKS+1 %FOR HASHP=0,1,31 %CYCLE CELLP==HASH(HASHP) %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) %IF TICKS-SEMACELL_TICK>=12 %START;! 2 MINS SINCE V OPER OPMESS("FSEMA timeout ".HTOS(SEMACELL_SEMA,8)) P_DEST=X'70002' P_SRCE=X'70004' P_P1=SEMACELL_SEMA PON(P) %FINISH CELLP==SEMACELL_LINK %REPEAT %REPEAT %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 SEMACELL_TICK=TICKS %IF MONLEVEL&2#0 %THEN SEMACELL_P5=M'SEMA' %IF MONLEVEL&2#0 %THEN SEMACELL_P6=M'HEAD' %RESULT=I %END %END %ENDOFFILE