! ! TO MAKE S SERIES SUPERVISOR REQUIRES:- ! 1) CHANGE SSERIES=NO TO SSERIES=YES IN CTOPTIONS FILE ! 2) REPLACE COMF BY S SERIES COM IN ERCC08.COMSF ! ! ! THESE CONST INTEGERS DEFINE SIZES AND LAYOUT OF IMPORTANT TABLES ! THEY HAVE TO BE HERE TO BE GLOBAL TO ALL ROUTINES INCLUDING IO ONES ! %CONSTINTEGER LSTLEN=192; ! LOCAL SEGMENT TABLE LENGTH %CONSTINTEGER CBTLEN=255; ! LENGTH OF CBT TABLE %CONSTLONGINTEGER LCACR=1; ! ACR OF LOCAL CONTROLLER %CONSTINTEGER DIRCSEG=10; ! SEG NO OF DIRECTOR COMMS SEG %CONSTINTEGER DIRCSEGOFFSET=0; ! FOR ALIGNMENT IF NEEDED %CONSTINTEGER DIRCSEGAD=DIRCSEG<<18; ! VIRTUAL ADDRESS OF DIR COM SEG %CONSTINTEGER DIRCSEGL=8*CBTLEN+255+LSTLEN; ! SIZE OF SAME ! MADE UP OF 2049 FOR CBT ! LSTLEN FOR SST ! 48+64 FOR 2 BITS OF SYTEMCALL TABLE ! 32+48 FOR DIROUTP&SIGOUT %CONSTINTEGER LSTACKLEN=3; ! LOCAL CONT. STACK ELEN %CONSTINTEGER LSTACKLENP=2; ! PAGED PART %CONSTINTEGER LSTKN=3; ! NO OF LOCAL STACKS %CONSTLONGINTEGER DIRACR=2; ! DIRECTOR ACR LEVEL %CONSTLONGINTEGER NONSLAVED=X'2000000000000000' %CONSTINTEGER MAXIT=X'FFFFFF' ! THESE CONST INTEGERS LAYOUT THE DIRECTOR COMMS SEGMENT(LOCAL 10) %CONSTINTEGER SCTIENTRIES=6; ! VALID I VALUES FOR SCT %CONSTINTEGER SCTI0=DIRCSEGAD+DIRCSEGOFFSET;! SYSTEMCALL INDEX TABLE %CONSTINTEGER SCTILEN=SCTIENTRIES*8; ! OF SCTIENTRIES DOUBLE WORDS %CONSTINTEGER SCTJ30=SCTI0+SCTILEN; ! 3RD BRANCH OF SC TABLE %CONSTINTEGER SCTJ3LEN=4*16; ! 4ENTRIES FOR 3 LC ROUTINES %CONSTINTEGER DIROUTPAD=SCTJ30+SCTJ3LEN;! ADDRESS OR DIROUTP %CONSTINTEGER DIROUTPLEN=32; ! ONE 32 BYTE RECORD %CONSTINTEGER SIGOUTPAD=DIROUTPAD+DIROUTPLEN;! ADDR SIGOUTP %CONSTINTEGER SIGOUTPLEN=48; ! ONE 48 BYTE RECORD %CONSTINTEGER CBTAD=SIGOUTPAD+SIGOUTPLEN;! CLAIMED BLOCK TABLE AD %CONSTINTEGER SSTAD=CBTAD+8*CBTLEN; ! 2DRY SEG TABLE OF LSTLEN BYTES %CONSTINTEGER LSTVAD=0; ! VIRTUAL ADDRESS OF LOCAL SEG TABLE !----------------------------------------------------------------------- %RECORDFORMAT IOSTATF(%INTEGER IAD,%STRING(15) INTMESS, %C %INTEGER INBUFLEN,OUTBUFLEN,INSTREAM,OUTSTREAM) %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) %INTEGERFNSPEC REQUEST INPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %INTEGERFNSPEC REQUEST OUTPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %INTEGERFNSPEC CHANGE CONTEXT %LONGINTEGERFNSPEC RTDR(%INTEGERFN A) %EXTERNALROUTINE SUP29 !----------------------------------------------------------------------- %OWNSTRING(3) SUPID="26I" ! MAIN CHANGES FOR 26I !--------------------- ! 1) CHANGES FOR BETTER ACCESSING OF SEQUENTIAL FILES ! TOGETHER WITH REDUCTION IN STROBING ! 2) CHANGES TO PREPAGING LC STACK TO AVOID USING PPCELLS ! %CONSTSTRING(3) CHOPID="20L"; ! EARLIEST COMPATABLE CHOPSUPE !----------------------------------------------------------------------- !* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20J ONWARDS * %RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, %C TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,DQADDR, %C %BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C NOCPS,RESV2,OCPPORT1,OCPPORT0, %C %INTEGER ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, %C BLKADDR,RATION,SMACS,TRANS,%LONGINTEGER KMON, %C %INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,SP0,SP1, %C SP2,SP3,SP4,SP5,SP6,SP7,SP8, %C LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, %C HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, %C SDR4,SESR,HOFFBIT,S2,S3,S4,END) %RECORDNAME COM(COMF) COM==RECORD(X'80000000'+48<<18) %CONSTINTEGER VIRTAD=X'81000000'; ! CAN NOT BE USED IF PAGE FLAWED %CONSTINTEGER PUBSEG=X'80000000',SEG64=X'01000000' COM_MAXPROCS=MAXPROCS %CONSTINTEGER EPAGESIZE=4,EPAGESHIFT=12;! 4*1024==1<<12 %CONSTINTEGER SEGEPSIZE=256//EPAGESIZE !----------------------------------------------------------------------- ! MISC. ROUTINE SPECS %EXTERNALROUTINESPEC SLAVESONOFF(%INTEGER ONOFF) %EXTERNALSTRING(15)%FNSPEC STRINT(%INTEGER N) %EXTERNALSTRING(8)%FNSPEC STRHEX(%INTEGER N) %EXTERNALSTRING(63)%FNSPEC STRSP(%INTEGER N) %EXTERNALROUTINESPEC PKMONREC(%STRING(20)TEXT,%RECORDNAME P) %EXTERNALROUTINESPEC MONITOR(%STRING(63) S) %EXTERNALROUTINESPEC OPMESS(%STRING(63) S) %EXTERNALROUTINESPEC DISPLAY TEXT(%INTEGER SCREEN,LINE,CHAR, %C %STRING(41) S) %EXTERNALROUTINESPEC UPDATE TIME %EXTERNALROUTINESPEC DPONPUTONQ(%RECORDNAME P) %EXTERNALROUTINESPEC TURNONER(%RECORDNAME P) %EXTERNALROUTINESPEC DUMP TABLE(%INTEGER TABNO,ADR,LEN) %IF SFCFITTED=YES %THEN %START %ROUTINESPEC BAD DRUM PAGE(%INTEGER DTX) %EXTERNALROUTINESPEC DRUM(%RECORDNAME P) %FINISH %IF MULTIOCP=YES %THEN %START %INTEGERFNSPEC REMOTE ACTIVATE(%INTEGER PORT,AD) %FINISH %IF MONLEVEL&4#0 %START %LONGINTEGER CLOCK0,IDLEIT,NOWORKIT,LCIT,LCIC,FLPIT,BLPIT %LONGINTEGER PTIT,PTIC,DRUMIT,DRUMIC,PDISCIT,PDISCIC, %C RETIT,RETIC,AMIT,AMIC %INTEGER PTCALLN,DRUMCALLN,PDISCCALLN,AMCALLN,RETCALLN %FINISH %INTEGER I,J,K,FSTASL,BSTASL,FREEEPAGES,SHAREDEPS,UNALLOCEPS, %C OVERALLOC,DRUMSIZE,DRUMTASL,NPQ,OLDLNB,IDLE,LCN,DRUMT ASL BTM, %C MPLEVEL,PAGEFREES,DCLEARS,GETEPN,DRUMALLOC,PREEMPTED, %C MAX OVERALLOC %IF MONLEVEL&4#0 %THEN %START %INTEGER RECAPN,PTURNN,PSHAREN,IDLEN,NOWORKN,FLPN,BLPN %INTEGER NEWPAGEN,PAGEOUTN,PAGEZN,SNOOZN,ABORTN %INTEGER SNOOZOK,SNOOZTO,SNOOZAB %FINISH %LONGINTEGER L,STKPSTE %STRING(3) STRPROC !----------------------------------------------------------------------- ! CONFIGURATION DECLARATIONS %BYTEINTEGERARRAYNAME CONTYPE %BYTEINTEGERARRAYFORMAT CONTYPEF(0:31) CONTYPE==ARRAY(COM_CONTYPEA,CONTYPEF) %INTEGERARRAYNAME BLOCKAD %INTEGERARRAYFORMAT BLOCKADF(0:63) BLOCKAD==ARRAY(COM_BLKADDR,BLOCKADF) !----------------------------------------------------------------------- %RECORDFORMAT SSNP1F(%INTEGER LNB,PSR,PC,SSR,SF,IT,IC,CTB,XNB,%C B,DR0,DR1,A0,A1,A2,A3,PEAD,II) %RECORDFORMAT ISTF(%INTEGER LNB,PSR,PC,SSR,SF,IT,IC,CTB) %RECORD LSSNP1I,LSSNP1,ISTDUM(ISTF) %RECORDNAME LSSNP1P(ISTF) %RECORD GSSNP1(ISTF) %OWNLONGINTEGERARRAYFORMAT PSTF(0:319); ! PUBLIC SEGMENT TABLE FORMAT %LONGINTEGERARRAYNAME PST %INTEGERARRAYFORMAT PTF(0:255); ! PAGE TABLE FORMAT !----------------------------------------------------------------------- ! STORE TABLE ETC. DECLARATIONS %RECORDFORMAT STOREF(%BYTEINTEGER FLAGS,USERS, %C %HALFINTEGER LINK,BLINK,FLINK,%INTEGER REALAD) %RECORDARRAY STORE(0:COM_SEPGS-1)(STOREF); ! ONE RECORD PER EPAGE %CONSTINTEGER STOREFSIZE=12; ! SIZE OF ELEMENT OF STORE ARRAY %INTEGERNAME STORESEMA %INTEGER SPSTOREX; ! FOR KEEPING EMERGENCY SPARE PAGE !----------------------------------------------------------------------- ! ACTIVE MEMORY TABLE DECLARATIONS %CONSTINTEGER MIN RESIDENCES=3,MAXRESIDENCES=15;! FOR AMT TIMEOUTS %OWNINTEGER RESIDENCES=MAXRESIDENCES; ! ADJUSTED DOWN AS DRUM FILLS %CONSTINTEGER AMTASEG=21 %CONSTINTEGER MAXAMTAK=MAXPROCS//2//EPAGESIZE*EPAGESIZE %RECORDFORMAT AMTF(%INTEGER DA,%HALFINTEGER DDP,USERS,LINK, %C %BYTEINTEGER LEN,OUTS) ! DA : DISC ADDRESS ! DDP : AMTDD POINTER ! LINK : COLLISION LINK ! USERS : NO OF USERS OF THIS BLOCK ! LEN : BLOCK LENGTH IN EPAGES ! OUTS : NO OF PAGE-OUTS OF ! PAGES IN THIS BLOCK IN PROGRESS %CONSTINTEGER AMTFLEN=12 %RECORDARRAYFORMAT AMTAF(0:MAXAMTAK<<10//AMTFLEN)(AMTF) %RECORDARRAYNAME AMTA(AMTF) %CONSTINTEGER AMTDDSEG=22 %CONSTINTEGER MAXAMTDDK=MAXPROCS//EPAGESIZE*EPAGESIZE %CONSTINTEGER DDFLEN=2 %HALFINTEGERARRAYFORMAT AMTDDF(0:MAXAMTDDK<<10//DDFLEN) %HALFINTEGERARRAYNAME AMTDD; ! EACH %HALF : NEW EPAGE(1) / ! STOREX-DRUMTX(1) / INDEX(14) %CONSTINTEGER MAXBLOCK=32; ! MAX BLOCK SIZE %IF SFCFITTED=YES %THEN %START DRUMSIZE=COM_SFCK//EPAGESIZE %HALFINTEGERARRAY DRUMT(0:DRUMSIZE) ! SPARE(2) / STOREX(14) %FINISH %CONSTINTEGER DTEND=X'FFFF' %CONSTINTEGER NEWEPBIT=X'8000' %CONSTINTEGER DTXBIT=X'4000' %CONSTINTEGER STXMASK=X'3FFF' %CONSTINTEGER DDBIT=X'8000' !----------------------------------------------------------------------- ! SCHEDULING CATEGORY TABLES %RECORDFORMAT CATTABF(%BYTEINTEGER PRIORITY,EPLIM,RTLIM,MOREP,MORET, %C LESSP,SP0,SUSP,RQTS1,RQTS2,STROBEI,SP2) %OWNINTEGER MAXCAT MAXCAT=INTEGER(COM_CATTAD) %RECORDARRAYFORMAT CATTABAF(0:MAXCAT)(CATTABF) %RECORDARRAYNAME CATTAB(CATTABF) CATTAB==ARRAY(COM_CATTAD+4,CATTABAF) %OWNINTEGER MAXEPAGES MAXEPAGES=CATTAB(MAXCAT-1)_EPLIM %IF MONLEVEL&8#0 %THEN %START %HALFINTEGERARRAY FLYCAT,CATREC(0:MAXCAT,0:MAXCAT) %FINISH %IF MONLEVEL&16#0 %THEN %START %INTEGERARRAY STROBEN,STREPN,STROUT(0:MAXCAT) %FINISH !----------------------------------------------------------------------- ! PON & POFF ETC. DECLARATIONS %EXTERNALROUTINESPEC PON(%RECORDNAME P) %EXTERNALROUTINESPEC DPON(%RECORDNAME P,%INTEGER DELAY) %EXTERNALINTEGERFNSPEC NEWPPCELL !%EXTERNALROUTINESPEC RETURN PPCELL(%INTEGER PPCELL) %IF MULTIOCP=YES %THEN %START %EXTERNALROUTINESPEC SEMALOOP(%INTEGERNAME SEMA) %EXTERNALROUTINESPEC RESERVE LOG %EXTERNALROUTINESPEC RELEASE LOG %FINISH %EXTERNALROUTINESPEC SUPPOFF(%RECORDNAME SERV,P) %EXTERNALROUTINESPEC INHIBIT(%INTEGER SERVICE) %EXTERNALROUTINESPEC UNINHIBIT(%INTEGER SERVICE) %EXTERNALROUTINESPEC PINH(%INTEGER PROCESS,MASK) %EXTERNALROUTINESPEC PUNINH(%INTEGER PROCESS,MASK) %EXTERNALROUTINESPEC CLEAR PARMS(%INTEGER SERVICE) %EXTERNALINTEGERFNSPEC PPINIT(%INTEGERFN NEW EPAGE) %INTEGERFNSPEC NEW EPAGE %RECORDFORMAT PARMXF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK) %RECORDARRAYFORMAT PARMSPF(0:4095)(PARMXF) %RECORDARRAYNAME PARM(PARMXF) %CONSTINTEGER LOCSN0=64 %CONSTINTEGER LOCSN1= LOCSN0+MAXPROCS COM_SYNC1DEST=LOCSN1 %CONSTINTEGER LOCSN2= LOCSN0+2*MAXPROCS COM_SYNC2DEST=LOCSN2 %CONSTINTEGER LOCSN3= LOCSN0+3*MAXPROCS COM_ASYNCDEST=LOCSN3 %CONSTINTEGER MAXSERV= LOCSN0+4*MAXPROCS %RECORDFORMAT SERVF(%INTEGER P,L) %EXTRINSICRECORDARRAY SERVA(0:MAXSERV)(SERVF);! 0 NOT USED %EXTRINSICINTEGER KERNELQ,RUNQ1,RUNQ2,MAINQSEMA %EXTERNALLONGINTEGER KMON KMON=COM_KMON !----------------------------------------------------------------------- ! SERVICE ROUTINE SPECS %ROUTINESPEC SCHEDULE(%RECORDNAME P) %ROUTINESPEC PAGETURN(%RECORDNAME P) %ROUTINESPEC GET EPAGE(%RECORDNAME P) %INTEGERFNSPEC QUICK EPAGE(%INTEGER ZEROED) %ROUTINESPEC RETURN EPAGE(%RECORDNAME P) %ROUTINESPEC DEADLOCK %ROUTINESPEC OVERALLOC CONTROL %ROUTINESPEC CONFIG CONTROL(%RECORDNAME P) %ROUTINESPEC ACTIVE MEM(%RECORDNAME P) %EXTERNALLONGINTEGERFNSPEC CLOCK %ROUTINESPEC UPDISP(%INTEGER PROCESS,OFFSET,%STRING(13) S) %EXTERNALROUTINESPEC ELAPSEDINT(%RECORDNAME P) %EXTERNALROUTINESPEC SEMAPHORE(%RECORDNAME P) %IF SSERIES=NO %THEN %START %EXTERNALROUTINESPEC DISC(%RECORDNAME P) %EXTERNALROUTINESPEC GPC(%RECORDNAME P) %FINISH %ELSE %START %EXTERNALROUTINESPEC DISC MINDER(%RECORDNAME P) %EXTERNALROUTINESPEC DCU(%RECORDNAME P) %FINISH %EXTERNALROUTINESPEC PDISC(%RECORDNAME P) %EXTERNALROUTINESPEC MOVE(%RECORDNAME P) %EXTERNALROUTINESPEC TAPE(%RECORDNAME P) %EXTERNALROUTINESPEC OPER(%RECORDNAME P) %EXTERNALROUTINESPEC PRINTER(%RECORDNAME P) %EXTERNALROUTINESPEC LP ADAPTOR(%RECORDNAME P) %EXTERNALROUTINESPEC CR ADAPTOR(%RECORDNAME P) %EXTERNALINTEGERFNSPEC SAFE IS READ(%INTEGER ISAD,%INTEGERNAME VAL) %EXTERNALINTEGERFNSPEC SAFE IS WRITE(%INTEGER ISAD,VAL) %IF CPFITTED=YES %THEN %START %EXTERNALROUTINESPEC CP ADAPTOR(%RECORDNAME P) %FINISH %IF MONLEVEL&256#0 %START %EXTERNALROUTINESPEC COMBINE(%RECORDNAME P) %EXTERNALROUTINESPEC HARVEST( %C %INTEGER EVENT, PROCESS, LEN, A, B, C, D, E) %EXTRINSICINTEGER TRACE EVENTS %EXTRINSICINTEGER TRACE PROCESS %EXTRINSICINTEGER TRACE %FINISH %EXTERNALROUTINESPEC COMMS CONTROL(%RECORDNAME P) %EXTERNALROUTINESPEC MK1FEADAPTOR(%RECORDNAME P) %EXTERNALROUTINESPEC COMREP(%RECORDNAME P) %EXTERNALROUTINESPEC BMREP(%RECORDNAME P) %EXTERNALROUTINESPEC SYSERR(%INTEGER STK,IP) !----------------------------------------------------------------------- ! TIMING INFORMATION DECS. %IF MONLEVEL&X'1C'#0 %THEN %START %ROUTINESPEC TIMEOUT(%RECORDNAME P) %ROUTINESPEC CLEAR TIME %FINISH %IF MONLEVEL&4#0 %THEN %START %LONGINTEGERARRAY SERVIT,SERVIC(0:LOCSN0+3) %INTEGERARRAY SERVN(0:LOCSN0+3) %FINISH !----------------------------------------------------------------------- ! PROCESS INORMATION ETC. %RECORDFORMAT PROCF(%STRING(6) USER, %C %BYTEINTEGER INCAR, CATEGORY, P4TOP4, RUNQ, ACTIVE, %C %INTEGER ACTW0, LSTAD, LAMTX, STACK, STATUS) %RECORDARRAY PROCA(0:MAXPROCS)(PROCF) ! 2**0 = HOLDS A SEMAPHORE ! 2**1 = ON A PAGE FAULT ! 2**2 = A BACKGROUND JOB ! 2**3 = DEALLOCATING AMT (&DRUM) ONLY ! 2**4 = AMT LOST ! 2**5 = HAD TIME ON FLY ! 2**6 = HAD EPAGES ON FLY ! 2**7 = SNOOZING ! 2**8 = LC STACK READ FAILURE ! 2**9 = STATE X(LC STK SNOOZED) ! REMAINDER UNUSED ! DUMP PROGRAM NEED TO HAVE ! DETAILS OF ANY CHANGES ! %CONSTINTEGER HADTONFLY=32,HADPONFLY=64,SNOOZED=128 %CONSTINTEGER LCSTFAIL=256,AMTLOST=16,STATEX=512 %CONSTINTEGER OPERSPACE=41*(6+MAXPROCS//3) %INTEGERARRAY PROC PICT(0:2+OPERSPACE>>2);! SPACE FOR PROCESS PICTURE PROC PICT(0)=OPERSPACE; ! FIRST WORD=LENGTH OF REM !----------------------------------------------------------------------- ! LOCAL CONTROLLER DECS ETC. %ROUTINESPEC LOCAL CONTROL %ROUTINESPEC GLOBAL CONTROL %OWNLONGINTEGERARRAYFORMAT LSTF(0:LSTLEN-1) %OWNINTEGER TIMESLICE=X'4000'; ! 131072 MICROSECS %OWNINTEGER OUT18CHARGE=X'800'; ! CHARGE FOR OUT116 =8 MILLESECS %OWNINTEGER OUT18INS; ! CHARGE *INS RATE %OWNINTEGER ALLOW PERI INTS=X'01800FFE';! CHANGED IN SCHEDULE ACT0 %EXTERNALINTEGERFNSPEC SYSTEMCALL !----------------------------------------------------------------------- I=SYSTEM CALL; ! TO INITIALISE "COM" FILE *STLN_OLDLNB ! ! CREATE LOCAL CONTROLLER CONTEXT ! LSSNP1I=0 LSSNP1I_LNB=LSTLEN*8+LSTKN*X'80'+(DIRCSEGL+1)+X'50' LSSNP1I_PSR=X'00140001' *JLK_ *LSS_%TOS *ST_I LSSNP1I_PC=I; ! TO CALL OF L-C AFTER ACTIVATE LSSNP1I_SSR=X'01800BFE' LSSNP1I_SF=LSTLEN*8+LSTKN*X'80'+(DIRCSEGL+1)+X'80' ! SF AT 12 WORDS AFTER LNB LSSNP1I_IT=MAXIT LSSNP1I_IC=MAXIT *LSS_(%LNB+5); ! PRESERVE DISPLAY PTR *ST_I LSSNP1I_CTB=I COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE ! ! SET UP CLOCK REGS ! I=COM_CLKZ *LB_I *LSS_13; ! INTERRUPT EVERY 2 SECS(APPROX) *ST_(0+%B); ! Z-REG %IF COM_TSLICE>0 %THEN TIMESLICE=COM_TSLICE//COM_ITINT OUT18CHARGE=TIMESLICE>>3; ! ONE EIGHTH OF TSLICE OUT18INS=OUT18CHARGE*COM_INSPERSEC*COM_ITINT//1000 ! ! FIND END OF KERNEL STACK ETC. ! PST==ARRAY(X'80040000',PSTF); ! PST SEG 8193(OCPPORT NEVER 1) PST(44)=0; PST(45)=0; ! CLEAR CHOPSUPE CODE GLA PST(46)=0; PST(47)=0; ! & STACK SEGMENTS FROM PST PST(13)=PST(5)-128; ! SSN FOR OCP PORT 2 PST(15)=PST(5)+128; ! SSN FOR OCP PORT 3 ! SET REAL ADDRESS INTO STORE ARRAY K=128//EPAGESIZE; ! EPAGESPERBLOCK %CYCLE I=0,1,COM_SEPGS-1 STORE(I)=0 J=I//K STORE(I)_REALAD=BLOCKAD(J)!(EPAGESIZE*(I-J*K))<<10 %REPEAT ! SET KERNEL STACK SEGMENT LIMIT ! INCLUDING PROTEM 8 K FOR EACH OCP ! STACK. THESE WILL BE REMOVED ! ONCE THE OCPS ARE ACTIVATED *STSF_J L=(J&X'3FFFF'+X'7F'+X'2000')>>7 %IF MULTIOCP=YES %THEN L=L+X'2000'>>7 I=PST(4)&X'0FFFFFF8'+L<<7 J=EPAGESIZE<<10 K=(I+J-1)//J*J; ! ALLIGN ON EPAGE PST(4)=PST(4)&X'FFFC007FFFFFFFFF'!(L-1)<<39 ! INITIALISE FREE PAGES ARRAY ! LEAVING BLOCK0 SMAC 1 FREE FOR P4S STKPSTE=PST(4)-X'200000000000' %IF MULTIOCP=YES %THEN STKPSTE=STKPSTE-X'200000000000' FSTASL=K//J J=FSTASL BSTASL=COM_SEPGS-1 %CYCLE I=FSTASL+1,1,BSTASL STORE(J)_FLINK=I %AND J=I %UNLESS %C STORE(I)_REALAD=X'400000' %AND COM_OCPTYPE>=4 %REPEAT STORE(BSTASL)_FLINK=0 ! ! REAL STORE X4000 TO X7FFF IS USED FOR PRINTER BUFFER EXCEPT FOR P3S ! THESE USE THIS AREA FOR MICROPROGRAM OVERLAYS AND HAVE PRINTER ! BUFFER AT THE TOP OF STORE. IF THE M-P FOR P3 IS LESS THAN 16K ! EXTRA CODE CAN BE PUT IN HERE TO ADD THE BALANCE OF THE SPACE ! TO THE FREE LIST ! FREEEPAGES=1 STORE(FSTASL)_BLINK=0 I=FSTASL; ! SET UP BACKWARD LINKS %UNTIL I=BSTASL %CYCLE J=I I=STORE(I)_FLINK STORE(I)_BLINK=J FREE EPAGES=FREE EPAGES+1 %REPEAT STORESEMA==STORE(0)_REALAD STORESEMA=-1 SPSTOREX=0 GETEPN=0 PREEMPTED=0; ! NO PROCESS PRE-EMPTED !----------------------------------------------------------------------- COM_STOREAAD=ADDR(STORE(0)) COM_PROCAAD=ADDR(PROCA(0)) %CYCLE I=0,1,MAXPROCS PROCA(I)=0 %REPEAT %IF SFC FITTED=YES %THEN COM_DRUMTAD=ADDR(DRUMT(0)) PARM==ARRAY(PPINIT(NEW EPAGE),PARMSPF) OVERALLOC=FREE EPAGES//4; ! 25% OVERALLOCATION MAX OVERALLOC=OVERALLOC SHAREDEPS=0 UNALLOCEPS=FREEEPAGES+OVERALLOC NPQ=0 IDLE=0 %BEGIN %RECORD P(PARMF) !----------------------------------------------------------------------- ! INITIALISE GPC, DRUM & DISC ROUTINES P_DEST=X'300002' %IF SSERIES=NO %THEN %START; ! ON P SERIES P_P1=COM_GPCA %FINISH %ELSE %START; ! ON S SERIES P_P1=COM_DCUA %FINISH P_P2=ADDR(PROC PICT(0)); ! SPACE FOR OPER PICTURE PON(P) P_DEST=X'370000' P_P1=EPAGESIZE P_P2=COMMS EPAGES; ! COMMSALLOC P_P3=ADDR(PARM(0)) PON(P) %IF SSERIES=NO %THEN %START; ! PSERIES INITIALISE DISC P_DEST=X'200000' PON(P) %FINISH %IF SFC FITTED=YES %AND DRUMSIZE>0 %THEN %START P_DEST=X'280000' P_P1=EPAGESIZE P_P2=COM_SFCA P_P3=ADDR(STORE(0)) P_P4=ADDR(PARM(0)) PON(P) %FINISH ! INITIALISE SCHEDULE & ACTIVEMEM INHIBIT(3); ! HOLD PON FOR DISC LABEL READS P_DEST=X'30000' PON(P); ! PONNED TO ALLOW DISC LABEL READING ! ! CLEAR TIMING ARRAY ETC. ! %IF MONLEVEL&4#0 %THEN CLEAR TIME P_DEST=X'A0001' P_SRCE=0 P_P1=X'B0000' P_P2=2 PON(P); ! KICK UPDATE TIME P_P1=X'360000' PON(P); ! KICK PRINTER P_P1=X'E0004' P_P2=10 PON(P); ! ACTIVE MEM P_P1=X'D0001' PON(P); ! KICK ERROR REPORTING P_P1=X'00100000' P_P2=600 PON(P); ! KICK OVERALLOC CNTRL EVERY 10 MIN %IF STRING(ADDR(COM_SUPVSN))1 %START P_DEST=X'110001'; P_P1=1<<16!COM_OCPPORT1 COM_NOCPS=1 PON(P); ! CONFIGURE IN 2ND OCP LATER %FINISH %END ! ! NOW ACTIVATE THIS OCP INTO GLOBAL CONTROLLER. ALSO REMOTE ACTIVATE ! OTHER OCP IF PRESENT. STACKS ARE PUBLIC 12 FOR PORT 2 AND 14 FOR PORT 3 ! I=2*COM_OCPPORT0+8; ! PST NO FOR LOCAL ACTIVATE K=I!!2; ! AND FOR REMOTE ACTIVATE GSSNP1=LSSNP1I *JLK_ *LSS_%TOS; *ST_J GSSNP1_PC=J GSSNP1_LNB=X'80000004'+I<<18 GSSNP1_SF=GSSNP1_LNB+X'20' GSSNP1_SSR=X'01800FFE' RECORD(X'80040000'+I<<18)<-GSSNP1;! CONTEXT FROM RECORD TO SSN+1 *STSF_J PST(I)=PST(4)&X'1FF000008FFFFF80'+X'1F8000000000'+ %C (J+128)&X'3FF80' %IF MULTIOCP=YES %THEN PST(K)=PST(I)+X'2000' *LSD_0; *SLSS_I; *USH_18; *OR_X'80000000' *LUH_0; *ST_%TOS; *ACT_%TOS GCCALL: *JLK_%TOS *STCT_(%LNB+5) GLOBAL CONTROL; ! DOES NOT RETURN !----------------------------------------------------------------------- LCCALL:*JLK_%TOS *STCT_(%LNB+5); ! DISPLAY PTR TO NEW STACK ! SO THAT THE LXN IN CALL SEQUENCE ! LINKS LOCAL TO GLOBAL CONTEXTS *STB_(%LNB+0); ! B HAS PROCESS NO IN IT PUTIN ! BY SCHEDULE AT CREATE ! AND IS PASSED ON BY THIS FRIG LOCAL CONTROL; ! INITIAL CALL(DOES NOT RETURN!) %ROUTINE GLOBAL CONTROL !%ROUTINESPEC UNQUEUE(%INTEGERNAME QUEUE,UNQUED SERVICE) %INTEGER I,J,K,PORT,SEIP,SELN,SESTK,KSERVICE,LSERVICE,TSERVICE, %C MY OCP PORT,HIS OCP PORT,IS DIAG,ISTAD,IT CORRN %LONGINTEGER WORK %IF MONLEVEL&4#0 %THEN %START %INTEGER IT,IC %FINISH %INTEGERNAME KIT; ! IT IN KERNEL CONTEXT %INTEGERNAME CURPROC; ! CURRENT PROCESS KEPT IN IST ! (LAST WRD) FOR DUMPS ETC %SWITCH CONROUT(0:3) %SWITCH SERVROUT(0:LOCSN0); ! KERNEL SERVICES %RECORDNAME PROC(PROCF); ! STATUS BITS SIGNIFY AS FOLLOWS %RECORDNAME KSERV,KSERVQ,LSERV,LSERVQ(SERVF) %RECORDNAME ISTP(ISTF) %INTEGERNAME RUNQ %CONSTINTEGER IC CORRN=20; ! INSTRNS NOT COUNTED IN IDLE %RECORD P(PARMF) ! ! FIND WHICH OCP THIS ACTIVATION IS USING AND SET RELEVANT IST ! *LSS_(3); *USH_-26 *AND_3; *ST_ MY OCP PORT %IF MULTIOCP=YES %THEN HIS OCP PORT=MY OCP PORT!!1 PST(4)=STKPSTE; ! SHORTEN OLD STACK *LSS_OLDLNB; *ST_(%LNB+0); ! FOR %MONITOR ISTAD=X'80000000'+MY OCP PORT<<18 ISTP==RECORD(ISTAD); ! IST BASE *STLN_I; ! USED TO FRIG %MONITOR LATER ISTP_LNB=I ISTP_PSR=X'00140001'; ! ACR=1, PRIV=1, PM=0, ACS=1 ISTP_PC=0 ISTP_SSR=X'01800FFE'; ! ONLY SYSERR *STSF_I ISTP_SF=I ISTP_IT=MAXIT ISTP_IC=MAXIT ISTP_CTB=0 RECORD(ISTAD+X'20')<-ISTP; ! EXTERNAL INTS RECORD(ISTAD+X'40')<-ISTP; ! M-P INTS RECORD(ISTAD+X'60')<-ISTP; ! PERIPHERAL INTS RECORD(ISTAD+X'120')<-ISTP; ! EXTRACODE(!) INTS RECORD(ISTAD+X'140')<-ISTP; ! EVEBT PENDING INTS LSSNP1P==RECORD(X'40000') ! ! MASK SYSERR& UNMASK OUT ON SYSERR. INTERRUPT ! ISTP_SSR=X'01800EFF' ISTP_SF=ISTP_SF+X'1000'; ! SET SYSTEM ERROR SF TO DISTANT PLACE ! ! INSERT PCS ! *LXN_ISTAD *JLK_; *LSS_%TOS; *ST_(%XNB+2) *JLK_; *LSS_%TOS; *ST_(%XNB+10) *JLK_; *LSS_%TOS; *ST_(%XNB+18) *JLK_; *LSS_%TOS; *ST_(%XNB+26) *JLK_; *LSS_%TOS; *ST_(%XNB+74) *JLK_; *LSS_%TOS; *ST_(%XNB+82) CURPROC==INTEGER(ISTAD+4*95); ! ONTO CTB FIELD FOR IC INT CURPROC=0 KSERVICE=0 IT CORRN=1+1024*IC CORRN//(COM_INSPERSEC*COM_ITINT) KIT==INTEGER(ISTP_SF&X'FFFC0000'+X'40014') %IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN %START ! OPEN PATHS FOR MP INT ETC ! SET PORT DEPENDENT PHOTO(P4S) %IF BASIC PTYPE<=3 %START *LSS_1; *ST_(X'6009'); ! BROADCAST SE *LSS_(X'600A') *AND_X'CC'; *ST_(X'600A'); ! PERMIT MP INTS & ACTIVATES *ST_IS DIAG %FINISH %ELSE %START *LSS_(X'4012'); *OR_X'300C'; *ST_(X'4012');! PERMIT MPINTS ! AND SE INTS FROM OCP PORTS *LSS_(X'4013'); *OR_X'8004'; *ST_(X'4013') *ST_IS DIAG %FINISH %IF MY OCP PORT#COM_OCPPORT0 %START;! IM NOT IPL PROCESSOR %IF BASIC PTYPE<=3 %THEN %START J=X'80'>>COM_SACPORT0 %IF COM_NSACS>1 %THEN J=J!X'80'>>COM_SACPORT1 J=J!!(-1) *LSS_(X'600A'); *AND_J; *ST_(X'600A') J=COM_OCPPORT0 *LSS_J; *ST_(X'600F');! OPEN ROUTE FOR RRTC *ST_IS DIAG %FINISH %ELSE %START %IF COM_OCPTYPE=4 %THEN J=COM_SACPORT0 %ELSE %C J=COM_OCPPORT0 J=J<<20 *LSS_(X'4013'); *OR_J; *ST_(X'4013') *ST_IS DIAG %FINISH %FINISH %FINISH !----------------------------------------------------------------------- ! TURN ON SLAVING WHICH HAS BEEN INHIBITED BY CHOPSUPE SLAVESONOFF(-1) !----------------------------------------------------------------------- ! SERVICE LOOPS KSERVE: ! KERNEL SERVICES %IF MONLEVEL&4#0 %THEN %START *LSS_X'FFFFFF'; ! SET IT & IC TO MAX. *ST_(5) *ST_(6) %FINISH *LSS_ALLOW PERI INTS; ! LET INTERRUPTS IN *ST_(3) *LSS_X'01800FFE' *ST_(3) %IF MULTIOCP=YES %THEN %START *INCT_(MAINQSEMA) *JCC_8, SEMALOOP(MAINQSEMA) MQGOT1: %FINISH KSKIP: ! TRY NEXT WITHOUT RECLAIMING SEMA %IF KSERVICE!KERNELQ=0 %THEN %START %IF CURPROC#0 %THEN %START ! PROC MAPPED AT LAST LSERVE %IF RUNQ1#0 %AND PREEMPTED=0 %AND PROC_RUNQ=2 %START PREEMPTED=CURPROC ! RUNQ==RUNQ1 *LD_RUNQ1 *J_; ! PREMPTED LOWPRIO FOR HIGHPRIO %FINISH KACT: ! ACTIVATE DIRECT KERNEL->USER %IF MULTIOCP=YES %THEN MAINQSEMA=-1 %IF MONLEVEL&4#0 %THEN %START %IF PROC_STATUS&4#0 %THEN BLPN=BLPN+1 %ELSE FLPN=FLPN+1 %FINISH *LXN_PROC+4 *ACT_(%XNB+3); ! REACTIVATE INTERRUPTED PROCESS %FINISH ! %IF RUNQ1#0 %THEN RUNQ==RUNQ1 %AND ->LSERVE *LSS_(RUNQ1); *JAF_4, %IF PREEMPTED#0 %START; ! RESUME PREMPTED PROCESS CURPROC=PREEMPTED LSERVICE=CURPROC+LOCSN0 LSERV==SERVA(LSERVICE) PREEMPTED=0 PROC==PROCA(CURPROC) ->KACT %FINISH ! %IF RUNQ2#0 %THEN RUNQ==RUNQ2 %AND ->LSERVE *LSS_(RUNQ2); *JAF_4, ! ! NO PROCESS NEEDS OCP. ENTER AND TIME THE IDLE LOOP ! WHICH IS DIFFERENT FOR MULTI OCPS WHERE OTHER OCP CAN GENERATE WORK ! %IF MULTIOCP=YES %THEN MAINQSEMA=-1 %IF MONLEVEL&4#0 %THEN %START %IF MPLEVEL+NPQIDLE0; ! IN CASE "EKS" SET %FINISH %ELSE %START; ! IDLE IN DUALS %IF SSERIES=NO %AND MY OCP PORT#COM_OCPPORT0 %START PORT=COM_SACPORT0 *LSS_X'01800FFE'; *ST_(3) J=X'44000000'!PORT<<20 *LB_J; *LSS_(0+%B); *ST_I *JAF_4, %IF COM_NSACS>1 %START PORT=COM_SACPORT1 J=X'44000000'!PORT<<20 *LB_J; *LSS_(0+%B); *ST_I *JAF_4, %FINISH *LSS_X'01800820'; *ST_(3) %FINISH *RRTC_0; *AND_255; *STUH_%B; *ST_%B; *ADB_2; ! RANDOM LOOP TIME IL0: *LSS_1 *IAD_1 *DEBJ_ *LSS_(5) *IRSB_MAXIT *IAD_IT CORRN; ! CORRECT FOR THESE INSTRNS *ST_I %IF MONLEVEL&4#0 %THEN %START %IF MPLEVEL+NPQKSERVE %FINISH %FINISH ! ! MAIN QUEUE SERVICING SECTION ! %IF KSERVICE=0 %THEN %START ! UNQUEUE(KERNELQ,KSERVICE) *LD_KERNELQ; *JLK_ *STB_KSERVICE KSERV==SERVA(KSERVICE) %FINISH I=KSERV_P&X'BFFFFFFF'; ! REMOVE EXECUTED BIT %IF I<=0 %THEN KSERV_P=I %AND KSERVICE=0 %AND ->KSKIP %IF KSERVICE>LOCSN1 %START; ! SUSPEND REPLY I=(KSERVICE-LOCSN0)&(MAXPROCS-1)+LOCSN1 SERVA(I)_P=SERVA(I)_P!X'80000000' I=I+(LOCSN2-LOCSN1) SERVA(I)_P=SERVA(I)_P!X'80000000' I=I+(LOCSN3-LOCSN2) SERVA(I)_P=SERVA(I)_P!X'80000000' %IF MULTIOCP=YES %THEN MAINQSEMA=-1 P_DEST=X'30007'; ! RESCHEDULE LOCAL CONTROLLER P_SRCE=0 P_P1=I-LOCSN3 SCHEDULE(P) TSERVICE=3 ->KTIMES %FINISH %IF MULTIOCP=YES %THEN MAINQSEMA=-1 SUPPOFF(KSERV,P) ->SERVROUT(KSERVICE) !----------------------------------------------------------------------- ! SERVICE ROUTINE CALLS SERVROUT(1): TIMESLICE=P_P1; ->KEXIT SERVROUT(2): DEADLOCK; ->KEXIT SERVROUT(3): SERVROUT(15): SCHEDULE(P); ->KEXIT SERVROUT(4): PAGETURN(P); ->KEXIT SERVROUT(5): GET EPAGE(P); ->KEXIT SERVROUT(6): RETURN EPAGE(P); ->KEXIT SERVROUT(7): SEMAPHORE(P); ->KEXIT SERVROUT(8): SERVROUT(14): ACTIVE MEM(P); ->KEXIT SERVROUT(9): ! ONLY FOR MONITORING %IF MONLEVEL&4#0 %THEN TIMEOUT(P); ->KEXIT SERVROUT(10): ELAPSEDINT(P); ->KEXIT SERVROUT(11): UPDATE TIME; ->KEXIT SERVROUT(12): DPONPUTONQ(P); ->KEXIT SERVROUT(13): TURNONER(P); ->KEXIT SERVROUT(16): OVERALLOC CONTROL; ->KEXIT SERVROUT(17): CONFIG CONTROL(P); ->KEXIT SERVROUT(18):SERVROUT(19):SERVROUT(20):SERVROUT(21): SERVROUT(22):SERVROUT(23):SERVROUT(24):SERVROUT(25):SERVROUT(26): SERVROUT(27):SERVROUT(28):SERVROUT(29):SERVROUT(30):SERVROUT(31): ->INVALID SERVROUT(32): %IF SSERIES=NO %THEN DISC(P) %ELSE DISC MINDER(P) ->KEXIT SERVROUT(33): PDISC(P); ->KEXIT SERVROUT(34):SERVROUT(35): ->INVALID SERVROUT(36):SERVROUT(37): MOVE(P); ->KEXIT SERVROUT(38):SERVROUT(39): ->INVALID SERVROUT(40): %IF SFC FITTED=YES %THEN DRUM(P) %AND ->KEXIT %ELSE ->INVALID SERVROUT(41): SERVROUT(42):SERVROUT(43):SERVROUT(44):SERVROUT(45):SERVROUT(46): SERVROUT(47):->INVALID SERVROUT(48): %IF SSERIES=NO %THEN GPC(P) %ELSE DCU(P); ->KEXIT SERVROUT(49): TAPE(P); ->KEXIT SERVROUT(50): OPER(P); ->KEXIT SERVROUT(51): LP ADAPTOR(P); ->KEXIT SERVROUT(52): CR ADAPTOR(P); ->KEXIT SERVROUT(53): %IF CPFITTED=YES %THEN CP ADAPTOR(P) %AND ->KEXIT %ELSE ->INVALID SERVROUT(54): PRINTER(P); ->KEXIT SERVROUT(55): COMMS CONTROL(P); ->KEXIT SERVROUT(56): %IF MONLEVEL&256#0 %START COMBINE(P); ->KEXIT %FINISH %ELSE -> INVALID SERVROUT(57): MK1FEADAPTOR(P); ->KEXIT SERVROUT(58):SERVROUT(59):SERVROUT(60):->INVALID SERVROUT(61): BMREP(P); ->KEXIT SERVROUT(62): COMREP(P); ->KEXIT SERVROUT(63): ! DELAYED RELAY I=P_DEST&X'FFFF'; ! THE DELAY P_DEST=P_P6 DPON(P,I) ->KEXIT SERVROUT(64):SERVROUT(0): ->INVALID !----------------------------------------------------------------------- KEXIT: %IF MONLEVEL&4#0 %THEN TSERVICE=KSERVICE KTIMES: ! RECORD SERVICE ROUTINE TIMES %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *IRSB_MAXIT; *IAD_IC CORRN; *ST_IC *LSS_(5); *IRSB_MAXIT; *IAD_IT CORRN; *ST_IT SERVIT(TSERVICE)=IT+SERVIT(TSERVICE) SERVIC(TSERVICE)=IC+SERVIC(TSERVICE) SERVN(TSERVICE)=SERVN(TSERVICE)+1 %FINISH ->KSERVE !----------------------------------------------------------------------- INVALID: ! INVALID SERVICE CALLED PKMONREC("INVALID POFF:",P) ->KSERVE !----------------------------------------------------------------------- LSERVE: ! LOCAL CONTROLLER SERVICES *STD_RUNQ; ! COMPLETE MAPPING OF RUNQ ! UNQUEUE(RUNQ,LSERVICE) *JLK_; *STB_LSERVICE LSERV==SERVA(LSERVICE) I=LSERV_P&X'BFFFFFFF'; ! WITHOUT "EXECUTING" BIT %IF I<=0 %THEN LSERV_P=I %AND ->KSKIP;! INHIBITED ! CAN L-C EVER BE INHIBITED?? %IF MULTIOCP=YES %THEN MAINQSEMA=-1 CURPROC=LSERVICE-LOCSN0 PROC==PROCA(CURPROC) %IF MONLEVEL&4#0 %THEN %START LCN=LCN+1 *LSS_(6); *IRSB_MAXIT; *LUH_0; *IAD_LCIC; *ST_LCIC *LSS_(5); *IRSB_MAXIT; *LUH_0; *IAD_LCIT; *ST_LCIT %FINISH ! ! TO ACTIVATE TO LOCAL CONTROLLER USE THE ACTIVATE WORDS IN THE PROCESS ! LIST BUT SUBSTITUTE LC STACK NO(0) FOR PROCESS STACK NO ! *LXN_PROC+4 *LSD_(%XNB+3) *SLSD_0; ! LC STACK NO NOT PARAMETERISED ! *ST_%TOS *ACT_%TOS !----------------------------------------------------------------------- ! EVENT PENDING (USED TO EXIT FROM LOCAL CONTROLLER) IST11I: *JLK_%TOS ! LOCAL CONTROL RETURNS TO HERE CURPROC=0 %IF MULTIOCP=YES %THEN %START *INCT_(MAINQSEMA) *JCC_8, SEMALOOP(MAINQSEMA) MQGOT2: %FINISH LSERV_P=LSERV_P&X'BFFFFFFF'; ! REMOVE "EXECUTING" BIT ! ! IF THE PROCESS IS NOT SUSPENDED THERE WILL BE MORE PARAMETERS FOR IT ! AND IT MUST BE REQUEUED. NOTE THAT THE PROCESS MAY HAVE CHANGED ! ITS RUNQ BY TRANSITIONS MADE ON THE FLY! ! %IF LSERV_P>0 %THEN %START %IF PROC_RUNQ=1 %THEN RUNQ==RUNQ1 %ELSE RUNQ==RUNQ2 %IF RUNQ=0 %THEN LSERV_L=LSERVICE %ELSE %START LSERVQ==SERVA(RUNQ) LSERV_L=LSERVQ_L LSERVQ_L=LSERVICE %FINISH RUNQ=LSERVICE %UNLESS PROC_STATUS&3#0 %AND RUNQ#0 %FINISH %IF MULTIOCP=YES %THEN MAINQSEMA=-1 ->KSERVE !----------------------------------------------------------------------- ! INTERRUPT ENTRY POINTS IST1I: *JLK_%TOS; ! ENTRY IS LINK PC I.E. NEXT INSTR ! SYSTEM ERROR INTS ENTER HERE *LSS_%TOS; *ST_SESTK *LSS_%TOS; *ST_SEIP *LSS_(%LNB+8); *ST_SELN; ! OLD LINE NUMBER SYSERR(SESTK,SEIP); ! DOES NOT RETURN ->KSERVE; ! EXCEPT IN S SERIES !!! !----------------------------------------------------------------------- IST2I:*JLK_%TOS ! EXTERNAL INTS (CLOCK) ENTER HERE *LSS_%TOS ; *ST_I *LSS_%TOS ; *ST_J %IF MONLEVEL&4#0 %AND IDLE#0 %THEN %START %IF MPLEVEL+NPQKSERVE %ELSE %START ELAPSEDINT(P) %IF MONLEVEL&4#0 %THEN TSERVICE=10 ->KTIMES %FINISH !----------------------------------------------------------------------- ! MULTIPROCESSOR IST3I:*JLK_%TOS %IF MULTIOCP=YES %THEN %START *LSS_%TOS; *LSS_%TOS; *USH_-20 *AND_15; *ST_I; ! INTERRUPTING PORT ! ! A MULTIOCP INT MEANS THAT THE OTHER OCP IS DOWN (EVEN THO' THE ! INT MAY HAVE COME FROM SELF). STEP1 IS TO READ AND CLEAR THE INT AND ! MASK OUT ANY FURTHER COMMUNICATION FRON THE DEAD OCP. ! %IF BASIC PTYPE<=3 %START *LSS_(X'6303'); ! CLEAR & DISCARD *LSS_(X'600A'); *OR_X'33' *ST_(X'600A') *LSS_0; *ST_(X'6009'); ! DONT BROADCAST SE INTS %FINISH %ELSE %START %IF I=MY OCP PORT %START; ! MP INT FROM SELF *LSS_(X'4012'); *AND_X'FFFFFDFF' *ST_(X'4012') %FINISH %ELSE %START J=X'42000006'!I<<20 *LB_J; *LSS_6; *ST_(0+%B) %FINISH *LSS_(X'4013'); *AND_X'FFFF7FFB' *ST_(X'4013'); ! REMOVE MULT AND DD %FINISH ! ! IF REMAINING OCP IS NOT THE IPL OCP THEN SAC &CLOCK INT PATHS ! MUST BE OPENED UP. ALSO IF CLOCK IN OCP THEN SPARE CLOCK IN ! THIS OCP MUST BE SET UP ! %IF COM_OCP PORT0#MY OCP PORT %START I=X'8'>>COM_SACPORT0 %IF COM_NSACS>1 %THEN I=I!(X'8'>>COM_SACPORT1) %IF BASIC PTYPE<=3 %START J=(I!I<<4)!!(-1) *LSS_(X'600A'); *AND_J; *ST_(X'600A') %FINISH %ELSE %START J=I<<12!I<<2 *LSS_(X'4012'); *OR_J; *ST_(X'4012') %FINISH %IF 5<=COM_OCPTYPE<=6 %START;! 2972&76 CHANGE PORT IN CLOCK IS REGS K=MY OCP PORT<<20 COM_CLKX=COM_CLKX&X'FF0FFFFF'!K COM_CLKY=COM_CLKY&X'FF0FFFFF'!K COM_CLKZ=COM_CLKZ&X'FF0FFFFF'!K K=X'80000000'>>MY OCP PORT *LSS_(X'4012'); *OR_K; *ST_(X'4012');! OPEN CLOCK INT PATH K=MY OCP PORT<<20 *LSS_(X'4013'); *AND_X'FFFFF'; *OR_K; *ST_(X'4013') %FINISH ! ! EXCEPT FOR 2980(WHICH HAS CLOCK IN SAC)SET & START CLOCK IN THIS OCP ! %IF COM_OCPTYPE#4 %START WORK=LENGTHENI(COM_TOJDAY)*86400+(COM_SECSFRMN+2) WORK=WORK*1000000 *LSD_WORK; *USH_-1; *STUH_%B; *ST_J K=COM_CLKX *LB_K; *LSS_WORK; *ST_(0+%B) K=COM_CLKY *LB_K; *LSS_J; *ST_(0+%B) K=COM_CLKZ *LB_K; *LSS_13; *ST_(0+%B) %FINISH %ELSE %START; ! 2980 I=X'80000000'>>COM_SACPORT0 *LSS_(X'4012'); *OR_I; *ST_(X'4012') %FINISH %IF BASIC PTYPE<=3 %START *LSS_MY OCP PORT; *ST_(X'600F') %FINISH %FINISH ! ! FREE UP ANY BUSY KERNEL SERVICE. THESE MUST BE DUE TO HIM ! SINCE MPINT IS MASKED DURING KERNEL ! %CYCLE I=1,1,LOCSN0 %IF SERVA(I)_P&X'40000000'#0 %THEN %C SERVA(I)_P=SERVA(I)_P!!X'40000000' %C %AND UNINHIBIT(I) %REPEAT ! ! FREE UP EXECUTING PROCESS ON OTHER OCP IF RELEVANT ! J=X'8000017C'+HIS OCP PORT<<18 I=INTEGER(J); INTEGER(J)=0; ! NO CURRENT PROC ON DEAD OCP %IF I#0 %THEN %START OPMESS(PROCA(I)_USER." CRASHES OCP") I=I+LOCSN0 SERVA(I)_P=SERVA(I)_P&X'BFFFFFFF' UNINHIBIT(I) P_DEST=I<<16!4; ! CATASTROPHIC HW ERROR PON(P) %FINISH P_DEST=X'110002'; P_P1=1<<16!HIS OCP PORT CONFIG CONTROL(P); ! FINISH CONFIGURING OFF HIM ->KSERVE %FINISH *IDLE_X'F3' !----------------------------------------------------------------------- IST4I:*JLK_%TOS ! PERIPHERAL INTS ENTER HERE *LSS_%TOS; ! OLD STACK *LSS_%TOS; ! PARAMETER = SAC NUMBER<<20 *ST_I %IF MONLEVEL&4#0 %AND IDLE#0 %THEN %START %IF MPLEVEL+NPQ>24 %START OPMESS("INT FROM DCU ".STRINT(I>>24)." ??") ->KSERVE %FINISH P_DEST=X'300003' P_P1=I DCU(P) TSERVICE=58 ->KTIMES %FINISH %ELSE %START; ! FOR P SERIES PORT=I>>20&3 I=X'44000000'!PORT<<20 ;! IMAGE STORE ADDR FOR TRUNK FLAGS *LB_I *LSS_(0+%B) *JAT_4,; ! NO TRUNK FLAGS *ST_I PROCESS INT: K=0 %CYCLE *LSS_I *SHZ_J *USH_1 *ST_I P_SRCE=0 J=J+K P_P1=PORT<<4!J ->CONROUT(CONTYPE(P_P1)) %IF P_P1<=31 CONROUT(1): %IF SFC FITTED=YES %THEN %START P_DEST=X'280003' DRUM(P) %IF MONLEVEL&4#0 %THEN TSERVICE=42 ->CONTINUE %FINISH CONROUT(0): ! IN CASE OF SPURIOUS BITS %IF MONLEVEL&4#0 %THEN TSERVICE=1 ->CONTINUE CONROUT(2): P_DEST=X'200003' DISC(P) %IF MONLEVEL&4#0 %THEN TSERVICE=34 ->CONTINUE CONROUT(3): P_DEST=X'300003' P_SRCE=M'INT' GPC(P) %IF MONLEVEL&4#0 %THEN TSERVICE=58 CONTINUE: %IF I=0 %THEN ->KTIMES %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT *LSS_X'FFFFFF'; *ST_(5); *ST_(6) SERVN(TSERVICE)=SERVN(TSERVICE)+1 SERVIT(TSERVICE)=SERVIT(TSERVICE)+MAXIT-IT SERVIC(TSERVICE)=SERVIC(TSERVICE)+MAXIT-IC %FINISH K=J+1 %REPEAT %FINISH !----------------------------------------------------------------------- ! EXTRACODE IST10I:*JLK_%TOS ; *IDLE_X'FA' !----------------------------------------------------------------------- JLUNQ: ! JUMP&LINK VERSION OF ROUTINE UNQUEUE ! DR DESCRIBES QUEUE *LB_(%DR); *MYB_8; *ADB_SERVA+4 *LCT_%B; ! CTB TO SERVQ *LB_(%CTB+1); *STB_%TOS *MYB_8; *ADB_SERVA+4 *LXN_%B; ! XNB TO SERV *LSS_(%XNB+0); *OR_X'40000000'; *ST_(%XNB+0) *LB_%TOS; *CPB_(%DR); *JCC_7, *LSS_0; *ST_(%DR); *J_ JLUNQA: *LSS_(%XNB+1); *ST_(%CTB+1) JLUNQB: *LSS_0; *ST_(%XNB+1) *J_%TOS; ! SERVICE NO IN B !%ROUTINE UNQUEUE(%INTEGERNAME QUEUE,UNQUED SERVICE) !!*********************************************************************** !!* UNQUEUES A SERVICE FROM MAIN OR RUN QUEUES AND MARKS IT * !!* AS BEING EXECUTED * !!*********************************************************************** !%INTEGER SERVICE; ! LOCAL COPY OF UNQUED SERVICE !%RECORDNAME SERVQ(SERVF); ! MAPPED ON TO SERVICE AT BACK OF Q !%RECORDNAME SERV(SERVF); ! FOR UNQUED SERVICE ! SERVQ==SERVA(QUEUE); ! BACK OF Q. L POINTS TO FRNT ! SERVICE=SERVQ_L; ! SERVICE TO UNQUEUE ! SERV==SERVA(SERVICE) ! SERV_P=SERV_P!X'40000000'; ! MARK AS UNDER EXECUTION ! %IF SERVICE=QUEUE %THEN QUEUE=0 %ELSE SERVQ_L=SERV_L ! SERV_L=0 ! UNQUED SERVICE=SERVICE !%END %END; ! OF GLOBAL CONTROLLER %ROUTINE SCHEDULE(%RECORDNAME P) !*********************************************************************** !* ACTIVITY 0 : INITIALISE * !* ACTIVITY 1 : CREATE FOREGROUND PROCESS * !* ACTIVITY 2 : REPLY FROM CREATE PROCESS * !* ACTIVITY 3 : OUT OF EPAGES FROM LOCAL CONTROLLER * !* ACTIVITY 4 : OUT OF TIME SLICES FROM LOCAL CONTROLLER * !* ACTIVITY 5 : SUSPEND PROCESS * !* ACTIVITY 6 : TRY AND LOAD FURTHER PROCESS * !* ACTIVITY 7 : UNSUSPEND PROCESS * !* ACTIVITY 8 : DESTROY PROCESS * !* ACTIVITY 9 : REPLY FROM PAGE-IN OF LOCAL CONTROLLER STACK * !* ACTIVITY 10: MORE EPAGES ON THE FLY ? * !* ACTIVITY 11: MORE TIME ON THE FLY ? * !* ACTIVITY 12: MORE OF PARTIAL ALLOCATION REQUEST * !* ACTIVITY 13: PROCESS WAITING ON ALLOCATION * !* ACTIVITY 14: DEADLOCK RECOVERY * !* ACTIVITY 15: UPDATE OPER DIPLAY * !* ACTIVITY 16: CREATE BACKGROUND JOB * !* ACTIVITY 17: START OR RESTART DIRECT * !* ACTIVITY 18: SUSPEND ON FLY? * !*********************************************************************** %ROUTINESPEC PARE EPAGES %ROUTINESPEC ONPQ %IF SNOOZING=YES %THEN %START %ROUTINESPEC BOOT ON FLY %ROUTINESPEC OFF BOOTQ(%INTEGER PROC) %FINISH %RECORDSPEC P(PARMF) %CONSTINTEGER PRATMAX=255,PRIQS=5,FIRST UPROC=5 %CONSTBYTEINTEGERARRAY PRAT(0:PRATMAX)= %C 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2; %OWNINTEGER PRATP=0,SCHEDSEMA=-1,BOOTQH=0,SCHTICKS=0 !----------------------------------------------------------------------- ! PRIORITY QUEUE ARRAY ETC. %OWNBYTEINTEGERARRAY PQ(1:MAXPROCS)=0(MAXPROCS) %OWNBYTEINTEGERARRAY PQH(1:PRIQS)=0(PRIQS);! NUMBER OF PRIORITIES=PRIQS %OWNINTEGER P4PAGES,MAXP4PAGES,NPL4=0 %OWNBYTEINTEGERARRAY PQN(1:PRIQS)=0(PRIQS) %IF MONLEVEL&1#0 %THEN %START %OWNINTEGER SUSPN=0 %CONSTSTRING(2)%ARRAY STRPN(1:PRIQS)="P1","P2","P3","P4","P5" %FINISH %CONSTSTRING(16)%ARRAY STARTMESS(0:3)=" PROCESS CREATED", " : SYSTEM FULL"," : NO AMT"," : PROCESS RUNNG" %LONGINTEGERARRAYNAME LST %INTEGER SRCE,ACT,PROCESS,PTY,LSTAD,LSTVAD,LSTACKDA,DCODEDA,DSTACKDA,%C DGLADA,XEPS,OLDCATSLOT,NEWCATSLOT,INCAR,LCDDP,I,J,K,L,LCSTX %LONGINTEGER LIM %STRING(15) USER %STRING(2) PSTATE %RECORDNAME OLDCAT,NEWCAT(CATTABF) %RECORDNAME PROC(PROCF) %SWITCH ACTIVITY(0:18) %IF MONLEVEL&2#0 %AND KMON&1<<3#0 %THEN %C PKMONREC("SCHEDULE:",P) ACT=P_DEST&X'FFFF' PROCESS=P_P1 %IF 0 SEMALOOP(SCHEDSEMA) SSEMAGOT: %FINISH ->ACTIVITY(ACT) !----------------------------------------------------------------------- ACTIVITY(0): ! INITIALISE I=FREEEPAGES//2-LSTACKLEN %IF MAXEPAGES>I %THEN %START MAXEPAGES=I %CYCLE I=1,1,MAXCAT-2; ! DONT ADJUST TRASHING CAT %IF CATTAB(I)_EPLIM>MAXEPAGES %THEN %C CATTAB(I)_EPLIM=MAXEPAGES %REPEAT %FINISH MAXP4PAGES=P4PERCENT*COM_SEPGS//100 COM_USERS=0 MPLEVEL=0 PAGEFREES=0 DCLEARS=0 %CYCLE I=1,1,MAXPROCS-1 PROCA(I)=0 PINH(I,X'F'); ! INHIBIT LOCSN0&1&2&3 %REPEAT ! ! INITIALISE LEFT-HAND OPER SCREEN ! DISPLAY TEXT(0,0,0," EMAS 2900 SUP".SUPID) DISPLAY TEXT(0,0,22,STRING(ADDR(COM_DATE0)+3)) %CYCLE I=1,1,MAXPROCS-1 STRPROC=STRINT(I) UPDISP(I,3-LENGTH(STRPROC),STRPROC) %REPEAT %IF MONLEVEL&1#0 %THEN %START DISPLAY TEXT(0,2,0,"RQ1 RQ2 P1 P2 P3 P4 P5 SUSP STF") DISPLAY TEXT(0,3,0," 0 0 0 0 0 0 0 0 100") %IF SFCFITTED=NO %OR DRUMSIZE=0 %THEN %C DISPLAY TEXT(0,2,36,"OUTS") %FINISH P_DEST=X'80000' ACTIVE MEM(P) %IF SNOOZING=YES %OR MONLEVEL&1#0 %START P_DEST=X'A0001'; ! REGULAR CLOCK TICK P_SRCE=0 P_P1=X'F000F'; ! ON SCHED ALT SERVICE NO P_P2=5; ! AT 5 SEC INTERVALS PON(P); ! FOR VIFEO & BOOTING %FINISH ALLOW PERI INTS=X'01800824'; ! PERMITS INTS BETWEEN KERNEL ! SERVICES NOW INITIALISATION ! IS COMPLETED(XCEPT IT,IC&MP INTS) ! ! START "DIRECT" PROCESS TAKING CARE ITS INCARNATION IS 0 ! AND THAT ALL ITS TEMP SPACE IS IN X40 EPAGES(1 SEGMENT) ! ACTIVITY(17): ! FOR DIRECTOR RESTARTS P_DEST=X'30001' P_SRCE=0; ! NO REPLY WANTED P_P1=M'DIR'!6<<24 P_P2=M'ECT'<<8; ! ENSURE INCAR=0 P_P3=COM_SUPLVN<<24!X'400'; ! LSTACKDA(NEEDS 3 EPAGES ONLY) P_P4=0; ! USE DEFAULT DIRVSN P_P5=P_P3+LSTACKLEN; ! DSTACKDA(1SEG IN CBT BUT USES LESS) P_P6=P_P3+(X'40'-8); ! DGLADA (ALLOW LAST 8 PAGES) PON(P) %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 %RETURN !----------------------------------------------------------------------- ACTIVITY(16): ! CREATE BATCH JOB ACTIVITY(1): ! CREATE FORGROUND PROCESS ! P_P1/P2 : STRING(USER NAME) ! P_P3 : L-C STACK DISC ADDRESS ! P_P4 : DIRCODE DISC ADDRESS ! (<=0 FOR DEFAULT) ! P_P5 : DIR STACK DISC ADDRESS ! P_P6 : DIR GLA DISC ADDRESS SRCE=P_SRCE USER=STRING(ADDR(P_P1)) INCAR=BYTE INTEGER(ADDR(P_P2)+3) %IF COM_USERS>=MAXPROCS-1 %THEN P_P1=1 %AND ->STARTREP;! SYSTEM FULL PROCESS=0 %IF USER="DIRECT" %THEN PROCESS=1 %IF USER="SPOOLR" %THEN PROCESS=3 %IF USER="VOLUMS" %THEN PROCESS=2 %IF USER="MAILER" %THEN PROCESS=4 %IF PROCESS>0 %START PROC==PROCA(PROCESS) %IF PROC_USER#"" %THEN P_P1=3 %AND ->STARTREP %FINISH %ELSE %START %CYCLE PROCESS=FIRST UPROC,1,MAXPROCS-1 PROC==PROCA(PROCESS) %IF PROC_USER="" %THEN %EXIT %REPEAT %FINISH LSTACKDA=P_P3 %IF P_P4<=0 %THEN DCODEDA=COM_DCODEDA %ELSE DCODEDA=P_P4 DSTACKDA=P_P5 DGLADA=P_P6 P_DEST=X'80001'; ! GET AMTX FOR LOCAL CNTRLRL STACK P_SRCE=0 P_P1=0 P_P2=LSTACKDA P_P3=X'FFFF0000'!(LSTACKLEN-1); ! "NEW" EPAGES ACTIVE MEM(P) %IF P_P2<=0 %THEN P_P1=2 %AND ->STARTREP;! NO AMT PROC_LAMTX=P_P2 COM_USERS=COM_USERS+1 PROC_USER=USER PROC_STATUS=ACT>>2; ! SET 2**2 BIT FOR BATCH PROC_ACTW0=(LSTLEN-1)<<18 PROC_INCAR=INCAR PROC_ACTIVE=0 %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN+1 PROC_CATEGORY=0 %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 UPDISP(PROCESS,4,USER) %IF ACT=16 %THEN UPDISP(PROCESS,10,"*") CLEAR PARMS(PROCESS+LOCSN0) CLEAR PARMS(PROCESS+LOCSN1) CLEAR PARMS(PROCESS+LOCSN2) CLEAR PARMS(PROCESS+LOCSN3) ! PON TO INITIALIZE LOCAL CONTROLLER P_DEST=(PROCESS+LOCSN0)<<16 P_SRCE=X'30002' P_P1=PROCESS P_P2=DCODEDA P_P3=DGLADA P_P4=DSTACKDA PON(P); ! INHIBITED AS YET THOUGH ! REPLY TO START-UP P_P1=0; ! PROCESS CREATED SUCCESSFULLY P_P2=(PROCESS+LOCSN1)<<16 P_P3=(PROCESS+LOCSN2)<<16 P_P4=(PROCESS+LOCSN3)<<16!1; ! ASYNCH SNO FOR INPUT CONTROL MESS P_P5=PROCESS STARTREP: %IF SRCE<=0 %THEN OPMESS(USER.STARTMESS(P_P1)) %C %ELSE P_DEST=SRCE %AND P_SRCE=X'30001' %AND PON(P) %IF P_P1=0 %THEN %START P_DEST=X'30007'; ! LOAD SOME MORE P_P1=PROCESS PON(P) %FINISH %ELSE SCHEDSEMA=-1 %RETURN !----------------------------------------------------------------------- ACTIVITY(2): ! REPLY FROM CREATE PROCESS NEWCATSLOT=1+PROC_STATUS>>2&1; ! INITIAL CATEGORY =1 FORE =2BACKGROUND NEWCAT==CATTAB(NEWCATSLOT) PROC_CATEGORY=NEWCATSLOT ->STOUT !----------------------------------------------------------------------- ACTIVITY(3): ! OUT OF EPAGES NEWCATSLOT=OLDCAT_MOREP NEWCAT==CATTAB(NEWCATSLOT) PROC_CATEGORY=NEWCATSLOT ->STOUT !----------------------------------------------------------------------- ACTIVITY(10): ! MORE EPAGES ON THE FLY ? P_P1=0 NEWCATSLOT=OLDCAT_MOREP NEWCAT==CATTAB(NEWCATSLOT) XEPS=NEWCAT_EPLIM-OLDCAT_EPLIM %IF XEPS<=0 %THEN ->WAYOUT; ! ALREADY IN MAX CATEGORY %IF OLDCAT_PRIORITY<=2 %AND PROC_STATUS&HADPONFLY=0 %C %AND XEPSGIVE PAGES ->WAYOUT %IF XEPS>SHAREDEPS+UNALLOCEPS I=1; J=0; K=OLDCAT_PRIORITY; ! CHECK FOR HIGHER PRIORITY WK %IF K=5 %THEN K=4; ! QUEUES 4 & 5 EQIVALENT %WHILE IWAYOUT; ! NO: MORE URGENT WORK GIVE PAGES: ! WITHOUT BOUNCING PROC_STATUS=PROC_STATUS!HADPONFLY;! SO HE WONT DO IT AGAIN UNALLOCEPS=UNALLOCEPS-XEPS PROC_CATEGORY=NEWCATSLOT P_P1=NEWCAT_EPLIM CONT: P_P2=NEWCAT_RTLIM P_P3=NEWCAT_STROBEI; ! SO L-C CAN DECIDE TO STROBE %IF OLDCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES-OLDCAT_EPLIM %IF NEWCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES+NEWCAT_EPLIM %IF NEWCAT_PRIORITY=4=OLDCAT_PRIORITY %THEN %C PROC_P4TOP4<-PROC_P4TOP4+1 %IF MONLEVEL&8#0 %THEN %C FLYCAT(NEWCATSLOT,OLDCATSLOT)<-FLYCAT(NEWCATSLOT,OLDCATSLOT)+1 WAYOUT: %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 %RETURN !----------------------------------------------------------------------- ACTIVITY(4): ! OUT OF TIME NEWCATSLOT=OLDCAT_MORET PARE EPAGES ->STOUT !----------------------------------------------------------------------- ACTIVITY(11): ! MORE TIME ON THE FLY? ! BE KIND TO VOLUMS&SPOOLR P_P1=0 %IF P4PAGES>=MAXP4PAGES %AND OLDCAT_PRIORITY>=4 %AND %C PROCESS>=FIRST UPROC %THEN ->WAYOUT NEWCATSLOT=OLDCAT_MORET NEWCAT==CATTAB(NEWCATSLOT) %IF PROC_STATUS&HADTONFLY=0 %AND %C (OLDCAT_PRIORITY<=2 %OR PROCESSGIVE TIME I=1; J=0; K=NEWCAT_PRIORITY %IF K=4 %THEN K=5; ! QUEUES 4 & 5 EQUIVALENT HERE %WHILE I<=K %CYCLE J=J+PQN(I) I=I+1 %REPEAT %IF J#0 %AND PROCESS>=FIRST UPROC %THEN ->WAYOUT ! CANNOT ALLOW VOLS&SPOOLR MORE ! TIME IF SYSTEM IS CONFGRD ! SO ONLY 1 P4 CAN BE IN STORE %IF PROCESS0 %AND %C P4PAGES<=OLDCAT_EPLIM %THEN ->WAYOUT GIVE TIME: ! WITHOUT REQUEING PROC_STATUS=PROC_STATUS! HADTONFLY PARE EPAGES; ! AND MAP NEWCAT UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-NEWCAT_EPLIM P_P1=NEWCAT_EPLIM ->CONT !----------------------------------------------------------------------- ACTIVITY(18): ! SUSPEND ON FLY(IE WITHOUT ! PAGING WOKSET OUT)? %IF SNOOZING=YES %THEN %START %IF SHAREDEPS+UNALLOCEPSWAYOUT;! NO ! NEWCATSLOT=OLDCAT_SUSP %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN+1 %AND %C UPDISP(PROCESS,11,"Z ") I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS)) PUNINH(PROCESS,I) PROC_ACTIVE=0 PROC_STATUS=PROC_STATUS!SNOOZED PARE EPAGES UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-NEWCAT_EPLIM %IF MONLEVEL&8#0 %THEN FLYCAT(NEWCATSLOT,OLDCATSLOT) <- %C FLYCAT(NEWCATSLOT,OLDCATSLOT)+1 MPLEVEL=MPLEVEL-1 %IF OLDCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES-OLDCAT_EPLIM;! PEDANTIC ! P_P1=0; ! YES MAY SUSPEND ON FLY %IF BOOTQH=0 %THEN PQ(PROCESS)=PROCESS %C %ELSE PQ(PROCESS)=PQ(BOOTQH) %AND PQ(BOOTQH)=PROCESS BOOTQH=PROCESS %IF SHAREDEPS+UNALLOCEPSWAYOUT !---------------------------------------------------------------------- ACTIVITY(5): ! SUSPEND %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN+1 I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS)) PUNINH(PROCESS,I) PSTATE="S " %IF PROC_STATUS&AMT LOST=0 %AND %C 8*OLDCAT_PRIORITY*COM_USERS<=COM_SEPGS %C %THEN PROC_STATUS=PROC_STATUS!STATEX %AND PSTATE="X " %IF MONLEVEL&1#0 %THEN UPDISP(PROCESS,11,PSTATE) PROC_ACTIVE=0 %IF PROC_STATUS&8#0 %START; ! DELLOCATE AMT ONLY PROC_STATUS=PROC_STATUS!!8 PROC_ACTIVE=3; ! GUESS.2-5 POSSIBLE DEPENDING ! ON CURRENT DRUN LOADING %FINISH NEWCATSLOT=OLDCAT_SUSP PARE EPAGES %IF NEWCAT_PRIORITY<4 %AND PROCESS>=FIRST UPROC %AND %C PROC_STATUS&4=0 %THEN NPL4=NPL4+1 ->STOUT !----------------------------------------------------------------------- ACTIVITY(7): ! UNSUSPEND %IF PROC_ACTIVE=255 %THEN ->WAYOUT;! RACE CONDITION WITH BOOTONFLY %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN-1 %IF SNOOZING=YES %AND PROC_STATUS&SNOOZED#0 %START;! PROCESS IN STORE PROC_STATUS=PROC_STATUS!!SNOOZED MPLEVEL=MPLEVEL+1 SNOOZOK=SNOOZOK+1 %IF MONLEVEL&1#0 %THEN %C UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) P_DEST=(PROCESS+LOCSN0)<<16!3 P_SRCE=X'30000' P_P1=OLDCAT_EPLIM P_P2=OLDCAT_RTLIM %IF OLDCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES+OLDCAT_EPLIM PON(P) OFF BOOT Q(PROCESS) PROC_ACTIVE=255 %IF MONLEVEL&4#0 %THEN SNOOZN=SNOOZN+LSTACKLENP ->WAYOUT %FINISH PROC_ACTIVE=255 %IF OLDCAT_PRIORITY<4 %AND PROCESS>3 %AND PROC_STATUS&4=0 %THEN %C NPL4=NPL4-1 ONPQ ->LOAD !----------------------------------------------------------------------- ACTIVITY(8): ! DESTROY PROCESS MPLEVEL=MPLEVEL-1 DESTROY: UPDISP(PROCESS,4," ") COM_USERS=COM_USERS-1 PINH(PROCESS,X'F'); ! ALL PROCESS SERVICES %IF OLDCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES-OLDCAT_EPLIM P_DEST=X'40002'; ! PAGE-TURN OUT P_SRCE=X'30008' P_P2=0; ! REGARD AS NOT WRITTEN TO %CYCLE I=0,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I PON(P) %REPEAT P_DEST=X'80002'; ! RETURN AMTX FOR L-CNTRLR STACK P_P1=0; ! ID NOT USED P_P2=PROC_LAMTX P_P3=1; ! DESTROY FLAG PON(P) PROC=0 ->DEALL !----------------------------------------------------------------------- STOUT: ! PAGE-OUT LOCAL CONTROLLER STACK %IF NEWCAT_PRIORITY=4=OLDCAT_PRIORITY %THEN %C PROC_P4TOP4<-PROC_P4TOP4+1 %IF MONLEVEL&8#0 %THEN %C CATREC(NEWCATSLOT,OLDCATSLOT)<-CATREC(NEWCATSLOT,OLDCATSLOT)+1 ACTIVITY(14): ! DEADLOCK RECOVERY MPLEVEL=MPLEVEL-1 P_DEST=X'40002'; ! PAGETURN/PAGE-OUT P_SRCE=X'3008A' %IF PROC_STATUS&STATEX#0 %THEN I=LSTACKLENP %ELSE I=0 %CYCLE I=I,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I %IF I>=LSTACKLENP %THEN P_P2=2 %ELSE P_P2=X'D';! MAKE END "NEW" PON(P); ! NO REPLIES %REPEAT %IF OLDCAT_PRIORITY>=4 %THEN P4PAGES=P4PAGES-OLDCAT_EPLIM PROC_RUNQ=0 %UNLESS ACT=5 %THEN ONPQ; ! UNLESS SUSPENEDED DEALL: ! DEALLOCATE PROCESSES EPAGES UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM+LSTACKLEN !----------------------------------------------------------------------- ACTIVITY(6): ! MORE LOADS LOAD: ! LOAD FURTHER PROCESS(ES) ! ! TRY TO LOAD AS MANY WAITING ! PROCESSES AS POSSIBLE EXCEPT THAT ONLY "MAXP4PAGES" OF BIG JOBS ARE ! LOADED EXCEPT WHEN THERE ARE NO INTERACTIVE JOBS ASLEEP IN QUEUES 1-3 ! THIS COUNT IS MAINTAINED IN 'NP4L' ! %IF NPQ=0 %THEN ->WAYOUT AGN: %CYCLE PTY=PRAT(PRATP) %EXIT %IF PQH(PTY)#0 PRATP=(PRATP+1)&PRATMAX %REPEAT %IF PTY>=3 %AND PAGEFREES>=256 %START;! TOO MANY WRITEOUT PRATP=(PRATP+1)&PRATMAX; ! PASS OVER BIG JOB %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 P_DEST=X'A0002' P_P1=X'30006'; P_P2=1 PON(P); ! WAIT 1 SEC %RETURN %FINISH PROCESS=PQ(PQH(PTY)) PROC==PROCA(PROCESS) OLDCATSLOT=PROC_CATEGORY OLDCAT==CATTAB(OLDCATSLOT) ! ! THE IDEA OF THE NEXT FEW LINES IS TO RESTRICT P4 JOBS TO 1 OR TO ! P4PAGES OF STORE EXCEPT WHEN THERE ARE SO FEW FOREGROUND USERS ! ASLLEEP THAT THEY WILL NOT BE INCONVENINECED. ! %IF PTY>=4 %THEN %START %IF P4PAGES>0 %AND P4PAGES+OLDCAT_EPLIM>MAXP4PAGES %AND %C NPL4*MAXEPAGES>SHAREDEPS+UNALLOCEPS %START %IF NPQ>PQN(4)+PQN(5) %THEN %C PRATP=(PRATP-31)&PRATMAX %AND ->AGN ->WAYOUT %FINISH %FINISH I=OLDCAT_EPLIM+LSTACKLEN %IF I>SHAREDEPS+UNALLOCEPS %AND MPLEVEL>0 %THEN ->WAYOUT; ! NOT ENOUGH ROOM UNALLOCEPS=UNALLOCEPS-I PRATP=(PRATP+1)&PRATMAX; ! TO NEXT PRIORITY Q %IF PTY>=4 %THEN P4PAGES=P4PAGES+OLDCAT_EPLIM %IF PROCESS=PQH(PTY) %THEN PQH(PTY)=0 %C %ELSE PQ(PQH(PTY))=PQ(PROCESS) NPQ=NPQ-1 PQN(PTY)=PQN(PTY)-1 %IF SNOOZING=YES %AND BOOTQH#0 %AND %C SHAREDEPS+UNALLOCEPS=LSTACKLEN %START;! ROOM FOR ANOTHER? P_DEST=X'30006'; ! YES KICK OURSELVES AGAIN P_SRCE=P_DEST; ! SINCE THIS IS NOT COMMON AND PON(P); ! AND THIS SIMPLIFIES DUALS %FINISH %RETURN !----------------------------------------------------------------------- ACTIVITY(12): ! MORE OF PARTIAL ALLOCATION ? !----------------------------------------------------------------------- ACTIVITY(13): ! NOW WAITING FOR ALLOCATION MONITOR("SCHEDULE ACT12OR13?") !----------------------------------------------------------------------- ACTIVITY(9): ! L-C STACK PAGE ARRIVED I=P_P1&X'FF'; ! EPAGE NO PROCESS=P_P1>>8&X'FF' PROC==PROCA(PROCESS) PQ(PROCESS)=PQ(PROCESS)-1 %IF I=0 %THEN PROC_LSTAD=P_P2; ! REAL ADDR OF NEW LST %IF P_P3#0 %THEN PROC_STATUS=PROC_STATUS!LCSTFAIL;! FAIL FLAG ->WAYOUT %UNLESS PQ(PROCESS)=0; ! WAIT UNTIL ALL PAGES HERE OLDCATSLOT=PROC_CATEGORY OLDCAT==CATTAB(OLDCATSLOT) %IF PROC_STATUS&LCSTFAIL#0 %START;! FAILED TO READ L-C STACK ! THIS IS NOT RECOVERABLE AS ! PAGETURN WILL HAVE TRIED DRUM ! AND DISC. MUST DESTROY PROCESS PRINT STRING("LOCAL CONTROLLER STACK READ FAIL, PROCESS ".%C STRINT(PROCESS)) ->DESTROY %FINISH LSTAD=PROC_LSTAD LSTVAD=(SEG64+LSTAD)!PUBSEG LST==ARRAY(LSTVAD,LSTF) LIM=LSTACKLEN*EPAGESIZE-1 K=LSTAD+(LSTLEN*8+X'50') LST(0)=X'4150038080000001'!LIM<<42!K ! FILL IN PAGE TABLE ENTRIES ! BY DIGGING IN AMT AND STORE TABLES K=LSTVAD+(LSTLEN*8+X'50') LCDDP=AMTA(PROC_LAMTX)_DDP; ! DD POINTER FOR PAGE O OF LC %IF PROC_STATUS&STATEX#0 %THEN %START PROC_STATUS=PROC_STATUS!!STATEX %IF MONLEVEL&4#0 %THEN SNOOZN=SNOOZN+LSTACKLENP I=LSTACKLENP %FINISH %ELSE I=0 %CYCLE I=I,1,LSTACKLEN-1 LCSTX=AMTDD(LCDDP+I); ! DRUM OR STORE POINTER ! NB PAGE MUST BE INCORE ! NOT ALL CASES NEED TO BE TESTED %IF SFCFITTED=YES %AND LCSTX&DTXBIT#0 %THEN %C LCSTX=DRUMT(LCSTX&STXMASK) L=X'80000001'!STORE(LCSTX)_REALAD %CYCLE J=0,1,EPAGESIZE-1 INTEGER(K+4*EPAGESIZE*I+J<<2)=L+J<<10 %REPEAT %REPEAT LST(1)=X'00F0000080000001'!LCACR<<56!(LSTAD+LSTLEN*8) PROC_RUNQ=OLDCAT_RQTS1 %IF MONLEVEL&1#0 %THEN %C UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) MPLEVEL=MPLEVEL+1 %IF OLDCATSLOT=0 %THEN %START; ! PROCESS BEING CREATED ! LST ENTRIES >=2 ZERO ALREADY I=LSTVAD+8*LSTLEN; ! PUBLIC ADR OF LOCAL SEG 1 RECORD(I)<-LSSNP1I; ! COPY LOCAL CONTROLLER CONTEXT IN INTEGER(I+36)=PROCESS; ! PROCESS NO TO BREG & ! HENCE VIA FRIG TO LOCAL CONTRLR UNINHIBIT(PROCESS+LOCSN0); ! LET CREATE PON GO %FINISH %ELSE %START P_DEST=(PROCESS+LOCSN0)<<16!1; ! TO L-C : START NEW RESIDENCE P_SRCE=X'30000' P_P1=OLDCAT_EPLIM P_P2=OLDCAT_RTLIM ! ! IF THE PERSON HAS USED A LOT OF P4 TIME FROM THE TERMINAL PENALISE ! HIM BY GRADUALLY REDUCING HIS RESIDENCE TIMES. IF HE GETS TIME ON ! THE FLY THEN HE AND THE SYSTEM WILL NOT BE AFFECTED ! %IF PROCESS>=FIRST UPROC %AND OLDCAT_PRIORITY=4 %AND %C PROC_P4TOP4>16 %THEN P_P2=P_P2*(320-PROC_P4TOP4)//320 PON(P) %FINISH %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 %RETURN !----------------------------------------------------------------------- ACTIVITY(15): ! UPDATE OPER INFO(EVERY 5 SECS) SCHTICKS=SCHTICKS+1 %IF SNOOZING=YES %START %WHILE BOOTQH#0 %CYCLE I=PQ(BOOTQH); ! NEXT TO BE BOOTED J=PROCA(I)_ACTIVE; ! TIME SNOOZING IN 20 SEC TICKS %IF J<2 %THEN %EXIT BOOT ON FLY; ! FROM SNOOZING TO SLEEPING ! AT BETWEEN 20 & 40 SECS SNOOZTO=SNOOZTO+1 %REPEAT %FINISH %IF SCHTICKS&3=0 %START; ! @EVERY 20 SECS I=1; J=0 %UNTIL J=COM_USERS %OR I>MAXPROCS %CYCLE PROC==PROCA(I) %IF PROC_USER#"" %THEN %START %IF I>=FIRST UPROC %AND PROC_ACTIVE=3*MINSINACTIVE %C %AND PROC_STATUS&4=0 %THEN %START P_DEST=(I+LOCSN3)<<16+1 P_P1=-1; P_P2=-1 P_P3=X'01570000'; ! SEND INT W PON(P) %FINISH PROC_ACTIVE=PROC_ACTIVE+1 %UNLESS PROC_ACTIVE>200 J=J+1 %FINISH I=I+1 %REPEAT %FINISH %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 %IF MONLEVEL&1#0 %THEN %START %BEGIN %INTEGERARRAY RUNQ(0:2) %IF MONLEVEL&256 # 0 %START %INTEGER SNOOS, PGFLT SNOOS = 0; PGFLT = 0 %FINISH %CYCLE I=0,1,2 RUNQ(I)=0 %REPEAT J=0; I=1 %UNTIL J=COM_USERS %OR I>MAXPROCS %CYCLE PROC==PROCA(I) %IF PROC_USER#"" %THEN %START J=J+1 %IF PROC_ACTIVE=255 %THEN RUNQ(PROC_RUNQ)=RUNQ(PROC_RUNQ)+1 %IF MONLEVEL&256 # 0 %START %IF PROC_STATUS&SNOOZED#0 %THEN SNOOS = SNOOS+1 %IF PROC_STATUS&2 # 0 %THEN PGFLT = PGFLT+1 %FINISH %FINISH I=I+1 %REPEAT %CYCLE I=1,1,2 DISPLAY TEXT(0,3,I*4-3,STRINT(RUNQ(I))." ") %REPEAT %CYCLE I=1,1,5 DISPLAY TEXT(0,3,I*3+7,STRINT(PQN(I))." ") %REPEAT DISPLAY TEXT(0,3,27,STRINT(SUSPN)." ") I=100*FREE EPAGES//COM_SEPGS DISPLAY TEXT(0,3,31,STRINT(I)."% ") %IF SFCFITTED=NO %OR DRUMSIZE=0 %THEN %C DISPLAY TEXT(0,3,36,STRINT(PAGEFREES)." ") %IF MON LEVEL&256 # 0 %START; ! include harvesting? HARVEST(1,0,20,COM_USERS<<24!RUNQ(1)<<16!RUNQ(2)<<8!PGFLT,%C PQN(1)<<24!PQN(2)<<16!PQN(3)<<8!PQN(4), %C PQN(5)<<24!SUSPN<<16!SNOOS<<8, %C PAGEFREES<<16!UNALLOCEPS,FREEEPAGES<<16) %C %IF TRACE = YES %AND TRACE EVENTS&(1<<1) # 0 %FINISH %END %FINISH %RETURN !----------------------------------------------------------------------- %IF SNOOZING=YES %THEN %START %ROUTINE BOOT ON FLY !*********************************************************************** !* THROWS OUT ONE PERSON SUSPENDED ON FLY * !*********************************************************************** %INTEGER PROCESS %RECORD P(PARMF) %RECORDNAME PROC(PROCF) PROCESS=PQ(BOOTQH) %IF BOOTQH=PROCESS %THEN BOOTQH=0 %ELSE PQ(BOOTQH)=PQ(PROCESS) PQ(PROCESS)=0 PINH(PROCESS,X'E'); ! ALL EXCEPT L-CNTRLR PROC==PROCA(PROCESS) ! %IF PROC_STATUS&SNOOZED#0 %THEN MONITOR("BOOTING WHOM??") PROC_STATUS=PROC_STATUS&(\SNOOZED) PROC_ACTIVE=255 MPLEVEL=MPLEVEL+1 P_DEST=(PROCESS+LOCSN0)<<16!8 P_SRCE=X'30011' %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN-1 PON(P) %END %ROUTINE OFF BOOTQ(%INTEGER PROC) !*********************************************************************** !* PROC HAS WOKEN UP WHILE IN STORE. REMOVE FROM BOOT Q * !*********************************************************************** %INTEGER ONE,TWO,BACK,COUNT COUNT=0 ONE=BOOTQH; BACK=ONE TWO=PQ(ONE) %IF ONE=TWO %THEN %START %IF ONE=PROC %THEN PQ(PROC)=0 %AND BOOTQH=0 %AND %RETURN MONITOR("BOOT Q STATE??") %FINISH %CYCLE %IF TWO=PROC %THEN %EXIT ONE=TWO; TWO=PQ(ONE) COUNT=COUNT+1 ! %IF COUNT>=255 %THEN MONITOR("BOOT QUEUE ??") %REPEAT PQ(ONE)=PQ(TWO) %IF BACK=TWO %THEN BOOTQH=ONE PQ(PROC)=0 %END %FINISH %ROUTINE PARE EPAGES !*********************************************************************** !* CHAIN BACK DOWN CATEGORY TABLE TO FIND THE BEST FIT * !* AFTER ALLOWING SOME LEEWAY * !*********************************************************************** %CONSTINTEGER LEEWAY=2 %CYCLE NEWCAT==CATTAB(NEWCATSLOT) %IF NEWCAT_LESSP=0 %OR %C P_P2+LEEWAY>CATTAB(NEWCAT_LESSP)_EPLIM %THEN %C PROC_CATEGORY=NEWCATSLOT %AND %RETURN NEWCATSLOT=NEWCAT_LESSP %REPEAT %END !----------------------------------------------------------------------- %ROUTINE ONPQ !*********************************************************************** !* PUT PROCESS ONTO APPROPIATE PRIORITY QUEUE AS GIVEN IN THE * !* CATEGORY TABLE. NORMALLY PROCESSES GO TO THE BACK OF QUEUE BUT * !* THEY ARE HOLDING A SEMA THEY GO TO THE FRONT * !*********************************************************************** PTY=CATTAB(PROC_CATEGORY)_PRIORITY %IF PQH(PTY)=0 %THEN PQ(PROCESS)=PROCESS %ELSE %C PQ(PROCESS)=PQ(PQH(PTY)) %AND PQ(PQH(PTY))=PROCESS PQH(PTY)=PROCESS %UNLESS PROC_STATUS&1#0 %AND PQH(PTY)#0 NPQ=NPQ+1; ! COUNT PROCESSES QUEUED PQN(PTY)=PQN(PTY)+1 %IF MONLEVEL&1#0 %THEN UPDISP(PROCESS,11,STRPN(PTY)) %END %END !----------------------------------------------------------------------- %ROUTINE PAGETURN(%RECORDNAME P) !*********************************************************************** !* FOR ALL ACTS : P_P1=AMTX<<16!EPX * !* ACTIVITY 1 : "PAGE IN" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=RETURNABLE IDENTIFIER * !* ACTIVITY 2 : "PAGE OUT" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=FLAGS (BEING THE BOTTOM 4 BITS OF STOREFLAGS) * !* ACTIVITY 3 : REPLY FROM "EPAGE" WITH EPAGE P_P2=STOREX * !* ACTIVITY 4 : ZERO "NEW" DISC EPAGE * !* ACTIVITY 5 : REPLY FROM DISC/WRITE * !* ACTIVITY 6 : REPLY FROM DRUM/READ ON FAILURE ONLY * !* ACTIVITY 7 : REPLY FROM DRUM/WRITE * !* ACTIVITY 8 : REPLY FROM ZERO DISC EPAGE * !* STORE FLAGS SIGNIFY AS FOLLOWS : * !* BIT 7 : DISC TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) * !* BIT 6 : DISC INPUT(0)/OUTPUT(1) * !* BIT 5 : DRUM TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) * !* BIT 4 : DRUM INPUT(0)/OUTPUT(1) * !* BIT 3 : WRITTEN TO MARKER * !* BIT 2 : TYPE (0:DISC ONLY, 1:DISC & DRUM) * !* BIT 1 : MAKE NEW IE DONT PAGE OUT & SUPPLY ZEROPAGE ON REREAD * !* BIT 0 : RECAPTURABLE(IF ON FREE LIST ON PAGING OUT) * !*********************************************************************** %RECORDSPEC P(PARMF) %CONSTINTEGER ZEROPAGEAD=X'804C0000' %INTEGER AEX,AMTX,EPX,DDX,DTX,FLAGS,STOREX,SRCE,CALL,ID,I,B,F %IF MONLEVEL&4#0 %THEN %START %INTEGER IT,IC %FINISH %HALFINTEGERNAME AMTDDDDX %RECORDNAME AMT(AMTF) %RECORDNAME ST(STOREF) %RECORDNAME PP(PARMXF) %IF SFC FITTED=YES %THEN %START %RECORD TDRUM,TDISC(PARMF) %FINISH %ELSE %START %RECORD TDISC(PARMF) %FINISH %SWITCH ACTIVITY(0:8) %IF MONLEVEL&2#0 %AND KMON&1<<4#0 %THEN %C PKMONREC("PAGETURN:",P) ! AEX=P_P1 ! AMTX=AEX>>16 ! EPX=AEX&X'FFFF' *LCT_P+4; *LSS_(%CTB+2); *ST_AEX *LUH_0; *USH_16; *SHS_-16; *ST_AMTX ! AMT==AMTA(AMTX) *LB_AMTX; *MYB_AMTFLEN *LD_AMTA; *MODD_%B; *STD_AMT ! DDX=AMT_DDP+EPX *LDTB_X'58000002'; *LB_(%DR+4) *ADB_EPX; *STB_DDX; ! AMTDDDDX==AMTDD(DDX) *ADB_%B; *LD_AMTDD *INCA_%B; *STD_AMTDDDDX %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SSEMAGOT: %FINISH I=AMTDDDDX ! %IF SFCFITTED=NO %OR I&DTXBIT=0 %START;! NO DRUM PAGE ALLOCATED ! STOREX=I&STXMASK ! DTX=-1 ! %FINISH %ELSE %START ! DTX=I&STXMASK ! STOREX=DRUMT(DTX) ! %FINISH %IF SFC FITTED=YES %THEN %START *LSS_I; *AND_DTXBIT; *JAT_4, *LB_I; *SBB_DTXBIT; *STB_DTX *ADB_%B; *LSS_(DRUMT+%B) *ST_STOREX; *J_ MCL1: %FINISH *LSS_I *AND_STXMASK; *ST_STOREX *LSS_-1; *ST_DTX MCL2: ->ACTIVITY(P_DEST-X'40000') !----------------------------------------------------------------------- ACTIVITY(1): ! PAGE-IN (ALLOWS PAGETURN TO BE CALLED) %IF MONLEVEL&4#0 %THEN PTURNN=PTURNN+1 AMT_USERS=AMT_USERS+1 CALL=P_SRCE SRCE=CALL&X'7FFFFFFF' ID=P_P2 %IF STOREX=STXMASK %THEN ->FETCH PAGE HERE: ! EPAGE ALLOCATED ST==STORE(STOREX) ! ->NOTRECAP %UNLESS ST_FLAGS=1 %AND ST_USERS=0;! RECAPTURE ! ST_FLAGS=0 ! ST_USERS=1 ! ST_LINK=0 ! F=ST_FLINK ! B=ST_BLINK ! ST_BLINK=AMTX ! ST_FLINK=EPX *LCT_ST+4; *LSS_(%CTB+0) *USH_-16; *ICP_X'0100'; ! FLAGS=1 & USERS=0 *JCC_7, *LSS_(%CTB+1); *LUH_0 *USH_16; *SHS_-16; *ST_B; ! UNPACK&STORE BOTH LINKS *LSS_AEX; *LUH_X'00010000'; ! SET FLAGS,USERS&LINK IN ONE *ST_(%CTB+0) %IF B#0 %THEN STORE(B)_FLINK=F%ELSE FSTASL=F %IF F#0 %THEN STORE(F)_BLINK=B %ELSE BSTASL=B FREEEPAGES=FREEEPAGES-1 %IF FREEEPAGES=0 %THEN INHIBIT(5) %IF MONLEVEL&4#0 %THEN RECAPN=RECAPN+1 ->PAGEIN REPLY NOTRECAP: ! PAGE MUST BE SHARED %IF ST_USERS=0 %THEN %START; ! PAGE-OUT IN PROGRESS PAGEFREES=PAGEFREES-1 %FINISH %ELSE %START SHAREDEPS=SHAREDEPS+1 %FINISH ST_USERS=ST_USERS+1 %IF MONLEVEL&4#0 %THEN PSHAREN=PSHAREN+1;! PAGE SAVED BY SHARING ! IF PAGE IS COMING IN MUST AWAIT ! ITS ARRIVAL. USE PIT LIST %IF ST_FLAGS&X'C0'=X'80' %OR %C (SFCFITTED=YES %AND ST_FLAGS&X'30'=X'20') %START *JLK_ MUST WAIT: ! FOR FREE PAGE OR TRANSFER %IF MULTIOCP=YES %THEN STORESEMA=-1 P_DEST=0; ! IF CALLED MEANS PAGE COMING %RETURN %FINISH PAGEIN REPLY: ! INTACT COPY IN STORE IF ! RECAPTURED OR PAGING OUT:REPLY ! PAGE IMMEDIATELY AVAILABLE P_P1=ID; ! IDENTIFIER P_P2=ST_REALAD&X'0FFFFFFF'; ! MAY BE FLAWED(BIT SET IN TOP) P_P3=0; ! SUCCESS ! P_P5=ST_USERS ! P_P6=ST_FLAGS %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF CALL>0 %THEN P_DEST=SRCE %AND P_SRCE=X'40001' %AND PON(P) %RETURN FETCH PAGE: ! ALLOCATE EPAGE %IF AMTDDDDX&NEWEPBIT#0 %THEN I=0 %ELSE I=1;! CLEAR IF NEW %IF FREE EPAGES>0 %THEN STOREX=QUICK EPAGE(I) %AND ->ACT3 P_SRCE=X'40003' P_P1=AEX P_P2=I; ! =0 FOR ZEROED P_P5=SRCE P_P6=ID %IF LOCSN0>16<=LOCSN1 %THEN GET EPN=GET EPN+1 %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF PAGEFREES<=1 %AND GETEPN>=MPLEVEL+1-COM_NOCPS %THEN %C P_DEST=X'20000' %AND PON(P) P_DEST=X'50000' PON(P) P_DEST=0; ! IN CASE PAGETURNED CALLED %RETURN !----------------------------------------------------------------------- ACTIVITY(3): ! REPLY FROM GET EPAGE CALL=1; ! I.E. >0 SRCE=P_P5 ID=P_P6 ! ! THERE ARE TWO COMPLICATIONS WHICH MUST BE DEALT WITH BEFORE GOING ! ON TO SET UP THE TRANSFER. FIRSTLY WE MAY GET PAGE 0 MEANING THE SYSTEM ! HAS DEADLOCKED. PASS THIS BACK TO LOCAL CONTROLLER WITH SPECIAL FLAG ! MEANING "PLEASE DEPART AS FAST AS POSSIBLE". ! THE OTHER POSSIBILTY IS THAT MORE THAN ONE PROCESS HAS ASKED ! FOR THIS PAGE WHILE THE FIRST IS AWAITING STORE. CARE IS REQUIRED TO ! AVOID LOSING A PAGE IN THESE CIRCOMSTANCES ! %IF P_P2=0 %THEN %START; ! DEADLOCK PAGE ZERO P_DEST=SRCE!1; ! FAILED TO PRODUCE PAGE P_P3=-1; ! PLEASE DEPART ! AMT_USERS=AMT_USERS-1 %IF MULTIOCP=YES %THEN STORESEMA=-1 PON(P) %RETURN %FINISH %IF STOREX#STXMASK %THEN %START; ! PAGE HAS ARRIVED BEFORE P_DEST=X'60000'; ! RETURN EPAGE P_SRCE=X'80040003' PON(P) ->HERE %FINISH STOREX=P_P2 ACT3: ! ENTERS HERE IF PAGE AVAILABLE ST==STORE(STOREX) ! ST_USERS=1 ! ST_LINK=0 ! ST_BLINK=AMTX ! ST_FLINK=EPX *LCT_ST+4; *LSS_AEX *LUH_X'00010000'; *ST_(%CTB+0) %IF AMTDDDDX&NEWEPBIT#0 %THEN %START;! NEW EPAGE AMTDDDDX=STOREX; ! NOT "NEW" & NOT DRUM ST_FLAGS=8; ! "WRITTEN" %IF MONLEVEL&4#0 %THEN NEWPAGEN=NEWPAGEN+1 ->PAGEIN REPLY %FINISH ! ! IT IS NECESSARY TO TRANSFER THE PAGE IN FROM DRUM OR DISC ! %IF SFCFITTED=YES %AND DTX>=0 %START;! PAGE ON DRUM DRUMT(DTX)=STOREX *JLK_ ST_FLAGS=X'20'; ! DRUM->STORE TRANSIT FLAGS=X'20'; ! DRUM TRANSFER TO BE STARTED %IF MULTIOCP=YES %THEN STORESEMA=-1 TDRUM_DEST=X'280001' TDRUM_SRCE=X'80040006' TDRUM_P1=AEX TDRUM_P2=DTX TDRUM_P3=STOREX P_DEST=0; ! IN CASE CALLED ->TRANSFER NEEDED %FINISH ! NO DRUMS OR PAGE IS ON DISC *JLK_ DRUMRF: ! DRUM READ FAILURES REJOIN HERE AMTDDDDX=STOREX ST_FLAGS=X'80'; ! DISC->STORE TRANSIT FLAGS=X'80'; ! DISC TRANSFER NEEDED %IF MULTIOCP=YES %THEN STORESEMA=-1 TDISC_DEST=X'210005'; ! DIRECT REPLIES TO LC TDISC_SRCE=X'80040099' TDISC_P1=AEX TDISC_P2=AMT_DA+EPX ;! DISC ADDRESS TDISC_P3=STOREX P_DEST=0 ->TRANSFER NEEDED !----------------------------------------------------------------------- ACTIVITY(6): ! FAILURE REPLY FROM DRUM/READ %IF SFCFITTED=YES %THEN %START ST==STORE(STOREX) BAD DRUM PAGE(DTX); ! DISCARD DRUM PAGE ->DRUMRF; ! AND FETCH FROM DISC %FINISH !----------------------------------------------------------------------- ACTIVITY(2): ! PAGE-OUT ST==STORE(STOREX) AMT_USERS=AMT_USERS-1 ST_FLAGS=ST_FLAGS!P_P2; ! INSERT WRITTEN ETC. MARKERS ST_USERS=ST_USERS-1 %IF ST_USERS>0 %THEN %START SHAREDEPS=SHAREDEPS-1 %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN %FINISH PAGEFREES=PAGEFREES+1; ! PAGE ABOUT TO BECOME FREE %IF ST_FLAGS&X'A0'#0 %THEN ->MUST WAIT ! PREVIOUS WRITEOUTS STILL GOING PAGEOUT: ! ACTUALLY PAGE IT OUT FLAGS=0; ! NO TRANSFER SET UP YET ! ! FIRST UPDATE DISC COPY IF PAGE HAS BEEN UPDATED. THEN CONSIDER ! WHETHER TO UPDATE OR GENERATE A DRUM COPY ! %IF ST_FLAGS&X'0A'=8 %THEN %START;! \NEW&WRITTEN THEN WRITE TO DISC %IF MONLEVEL&4#0 %THEN PAGEOUTN=PAGEOUTN+1 ST_FLAGS=ST_FLAGS!X'C0'; ! DISC TRANSFER OUT BITS FLAGS=X'C0'; ! TRANSFER INITIATED AMT_OUTS=AMT_OUTS+1; ! AVOIDS AMT BEING DEALLOCATED TDISC_DEST=X'210006'; ! STORE->DISC TDISC_SRCE=X'80040005' TDISC_P1=AEX TDISC_P2=AMT_DA+EPX; ! DISC ADDR TDISC_P3=STOREX %FINISH %IF SFCFITTED=YES %THEN %START %IF ST_FLAGS&4=0 %START; ! NO DRUM UPDATE %IF DTX>=0 %THEN %START; ! RETURN DRUM PAGE(IF ANY) AMTDDDDX=STOREX DRUMT(DTX)=DRUMTASL DRUMTASL=DTX DRUMALLOC=DRUMALLOC-1 DTX=-1 %FINISH %FINISH %ELSE %START; ! DRUM UPDATE REQUIRED %IF DTX<0 %AND DRUMTASL#DTEND %START;! NOT ON DRUM YET DTX=DRUMTASL; ! GET DRUM PAGE DRUMTASL=DRUMT(DRUMTASL) DRUMALLOC=DRUMALLOC+1 AMTDDDDX=DTXBIT!DTX DRUMT(DTX)=STOREX ST_FLAGS=ST_FLAGS!8; ! FORCE DRUM UPDATE %FINISH %FINISH %FINISH %IF SFCFITTED=YES %AND DTX>=0 %AND ST_FLAGS&8#0 %START ! UPDATE DRUM COPY ST_FLAGS=ST_FLAGS!X'30'; ! DRUM TRANSFER OUT BITS FLAGS=FLAGS!X'30'; ! TRANSFER INITIATED AMT_OUTS=AMT_OUTS+1; ! AVOIDS AMT SPACE GOING TDRUM_DEST=X'280002'; ! DRUM WRITE TDRUM_SRCE=X'80040007' TDRUM_P1=AEX TDRUM_P2=DTX TDRUM_P3=STOREX TDRUM_P4=ADDR(AMT_OUTS) %FINISH %IF FLAGS=0 %THEN %START; ! NO TRANSFERS INITIATED %IF ST_FLAGS&2#0 %THEN AMTDDDDX=NEWEPBIT!STXMASK %C %AND ST_FLAGS=0 ->REP; ! TO RETURN EPAGE %FINISH ST_FLAGS=ST_FLAGS&X'F1' %IF MULTIOCP=YES %THEN STORESEMA=-1 TRANSFER NEEDED: ! TO COMPLETE PAGETURN %IF FLAGS&X'80'#0 %THEN %START; ! DISC TRANSFER TO START %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PDISC(TDISC) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PDISCIT; *ST_PDISCIT *LSD_PTIT; *ISB_%TOS; *ST_PTIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PDISCIC; *ST_PDISCIC *LSD_PTIC; *ISB_%TOS; *ST_PTIC PDISCCALLN=PDISCCALLN+1 %FINISH %FINISH %IF SFCFITTED=YES %AND FLAGS&X'20'#0 %START;! DRUM DIITO %IF MONLEVEL&4#0 %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH DRUM(TDRUM) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_DRUMIT; *ST_DRUMIT *LSD_PTIT; *ISB_%TOS; *ST_PTIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_DRUMIC; *ST_DRUMIC *LSD_PTIC; *ISB_%TOS; *ST_PTIC DRUMCALLN=DRUMCALLN+1 %FINISH %FINISH %RETURN !----------------------------------------------------------------------- ACTIVITY(4): ! ZERO "NEW" EPAGE ON DEACTIVATION %IF MONLEVEL&4#0 %THEN PAGEZN=PAGEZN+1 %IF MULTIOCP=YES %THEN STORESEMA=-1 FLAGS=X'80'; ! DISC WRITE INITIATED TDISC_DEST=X'210002'; ! WRITEOUT TDISC_SRCE=X'80040008'; ! REPLY TO ACT 8 TDISC_P1=AEX TDISC_P2=AMT_DA+EPX TDISC_P3=ZEROPAGEAD ->TRANSFER NEEDED !---------------------------------------------------------------------- ACTIVITY(5): ! REPLY FROM DISC/WRITE ST==STORE(STOREX) ! ! THERE ARE THREE POSSIBLE COURSES OF ACTION ON DISC FAILURE ! 1) FRIG THE USER COUNT SO IT STAYS IN CORE ! 2) TRY AGAIN (UNHELPFUL SINCE 42*8 TRIES ALREADY MADE) ! 3) DO NOTHING AND RELY ON NEXT READ FAILING ! FOR THE MOMENT FOLLOW COURSE 3 ! ST_FLAGS=ST_FLAGS&X'3F'; ! NO DISC TRANSFER %IF P_P2=4 %THEN %START; ! WAS ABORTED %IF MONLEVEL&4#0 %THEN ABORTN=ABORTN+1 ST_FLAGS=ST_FLAGS!8; ! PUT BACK WRITTEN MARKER %FINISH AMT_OUTS=AMT_OUTS-1 %IF ST_FLAGS&X'A0'#0 %OR ST_USERS#0 %THEN ->MUST WAIT %IF ST_FLAGS&X'E'#0 %THEN ->PAGEOUT REP: ! RETURN THE EPAGE ST_FLAGS=ST_FLAGS&1 %IF ST_FLAGS=0 %START; ! NOT RECAPTURABLE %IF SFCFITTED=NO %OR DTX<0 %THEN %C AMTDDDDX=AMTDDDDX!STXMASK %ELSE DRUMT(DTX)=STXMASK %FINISH %ELSE %START %IF SFCFITTED=NO %OR DTX<0 %THEN ST_LINK=DDX %C %ELSE ST_LINK=DDBIT!DTX %FINISH P_DEST=X'60001' P_P2=STOREX PAGEFREES=PAGEFREES-1 %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH RETURN EPAGE(P) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_RETIT; *ST_RETIT *LSD_PTIT; *ISB_%TOS; *ST_PTIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_RETIC; *ST_RETIC *LSD_PTIC; *ISB_%TOS; *ST_PTIC RETCALLN=RETCALLN+1 %FINISH RAMTX: ! RETURN AMTX IF UNUSED %IF AMT_USERS=0 %AND AMT_OUTS=0 %THEN %START P_DEST=X'00080003' P_P2=AMTX %IF MULTIOCP=YES %THEN PON(P) %ELSE %START %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH ACTIVE MEM(P) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_AMIT; *ST_AMIT *LSD_PTIT; *ISB_%TOS; *ST_PTIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_AMIC; *ST_AMIC *LSD_PTIC; *ISB_%TOS; *ST_PTIC AMCALLN=AMCALLN+1 %FINISH %FINISH %FINISH %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN !----------------------------------------------------------------------- ACTIVITY(7): ! REPLY FROM DRUM/WRITE %IF SFCFITTED=YES %THEN %START ST==STORE(STOREX) %IF P_P2<0 %THEN %START; ! WRITE FAILURE AMTDDDDX=STOREX; ! RETURN DRUM PAGE BAD DRUM PAGE(DTX) DTX=-1 %FINISH ! ! NORMALLY DRUM AND DISC TRANSFERS ARE STARTED TOGETHER AND DRUM FINISHES ! FIRST. IN THESE CIRCUMSTANCES THE NEXT 2 LINES ARE DONE IN DRUM AND ! THERE IS NO REPLY. REPLIES COME IF DISC FININISHES FIRST OR DRUM ! TRANSFER FAILS OR THIS IS THE ONLY TRANSFER AS WHEN READONLY PAGE ! WRITTEN TO DRUM ON FIRST ACCESS ! ST_FLAGS=ST_FLAGS&X'CF'; ! NO DRUM TRANSFER AMT_OUTS=AMT_OUTS-1 %IF ST_FLAGS&X'A0'#0 %OR ST_USERS#0 %THEN ->MUST WAIT %IF ST_FLAGS&X'E'#0 %THEN ->PAGEOUT;! FURTHER UPDATES HAPPENED?? ->REP; ! RETURN EPAGE %FINISH !----------------------------------------------------------------------- ACTIVITY(8): ! REPLY FROM ZERO DISCPAGE ! IGNORE FAILURES SEE ACT 5 DCLEARS=DCLEARS-1 AMT_OUTS=AMT_OUTS-1 ->RAMTX !---------------------------------------------------------------------- PUSHPIT: ! AWAIT TRANSFER USING THE PIT LIST I=NEWPPCELL PP==PARM(I) PP_DEST=SRCE PP_SRCE=X'40003' PP_P1=ID PP_P2=ST_REALAD&X'0FFFFFFF'; ! MAY BE FLAWED PP_P3=0; ! SUCCESS FLAG PP_P6=DTX; ! TELL IF DRUM OR DISC IN DUMP PP_LINK=ST_LINK ST_LINK=I *J_%TOS %END !---------------------------------------------------------------------- %IF SFCFITTED = YES %THEN %START %ROUTINE BAD DRUM PAGE(%INTEGER DTX) !*********************************************************************** !* PUTS A DRUM PAGE ONTO BACK OF FREELIST. FREELIST IS NOT CIRCULAR * !* TO MINIMISE OVERHEADS SO SOME SEARCHING MAY BE NEEDED HERE. * !* DRUM ASL BTM POINTS TO LAST CELL UNLESS LIST HAS BEEN COMPLETELY * !* EMPTY SINCE IPL. RELEVANT SEMA IS ASSUMED CLAIMED! * !*********************************************************************** %INTEGER I,J %IF DRUMTASL=DTEND %THEN DRUMTASL=DTX %AND ->ENTER %IF DRUMT(DRUMT ASL BTM)#DTEND %START I=DRUMTASL %CYCLE J=DRUMT(I) %IF J=DTEND %THEN %EXIT I=J %REPEAT DRUMT ASL BTM=I %FINISH DRUMT(DRUMT ASL BTM)=DTX ENTER: DRUMT(DTX)=DTEND DRUMT ASL BTM=DTX DRUM ALLOC=DRUM ALLOC-1 %END %FINISH %INTEGERFN QUICK EPAGE(%INTEGER ZEROED) !*********************************************************************** !* CAN BE CALLED BY ANYONE HOLDING STORESEMA TO GET THE NEXT FREE * !* NEXT FREE EPAGE. GIVES THE STORE INDEX OR -1 * !*********************************************************************** %RECORDNAME ST(STOREF) %CONSTINTEGER CLEARTB=X'58000000'+1024*EPAGESIZE %INTEGER I,STAD,STOREX %IF FREE EPAGES=0 %THEN %RESULT=-1 STOREX=FSTASL ST==STORE(STOREX) FSTASL=STORE(FSTASL)_FLINK %IF FSTASL=0 %THEN BSTASL=0 %ELSE STORE(FSTASL)_BLINK=0 %IF ST_FLAGS=1 %THEN %START; ! RECAPTURABLE FLAG I=ST_LINK %IF SFC FITTED=NO %OR I&DDBIT=0 %THEN %C AMTDD(I)=AMTDD(I)!STXMASK %ELSE %C I=I&(\DDBIT) %AND DRUMT(I)=STXMASK ST_FLAGS=0 %FINISH %IF ZEROED=0 %THEN %START; ! CLEAR TO ZERO STAD=PUBSEG!(SEG64+ST_REALAD) *LDTB_CLEARTB *LDA_STAD *MVL_%L=%DR,0,0 %FINISH FREEEPAGES=FREEEPAGES-1 %IF FREEEPAGES=0 %THEN INHIBIT(5) %RESULT=STOREX %END %ROUTINE GET EPAGE(%RECORDNAME P) !*********************************************************************** !* CAN BE PONNED (BUT NOT CALLED!) TO PROVIDE AN EPAGE. * !* REPLIES HAVE STORE INDEX IN P_P2 AND VIRTADDR IN P_P4 * !*********************************************************************** %RECORDSPEC P(PARMF) %INTEGER STOREX,PS,I %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SEMACL: %FINISH %IF FREEEPAGES=0 %THEN %START; ! SHOULD ONLY OCCUR IN MULTIOCPS %IF MULTIOCP=YES %THEN STORESEMA=-1 PON(P); ! SERVICE NOW INHIBITED OPMESS("FREE PAGE COUNT ???") %RETURN %FINISH %IF MONLEVEL&2#0 %AND KMON&1<<5#0 %THEN %C PKMONREC("GET EPAGE:",P) STOREX=QUICK EPAGE(P_P2) P_P2=STOREX; ! LEAVE P1 & P3 & P5 & P6 INTACT P_P4=(STORE(STOREX)_REALAD+SEG64)!PUBSEG P_DEST=P_SRCE P_SRCE=X'50000' PS=P_DEST %IF PS=X'40003' %THEN PS=P_P5 %IF LOCSN0>16<=LOCSN1 %THEN GETEPN=GETEPN-1 %IF MULTIOCP=YES %THEN STORESEMA=-1 PON(P) %END !----------------------------------------------------------------------- %INTEGERFN NEW EPAGE !*********************************************************************** !* HANDS OUT A NEW EPAGE TO EXTEND A VITAL RESIDENT TABLE * !*********************************************************************** %RECORD P(PARMF) %INTEGER I %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_7,; ! CAN NOT LOOP HERE %FINISH %IF FREE EPAGES>0 %THEN %START I=QUICK EPAGE(0); ! ZEROED %IF MULTIOCP=YES %THEN STORESEMA=-1 %RESULT=STORE(I)_REALAD&X'0FFFFFFF';! MAY BE FLAWED %FINISH %IF MULTIOCP=YES %THEN STORESEMA=-1 USE SPARE: ! TRY EMERGENCY SPARE PAGE %IF SPSTOREX>0 %START I=STORE(SPSTOREX)_REALAD; ! CANNOT BE FLAWED(SEE RETURNEPAGE) SPSTOREX=0 %RESULT=I %FINISH %RESULT=-1 %END !----------------------------------------------------------------------- %ROUTINE RETURN EPAGE(%RECORDNAME P) !*********************************************************************** !* PUT AN EPAGE BACK ON THE FREE LIST. FLAWED PAGES ARE ABANDONED * !* IF THE PAGE IS MARKED AS 'RECAPTURABLE' IT GOES TO THE BACK OF * !* OF THE FREELIST OTHERWISE IT GOES ON THE FRONT. THIS GIVES THE * !* MAXIMUM CHANCES OF RECAPTURING ANYTHING USEFUL * !*********************************************************************** %CONSTINTEGER CLEARTB=X'58000000'+1024*EPAGESIZE %RECORDSPEC P(PARMF) %RECORDNAME ST(STOREF) %INTEGER I,STOREX,STAD,ACT ACT=P_DEST&1 %IF MULTIOCP=YES %AND ACT=0 %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SEMACL: %FINISH %IF MONLEVEL&2#0 %AND KMON&1<<6#0 %THEN %C PKMONREC("RETURNEPAGE:",P) STOREX=P_P2 ST==STORE(STOREX) %IF ST_REALAD<0 %THEN %START %IF STOREX=0 %THEN MONITOR("PAGE 0 RETURNED???") OPMESS("PAGE ".STRINT(STOREX)." ABANDONED") *JLK_ ->RETURN %FINISH %IF SPSTOREX=0 %START *JLK_ STAD=VIRTAD+ST_REALAD; ! CANNOT BE FLAWED *LDTB_CLEARTB *LDA_STAD *MVL_%L=%DR,0,0 SPSTOREX=STOREX %FINISH %ELSE %START %IF ST_FLAGS&1#0 %START; ! RECAPTURABLE TO BACK ST_FLINK=0 ST_BLINK=BSTASL %IF BSTASL=0 %THEN FSTASL=STOREX %ELSE %C STORE(BSTASL)_FLINK=STOREX BSTASL=STOREX %FINISH %ELSE %START; ! NOT RECAPTURABLE ON FRONT ST_BLINK=0 ST_FLINK=FSTASL %IF FSTASL=0 %THEN BSTASL=STOREX %ELSE %C STORE(FSTASL)_BLINK=STOREX FSTASL=STOREX %FINISH %IF FREEEPAGES=0 %THEN UNINHIBIT(5) FREEEPAGES=FREEEPAGES+1 %FINISH RETURN: %IF MULTIOCP=YES %AND ACT=0 %THEN STORESEMA=-1 %RETURN STOP RECAPTURE: ! JLK SUBROUTINE TO BREAK LINK %IF ST_FLAGS=1 %THEN %START; ! RECAPTURABLE I=ST_LINK %IF SFC FITTED=NO %OR I&DDBIT=0 %THEN %C AMTDD(I)=AMTDD(I)!STXMASK %ELSE %C I=I&(\DDBIT) %AND DRUMT(I)=STXMASK ST_FLAGS=0 %FINISH *J_%TOS %END !----------------------------------------------------------------------- %ROUTINE DEADLOCK !*********************************************************************** !* CALLED WHEN THE NUMBER OF PROCESSES NOT WAITING ON A PAGE FAULT * !* IS LESS THAN THE NUMBER OF OCPS TO EXECUTE THEM.THIS ROUTINE GOES* !* DOWN THE LIST OF GET EPAGES UNTIL IT FIND A PROCESS AND GIVES IT * !* PAGE ZERO AS A SIGNAL TO DEPART. NEEDS STORE SEMA TO CHECK FOR * !* A DEADLOCK AND THE MAINQSEMA FOR SUPPOFFING * !*********************************************************************** %RECORD P(PARMF) %INTEGER I,N,K %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SEMAGOT: %FINISH %UNLESS PAGEFREES<=1 %AND GETEPN>=MPLEVEL+1-COM_NOCPS %START %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN; ! NOT A TRUE DEADLOCK %FINISH N=GETEPN GETEPN=GETEPN-1; ! ASSUMES WE WILL CURE DEADLOCK %IF MULTIOCP=YES %THEN STORESEMA=-1 %CYCLE I=1,1,4*N; ! ALLOW FOR PLENTY OF OTHER RQS SUPPOFF(SERVA(5),P); ! TAKE A GET PAGE REQUEST %IF (P_SRCE=X'40003' %AND LOCSN0>16<=LOCSN1) %OR %C LOCSN0>16<=LOCSN1 %START ! 4-3=PAGEIN. P_P5 IS PT SRCE ! LC ACT 9 IS GET PAGE FOR PTS ! LC ACTF IS GET LOCKED PAGE P_DEST=P_SRCE P_SRCE=X'50000'; ! AS FROM GET EPAGE P_P2=0; ! PAGE 0 P_P4=-1; ! WHICH HAS REALAD OF -1 PON(P) PRINTSTRING("DEADLOCK RECOVERED ") K=1+COM_SEPGS//200; ! 0.5% OF STORE %IF K>OVERALLOC %THEN K=OVERALLOC OVERALLOC=OVERALLOC-K UNALLOCEPS=UNALLOCEPS-K %RETURN %FINISH PON(P); ! NOT SUITABLE: RETURN TO QUEUE %REPEAT GETEPN=GETEPN+1 OPMESS("DEADLOCK UNRECOVERABLE") %END %ROUTINE OVERALLOC CONTROL !*********************************************************************** !* THIS ROUTINE IS KICKED PERIODICALLY TO TRY TO INCREASE THE STORE * !* OVERALLOCATION. EACH TIME THERE IS A DEADLOCK THE OVERALLOCATION * !* IS DECREASED. SYSTEM SHOULD SELF TUNE TO OCCAISIONAL DEADLOCKS * !* (1 EVERY 10-15MINS) WHICH IS OPTIMAL STORE USE. * !*********************************************************************** %IF OVERALLOC SEMALOOP(STORESEMA) ASEMAGOT: %FINISH ->ACT(P_DEST&X'F') !----------------------------------------------------------------------- ACT(0): ! INITIALISE %IF MULTIOCP=YES %THEN STORESEMA=-1 REALAD=NEW EPAGE LIM=MAXAMTAK-1 PST(AMTASEG)=X'4110038080000001'!LIM<<42!REALAD %IF MULTIOCP=YES %THEN PST(AMTASEG)=PST(AMTASEG)!NONSLAVED ! ! SET UP PUBLIC SEGMENT 'AMTASEG' FOR AMTA RECORD ARRAY WITH ! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF ! AMTAPT==ARRAY((REALAD+SEG64)!PUBSEG,PTF) AMTA==ARRAY(X'80000000'!AMTASEG<<18+(MAXAMTAK<<2-AMTFLEN),AMTAF) APPENDAMTA(EPAGESIZE<<10-MAXAMTAK<<2,REALAD) REALAD=NEW EPAGE LIM=MAXAMTDDK-1 ! ! PUBLIC SEGMENT 'AMTDDSEG' FOR AMTDD ARRAY WITH ! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF ! PST(AMTDDSEG)=X'4110038080000001'!LIM<<42!REALAD %IF MULTIOCP=YES %THEN PST(AMTDDSEG)=PST(AMTDDSEG)!NONSLAVED AMTDDPT==ARRAY((REALAD+SEG64)!PUBSEG,PTF) AMTDD==ARRAY(X'80000000'!AMTDDSEG<<18+(MAXAMTDDK<<2-DDFLEN), %C AMTDDF) APPENDAMTDD(EPAGESIZE<<10-MAXAMTDDK<<2,REALAD) %IF SFCFITTED=NO %OR DRUMSIZE=0 %THEN DRUMTASL=DTEND %ELSE %START %CYCLE I=0,1,DRUMSIZE-2 DRUMT(I)=I+1 %REPEAT DRUMT ASL BTM=DRUMSIZE-1 DRUMT(DRUMT ASL BTM)=DTEND DRUMTASL=0 DRUMALLOC=0 %IF MONLEVEL&1#0 %THEN %START DISPLAY TEXT(0,2,36,"DRMF") DISPLAY TEXT(0,3,36," 99%") %FINISH %FINISH %RETURN !----------------------------------------------------------------------- ACT(1): ! GET AMTX DA=P_P2 LEN=P_P3&(MAXBLOCK-1)+1 MASK=P_P3; ! "NEW" EPAGE BIT MASK (TOP BITS) *LSS_DA; *IMDV_509; *LSS_%TOS; *AND_511; *ST_HASH AMTX=AMTHASH(HASH) %WHILE AMTX#0 %CYCLE; ! SCAN DOWN LIST AMT==AMTA(AMTX) %IF AMT_DA=DA %THEN %START; ! THIS DA ALREADY IN TABLE %IF AMT_LEN#LEN %THEN %START %IF AMT_USERS#0 %THEN AMTX=-3 %AND ->RETURN %IF AMT_LENRETURN;! EXTEND ? %CYCLE I=AMT_DDP+LEN,1,AMT_DDP+AMT_LEN-1 ! RETURN IF STILL IN USE %IF AMTDD(I)&STXMASK#STXMASK %THEN %C AMTX=0 %AND ->RETURN %REPEAT DEALLOCDD(AMT_DDP+LEN,AMT_LEN-LEN) AMT_LEN=LEN %FINISH AMT_USERS=AMT_USERS+1; ! USERS ->RETURN %FINISH AMTX=AMT_LINK %REPEAT %IF AMTASL=0 %THEN %START; ! NO AMT CELLS FREE ! TRY TO APPEND EPAGE TO AMTA AMTX=-1 %IF AMTANEXT>=MAXAMTAK %THEN ->RETURN;! ALREADY MAX SIZE REALAD=NEW EPAGE %IF REALAD<=0 %THEN ->RETURN; ! NO FREE EPAGE APPENDAMTA(EPAGESIZE<<10,REALAD) %FINISH ! ALLOCATE NEW SPACE GARB=0; ! NOT GARBAGE COLLECTED YET %CYCLE %IF DDASL(LEN)#0 %THEN %START DDX=DDASL(LEN) DDASL(LEN)=AMTDD(DDX) ->SETAMT %FINISH ! TAKE SPACE FROM A BIGGER HOLE I=LEN+1 %WHILE I<=MAXBLOCK %CYCLE DDX=DDASL(I) %IF DDX#0 %THEN %START DDASL(I)=AMTDD(DDX) AMTDD(DDX+LEN)=DDASL(I-LEN) DDASL(I-LEN)=DDX+LEN ->SETAMT %FINISH I=I+1 %REPEAT ! NO HOLES BIG ENOUGH %IF GARB#0 %THEN AMTX=-2 %AND ->RETURN;! STILL NOT ENOUGH SPACE COLLECT DD GARBAGE ! TRY TO APPEND EPAGE TO AMTDD %IF FREEMAX<32 %AND AMTDDNEXT0 %THEN APPENDAMTDD(EPAGESIZE<<10,REALAD) %FINISH %REPEAT SETAMT: ! PUSHDOWN NEW AMT CELL AMTX=AMTASL AMT==AMTA(AMTX) AMTASL=AMT_LINK AMT_DA=DA AMT_DDP=DDX AMT_USERS=1 AMT_LEN=LEN AMT_OUTS=0 AMT_LINK=AMTHASH(HASH) AMTHASH(HASH)=AMTX %CYCLE I=DDX,1,DDX+LEN-1 AMTDD(I)=MASK>>31<<15!STXMASK %REPEAT RETURN: P_P1=ID P_P2=AMTX %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF SRCE>0 %THEN P_DEST=SRCE %AND P_SRCE=X'80001' %AND PON(P) %RETURN !----------------------------------------------------------------------- ACT(2): ! RETURN AMTX IN P_P2 ! P_P3=0 FILE KEPT #0 DESTROY %BEGIN %INTEGERARRAY CLEARS(0:MAXBLOCK) AMTX=P_P2 AMT==AMTA(AMTX) %IF AMT_DA=X'FF000000' %OR AMT_DA=0 %THEN OPMESS("RETURNED AMT??") CN=0; ! NO CLEARS AS YET %IF P_P3=0 %THEN %START; ! FILE BEING KEPT %CYCLE I=AMT_DDP,1,AMT_DDP+AMT_LEN-1;! CHECK "NEW" EPAGE BIT ! "NEW" SECTIONS NEVER SHARED %IF AMTDD(I)&NEWEPBIT#0 %THEN %START AMTDD(I)=AMTDD(I)&(\NEWEPBIT) CLEARS(CN)=AMTX<<16!(I-AMT_DDP) CN=CN+1 AMT_OUTS=AMT_OUTS+1 %FINISH %REPEAT %FINISH AMT_USERS=AMT_USERS-1 ! ! NOW IF THERE WERE ANY CLEARS SET THEM OFF. THIS IS DONE LATER ! SO THAT THE STORE SEMA CAN BE FREE ON DUALS. IMPORTANT AS IT MAY ! BE NECESSARY TO EXTEND THE PARM ASL IF VERY LARGE NO OF CLEARS ! ARE REQUIRED ! P_P6=CN; ! SO L-C CAN ACCOUNT FOR CLEARS %IF CN>0 %START DCLEARS=DCLEARS+CN %IF MULTIOCP=YES %THEN STORESEMA=-1 Q_DEST=X'40004'; ! ZERO PAGE Q_SRCE=X'80080002' %CYCLE I=0,1,CN-1 Q_P1=CLEARS(I) %IF MULTIOCP=YES %THEN PON(Q) %ELSE %START %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *ST_IT; *LSS_(6); *ST_IC %FINISH PAGETURN(Q) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_AMIT; *ISB_%TOS; *ST_AMIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_AMIC; *ISB_%TOS; *ST_AMIC PTCALLN=PTCALLN+1 %FINISH %FINISH %REPEAT %FINISH %END %IF CN>0 %THEN %RETURN; ! SEMA ALREADY RELEASED ! IF THERE WERE NO CLEARS THEN ! DROP THROUGH INTO ACT 3 !----------------------------------------------------------------------- ACT(3): ! RETURN AMTX AFTER TRANFERS END AMTX=P_P2 AMT==AMTA(AMTX) %UNLESS AMT_USERS=AMT_OUTS=0 %AND AMT_DA#X'FF000000' %START %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN; ! AWAIT TRANSFERS %FINISH DEALLOCDD(AMT_DDP,AMT_LEN) DEALLOCAMT %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN !----------------------------------------------------------------------- ACT(4): ! ENTERED EVERY 10 SECS %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF SFCFITTED=YES %AND DRUMSIZE#0 %THEN %C I=100*DRUMALLOC//DRUMSIZE %ELSE I=0 %IF SFCFITTED=YES %AND MONLEVEL&1#0 %AND DRUMSIZE#0 %THEN %C DISPLAY TEXT(0,3,37,STRINT(100-I)."% ") RESIDENCES=MINRESIDENCES+50-I//2 RESIDENCES=MAXRESIDENCES %IF RESIDENCES>MAXRESIDENCES ! ! EXAMINE PROCESS LIST EVERY 10 SECS. ALL PROCESSES THAT HAVE ! BEEN INACTIVE FOR MORE THAN 2 MINS ARE TOLD TO DEACTIVATE ! THEIR ACTIVE MEMORY FREEING DRUM & TABLESPACE ! P_SRCE=X'80000' K=(RESIDENCES-MINRESIDENCES+2)>>1;! HOW LONG CAN HE HANG ON TO DRUM ! MAX 7 MIN 1 IN 20 SEC TICKS I=1; J=0 %UNTIL J=COM_USERS %OR I>MAXPROCS %CYCLE PROC==PROCA(I) %IF PROC_USER#"" %THEN %START %IF PROC_STATUS&16=0 %AND K1 %CYCLE I=I-1 %IF AMTDD(I)=0 %THEN %START DDX=I %WHILE I>1 %CYCLE I=I-1 %IF AMTDD(I)#0 %THEN DDASLALLOC(I+1,DDX) %AND ->ALLOC %REPEAT DDASLALLOC(1,DDX) %EXIT %FINISH %REPEAT GARB=1 %END %ROUTINE APPENDAMTA(%INTEGER NEWSPACE,REALAD) !*********************************************************************** !* APPEND A NEW EPAGE AT "REALAD" TO THE AMT TABLE. ADD THE LAST * !* NEWSPACE BYTES TO THE TABLE. NEWSPACE=EPAGESIZE FOR ALL EPAGES * !* EXCEPT THE FIRST WHICH HOLDS THE PAGETABLE ALSO. * !*********************************************************************** %INTEGER FIRSTNEW,I,J J=X'80000001'!REALAD %CYCLE I=0,1,EPAGESIZE-1 AMTAPT(I+AMTANEXT)=J+I<<10 %REPEAT AMTANEXT=AMTANEXT+EPAGESIZE FIRSTNEW=AMTASIZE+1 AMTASIZE=AMTASIZE+NEWSPACE//AMTFLEN;! MIGHT WASTE THE ODD RECORD %CYCLE I=FIRSTNEW,1,AMTASIZE-1 AMTA(I)_LINK=I+1 %REPEAT AMTA(AMTASIZE)_LINK=AMTASL AMTASL=FIRSTNEW %END !----------------------------------------------------------------------- %ROUTINE APPENDAMTDD(%INTEGER NEWSPACE,REALAD) !*********************************************************************** !* APPEND A NEW EPAGE TO AMTDD. PARAMETERS AS FOR APPENDAMTA * !*********************************************************************** %INTEGER FIRSTNEW,I,J J=X'80000001'!REALAD %CYCLE I=0,1,EPAGESIZE-1 AMTDDPT(I+AMTDDNEXT)=J+I<<10 %REPEAT AMTDDNEXT=AMTDDNEXT+EPAGESIZE FIRSTNEW=AMTDDSIZE+1 AMTDDSIZE=AMTDDSIZE+NEWSPACE//DDFLEN FREEMAX=0 DDASLALLOC(FIRSTNEW,AMTDDSIZE) %END !----------------------------------------------------------------------- %ROUTINE DDASLALLOC(%INTEGER FROM,TO) !*********************************************************************** !* CHOP UP AMTDD (FROM:TO) INTO AS MANY MAXIMUM SIZED BLOCKS * !* AS POSSIBLE AND A LEFTOVER * !*********************************************************************** %INTEGER LEN %CYCLE LEN=TO-FROM+1 %IF LEN>=MAXBLOCK %THEN %START AMTDD(FROM)=DDASL(MAXBLOCK) DDASL(MAXBLOCK)=FROM FREEMAX=FREEMAX+1 FROM=FROM+MAXBLOCK %FINISH %ELSE %START %IF FROM<=TO %THEN %C AMTDD(FROM)=DDASL(LEN) %AND DDASL(LEN)=FROM %RETURN %FINISH %REPEAT %END !----------------------------------------------------------------------- %ROUTINE DEALLOCAMT !*********************************************************************** !* DEALLOCATE AMT ENTRY AND RETURN TO FREE LIST. RESETTING THE HASH * !* CHAIN IS THE ONLY PROBLEM * !*********************************************************************** %INTEGER HASH,DA %RECORDNAME AMT(AMTF) %HALFINTEGERNAME PTR AMT==AMTA(AMTX) DA=AMT_DA AMT_DA=X'FF000000' *LSS_DA; *IMDV_509; *LSS_%TOS; *AND_511; *ST_HASH PTR==AMTHASH(HASH) PTR==AMTA(PTR)_LINK %WHILE PTR#AMTX PTR=AMT_LINK; ! RESET CHAIN OMITTING THIS ENTRY AMT_LINK=AMTASL; ! RETURN CELL AMTASL=AMTX %END !----------------------------------------------------------------------- %ROUTINE DEALLOCDD(%INTEGER DDX,LEN) !*********************************************************************** !* DEALLOCATE A SECTION OF AMTDD. DIFFICULT IN DUALS AS STORE * !* SEMA IS NEEDED TO CLEAR BACKLINKS * !*********************************************************************** %INTEGER I,J,DTX %CYCLE I=DDX,1,DDX+LEN-1 %IF SFCFITTED=YES %AND AMTDD(I)&DTXBIT#0 %START;! RETURN DRUM PAGE DTX=AMTDD(I)&STXMASK J=DRUMT(DTX) %IF J#STXMASK %THEN STORE(J)_FLAGS=0 DRUMT(DTX)=DRUMTASL DRUMTASL=DTX DRUMALLOC=DRUMALLOC-1 %FINISH %ELSE %START J=AMTDD(I)&STXMASK %IF J#STXMASK %THEN STORE(J)_FLAGS=0 %FINISH AMTDD(I)=0 %REPEAT I=DDASL(LEN) AMTDD(DDX)=I DDASL(LEN)=DDX %END !----------------------------------------------------------------------- %END !----------------------------------------------------------------------- %IF MONLEVEL&X'1C'#0 %THEN %START %ROUTINE TIMEOUT(%RECORDNAME P) !*********************************************************************** !* PRINT OUT THE SESSION TIMING MEASUREMENTS * !*********************************************************************** %RECORDSPEC P(PARMF) %CONSTSTRING(15)%ARRAY SERVROUT(0:LOCSN0+3)="IDLE TIME", "NOWORK TIME","DEADLOCK RCVRY","SCHEDULE", "PAGETURN","GET EPAGE","RETURN EPAGE","FILE SEMAPHORE","ACTIVE MEM", "","ELAPSEDINT","UPDATE TIME","DPONPUTONQ","TURNON ER", "ACTIVEMEM(POLL)","SCHEDULE(OPER)","OVERALLOC CNTRL",""(15), "DISC","DISC TRANSFERS","DISC INTERRUPT","","MOVE REQUESTS", "MOVE TRANSFERS",""(2), "DRUM TRANSFERS","","DRUM INTERRUPT",""(5),"GPC REQUESTS","TAPE", "OPER","LP ADAPTOR","CR ADAPTOR","CP ADAPTOR","PRINTER", "COMMS CONTROL","COMBINE","FEP ADAPTOR","GPC INTERRUPT", ""(2),"BMREP","COMREP",""(2),"LOCAL CONTROL","FOREGRND USERS", "BACKGRND USERS" %EXTRINSICLONGINTEGER SEMATIME %INTEGER I,J,K %LONGREAL PERIOD, TOTAL, IDLETIME, PROCTIME, SERVTIME %STRING (15) S %STRING(31)%FNSPEC STRPRINT(%LONGREAL X,%INTEGER A,B) %IF MULTIOCP=YES %THEN RESERVE LOG %IF MONLEVEL&4#0 %THEN %START PERIOD=CLOCK-CLOCK0 I=ADDR(COM_DATE0)+3 NEWPAGE PRINT STRING(" EMAS2900 SUP".SUPID." TIMING MEASUREMENTS ".STRING(I)." ".STRING(I+12)." PERIOD=".STRPRINT(PERIOD/1000000,1,3)." SECS") %IF MULTIOCP=YES %THEN PERIOD=PERIOD*COM_NOCPS SERVIT(0)=IDLEIT SERVIT(1)=NOWORKIT SERVIT(4)=SERVIT(4)+PTIT; ! PAGETURN SERVIT(6)=SERVIT(6)+RETIT; ! RETURN EPAGE SERVIT(8)=SERVIT(8)+AMIT; ! ACTIVE MEM SERVIT(33)=SERVIT(33)+PDISCIT; ! PDISC SERVIT(40)=SERVIT(40)+DRUMIT; ! DRUM SERVIT(LOCSN0+1)=SERVIT(LOCSN0+1)+LCIT SERVIT(LOCSN0+2)=FLPIT SERVIT(LOCSN0+3)=BLPIT SERVIC(0)=IDLEN SERVIC(1)=NOWORKN SERVIC(4)=SERVIC(4)+PTIC SERVIC(6)=SERVIC(6)+RETIC SERVIC(8)=SERVIC(8)+AMIC SERVIC(33)=SERVIC(33)+PDISCIC SERVIC(40)=SERVIC(40)+DRUMIC SERVIC(LOCSN0+1)=SERVIC(LOCSN0+1)+LCIC SERVN(0)=IDLEN IDLETIME=COM_ITINT*(IDLEIT+NOWORKIT) SERVN(1)=NOWORKN SERVN(4)=SERVN(4)+PTCALLN SERVN(6)=SERVN(6)+RETCALLN SERVN(8)=SERVN(8)+AMCALLN SERVN(33)=SERVN(33)+PDISCCALLN SERVN(40)=SERVN(40)+DRUMCALLN SERVN(LOCSN0+1)=LCN SERVN(LOCSN0+2)=FLPN SERVN(LOCSN0+3)=BLPN PROCTIME=COM_ITINT*(FLPIT+BLPIT) PRINT STRING(" SERVICE CALLS TIME AVERAGE % OF % OF"%C ." % OF INSTRNS AVERAGE (SECS) (MSECS) TOTAL " %C ."NON-IDLE SUPVSR ") TOTAL=0 %CYCLE I=0,1,LOCSN0+3 S=SERVROUT(I) %IF S#"" %THEN %START PRINT STRING(" ".S.STRSP(16-LENGTH(S)).STRPRINT( %C SERVN(I),7,0)) %IF SERVN(I)=0 %THEN NEWLINE %ELSE %START SERVTIME=COM_ITINT*SERVIT(I) PRINT STRING(STRPRINT(SERVTIME/1000000,6,3). %C STRPRINT((SERVTIME/1000)/SERVN(I),6,3). %C STRPRINT(100*SERVTIME/PERIOD,7,1)."%". %C STRPRINT(100*SERVTIME/(PERIOD-IDLETIME),6,1). %C "%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME- %C PROCTIME),6,1)."%".STRPRINT(SERVIC(I),11,0). %C STRPRINT(SERVIC(I)/SERVN(I),8,0)." ") TOTAL=TOTAL+SERVTIME %FINISH %FINISH %REPEAT PRINT STRING(" INTERRUPT/ACTIVATE ETC.=".STRPRINT((PERIOD-TOTAL)/1000000,1,3). %C " SECS (".STRPRINT(100*(PERIOD-TOTAL)/PERIOD,1,1)."%) SEMALOCKOUT=".STRPRINT(SEMATIME/1000000,1,3).%C "SECS(".STRPRINT(100*SEMATIME/PERIOD,1,1)."%) ") PRINTSTRING("DRUMSIZE=".STRINT(DRUMSIZE)." OVERALLOC=".STRINT(OVERALLOC)." PAGEINS=".STRINT(PTURNN)." RECAPTURES=".STRINT(RECAPN)." SHARED PAGES=".STRINT(PSHAREN)." NEW PAGES=".STRINT(NEWPAGEN)." WRITEOUTS=".STRINT(PAGEOUTN)." PAGES ZEROED=".STRINT(PAGEZN)." PAGES SNOOZED=".STRINT(SNOOZN)) PRINTSTRING(" SNOOZES OK=".STRINT(SNOOZOK)." SNOOZES TIMEDOUT=".STRINT(SNOOZTO)." SNOOZES ABANDONED=".STRINT(SNOOZAB)." PAGES ABORTED=".STRINT(ABORTN)." SOFTWARE INWARD CALLS=".STRINT(INTEGER(X'800000E0'))." ") %FINISH %IF MONLEVEL&8#0 %THEN %START NEWPAGE PRINTSTRING(" CATEGORY TABLE TRANSITIONS ") SPACES(3) %CYCLE I=1,1,MAXCAT WRITE(I,5) %REPEAT NEWLINE %CYCLE I=1,1,MAXCAT WRITE(I,2) %CYCLE J=1,1,MAXCAT K=CATREC(I,J) WRITE(K,5) %REPEAT NEWLINE SPACES(3) %CYCLE J=1,1,MAXCAT K=FLYCAT(I,J) %IF K#0 %THEN WRITE(K,5) %ELSE SPACES(6) %REPEAT NEWLINE %REPEAT %FINISH %IF MONLEVEL&16#0 %THEN %START PRINTSTRING(" CAT STROBES EPSEXAMINED EPSOUT ") %CYCLE I=1,1,MAXCAT %IF STROBEN(I)#0 %START WRITE(I,2) WRITE(STROBEN(I),7) WRITE(STREPN(I),11) WRITE(STROUT(I),6) %IF STROUT(I)#0 %THEN WRITE(STREPN(I)//STROUT(I),6) NEWLINE %FINISH %REPEAT %FINISH NEWPAGE PPROFILE %IF MULTIOCP=YES %THEN RELEASE LOG CLEAR TIME %RETURN %STRING (31) %FN STRPRINT(%LONGREAL X, %INTEGER N, M) !*********************************************************************** !* PRINTS A REAL NUMBER (X) ALLOWING N PLACES BEFORE THE DECIMAL * !* POINT AND M PLACES AFTER.IT REQUIRES (M+N+2) PRINT PLACES * !* UNLESS (M=0) WHEN (N+1) PLACES ARE REQUIRED. * !* * !* A LITTLE CARE IS NEEDED TO AVOID UNNECESSARY LOSS OF ACCURACY * !* AND TO AVOID OVERFLOW WHEN DEALING WITH VERY LARGE NUMBERS * !*********************************************************************** %LONGREAL ROUND,Y,Z %STRING(127)S %INTEGER I,J,L,SIGN,SPTR SIGN=' '; ! '+' IMPLIED %IF X<0 %THEN SIGN='-' Y=MOD(X); ! ALL WORK DONE WITH Y ROUND= 0.5/10.0**M; ! ROUNDING FACTOR Y=Y+ROUND I=0;Z=1 %UNTIL Z>Y %CYCLE; ! COUNT LEADING PLACES I=I+1;Z=10*Z; ! NO DANGER OF OVERFLOW HERE %REPEAT SPTR=1 %WHILE SPTR<=N-I %CYCLE CHARNO(S,SPTR)=' ' SPTR=SPTR+1 %REPEAT CHARNO(S,SPTR)=SIGN SPTR=SPTR+1 J=I-1; Z=10.0**J %CYCLE %UNTIL J<0 %CYCLE L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT Y=Y-L*Z;Z=Z/10; ! AND REDUCE TOTAL CHARNO(S,SPTR)=L+'0' SPTR=SPTR+1 J=J-1 %REPEAT %IF M=0 %THEN %EXIT; ! NO DECIMAL PART TO BE O/P CHARNO(S,SPTR)='.' SPTR=SPTR+1 J=M-1; Z=10.0**(J-1) M=0 Y=10*Y*Z %REPEAT LENGTH(S)=SPTR-1 %RESULT=S %END %END !----------------------------------------------------------------------- %ROUTINE CLEAR TIME !*********************************************************************** !* CLEAR OUT THE TIMING MEASUREMENTS * !*********************************************************************** %EXTRINSICLONGINTEGER SEMATIME %INTEGER I, J %IF MONLEVEL&4#0 %THEN %START %CYCLE I=0,1,LOCSN0+3 SERVIT(I)=0 SERVIC(I)=0 SERVN(I)=0 %REPEAT IDLEIT=0 IDLEN=0 NOWORKIT=0 NOWORKN=0 PTIT=0 PTIC=0 DRUMIT=0 DRUMIC=0 PDISCIT=0 PDISCIC=0 RETIT=0 RETIC=0 AMIT=0 AMIC=0 PTCALLN=0 DRUMCALLN=0 PDISCCALLN=0 AMCALLN=0 RETCALLN=0 LCIT=0 LCIC=0 LCN=0 FLPIT=0 BLPIT=0 FLPN=0 BLPN=0 RECAPN=0 PTURNN=0 NEWPAGEN=0 PAGEOUTN=0 PAGEZN=0 SNOOZN=0 SNOOZOK=0 SNOOZAB=0 SNOOZTO=0 ABORTN=0 PSHAREN=0 SEMATIME=0 CLOCK0=CLOCK %FINISH %IF MONLEVEL&8#0 %THEN %START %CYCLE I=0,1,MAXCAT %CYCLE J=0,1,MAXCAT FLYCAT(I,J)=0; CATREC(I,J)=0 %REPEAT %REPEAT %FINISH %IF MONLEVEL&16#0 %THEN %START %CYCLE I=0,1,MAXCAT STROBEN(I)=0 STREPN(I)=0 STROUT(I)=0 %REPEAT %FINISH %END %FINISH !----------------------------------------------------------------------- %IF MULTIOCP=YES %THEN %START %INTEGERFN REMOTE ACTIVATE(%INTEGER REMOTE PORT,ADDR) !*********************************************************************** !* ACTIVATES A REMOTE OCP. ITS SSN+1 IS AT ADDR * !*********************************************************************** %INTEGER I,ISAD,STKAD,VAL,RES %RECORDNAME SSNP1(ISTF) STKAD=ADDR&X'FFF80000'; ! REMOVE ODD BIT FROM SEGNO SSNP1==RECORD(ADDR) SSNP1=GSSNP1; ! COPY IN CONTEXT SSNP1_LNB=SSNP1_LNB&X'3FFFF'!STKAD SSNP1_SF=SSNP1_SF&X'3FFFF'!STKAD %CYCLE I=0,4,60 INTEGER(X'81000080'+I)=INTEGER(ADDR+I) %REPEAT; ! COPY SSN+1 TO REAL ADRR 80 ISAD=X'42000000'!REMOTE PORT<<20 %IF BASIC PTYPE<=3 %START; ! P2&P3 ISAD=ISAD!X'6014' VAL=X'80' %FINISH %ELSE %START; ! P4 PROCESSORS ISAD=ISAD+2 VAL=X'40000000' %FINISH RES=SAFE IS WRITE(ISAD,VAL) %CYCLE I=1,1,10000; %REPEAT %CYCLE I=0,4,60 INTEGER(X'81000080'+I)=INTEGER(X'801C0000'+I) %REPEAT; ! RESTORE RESTART REGS %RESULT=RES %END %FINISH %ROUTINE CONFIG CONTROL(%RECORDNAME P) !*********************************************************************** !* CONFIGURE OFF(DACT=0) OR ON(DACT=1) A MAJOR UNIT * !* P_P1=DEVICE<<16! IDENT NO * !* WHERE DEV=1 FOR OCP * !* DEV=2 FOR SAC * !* DEV=3 FOR SMAC * !* OTHER DACTS DESCRIBED IN COMMENTS * !*********************************************************************** %IF MULTIOCP=YES %THEN %START %INTEGERFNSPEC SMAC PORT(%INTEGER OPEN,PORT) %RECORDSPEC P(PARMF) %SWITCH DACT(0:2),CIN,COFF(1:3) %INTEGER DEV,IDENT,I,J,MYPORT,HISPORT,STACK %STRING(5)DEVNAME,ONOFF %CONSTSTRING(5)%ARRAY DEVS(1:3)="OCP ","SAC ","SMAC "; DEV=P_P1>>16 IDENT=P_P1&X'FFFF' %IF 1<=DEV<=3 %THEN DEVNAME=DEVS(DEV) %ELSE %START DEVNAME="??? " ->FAIL %FINISH *LSS_(3); *USH_-26 *AND_3; *ST_MYPORT HISPORT=MYPORT!!1 ->DACT(P_DEST&15) DACT(0): ! CONFIGURE OFF ->COFF(DEV) DACT(1): ! CONFIGURE ON ->CIN(DEV) COFF(1): ! CONFIGURE OFF OCP ->FAIL %UNLESS COM_NOCPS=2 %AND 2<=IDENT<=3 %IF MYPORT #IDENT %START; ! CAN ONLY CONFIGURE OFF MYSELF P_P6=P_DEST; P_DEST=X'3F0001' PON(P); ! TRY AGAIN IN 1 SEC %RETURN %FINISH ! %IF BASIC PTYPE<=3 %START I=X'42056011'!IDENT<<20 *LB_I; *LSS_X'80010000' *ST_(0+%B) %FINISH %ELSE %START *LSS_(X'4012'); *OR_X'100' *ST_(X'4012') %FINISH ! ! HAVE TOLD REMAINING OCP THAT I HAVE DIED. SO NOW LOOP FOR EVER ! %CYCLE *IDLE_X'F0FF' %REPEAT %RETURN CIN(1): ! CONFIGURE IN AN OCP ->FAIL %UNLESS COM_NOCPS=1 %AND 2<=IDENT<=3 %AND %C IDENT#COM_OCPPORT0 ->FAIL %UNLESS SMAC PORT(0,IDENT)=0;! OPEN RELEVANT PORT ! STACK=2*IDENT+8 %IF BASIC PTYPE=3 %START *LSS_(X'600A'); *AND_X'CC'; *ST_(X'600A');! ALLOW ACTIVATES %FINISH COM_OCPPORT1=IDENT COM_NOCPS=2 %IF REMOTE ACTIVATE(IDENT,X'80040000'+STACK<<18)#0 %THEN %C COM_NOCPS=1 %AND J=SMACPORT(1,HISPORT) %AND ->FAIL %IF BASIC PTYPE<=3 %START *LSS_1; *ST_(X'6009') %FINISH %ELSE %START *LSS_(X'4012'); *OR_X'300C'; *ST_(X'4012');! ALLOW MP INTS *LSS_(X'4013'); *OR_X'8004'; *ST_(X'4013');! SET MULT&DD %FINISH ->SUCC DACT(2): ! FINISH CONFIGURIN OFF HIM COM_NOCPS=1; COM_OCPPORT0=MYPORT COM_OCPPORT1=HISPORT J=SMACPORT(1,HISPORT); ! CLOSE OFF HIS SMAC PORT SUCC: %IF P_DEST&1=0 %THEN ONOFF="OFF" %ELSE ONOFF="ON" OPMESS(DEVNAME.STRINT(IDENT)." CONFIGURED ".ONOFF) %RETURN FAIL: ! UNKNOWN DEVICE OR OTHERS OPMESS("CANNOT CONFIGURE ".DEVNAME.STRINT(IDENT)) %RETURN %INTEGERFN SMAC PORT(%INTEGER OPEN,PORT) !*********************************************************************** !* OPEN (OPEN=0) %OR CLOSE A SMAC PORT IN ALL ONLINE SMACS * !*********************************************************************** %INTEGER I,J,K,L,VAL,RES K=X'20'>>PORT L=K!!(-1) %IF OPEN=0 %THEN K=0 RES=0 %CYCLE I=0,1,15 %IF 1<120 SECS ! TO ALLOW TIME TO AUTOLOAD DFC ! !----------------------------------------------------------------------- ! PROCESS CREATE ENTRY ONLY *LSS_(%LNB+0) *ST_PROCESS; ! FIND PROCESS NO PASSED BY FRIG PROCESS=INTEGER(PROCESS&X'FFFFFFFC') *LSS_OLDLNB *ST_(%LNB+0); ! TO ENABLE %MONITOR TO FIND ! GLOBAL VARIABLES PROC==PROCA(PROCESS) ME=(PROCESS+LOCSN0)<<16 LSN3=PROCESS+LOCSN3 SERV0==SERVA(PROCESS+LOCSN0) SERV3==SERVA(LSN3) ! ***** SEMAPHORE?******** SUPPOFF(SERV0,P); ! OBTAIN STARTUP RECORD ! ! INITIALIZE LOCAL STACKS INFO ! LST==ARRAY(LSTVAD,LSTF); ! LOCAL SEG TABLE IN SEG 0 LSTKSSN(1)=4; ! DIRECTOR/USER STACK SEGMENT LST(5)=LST(1)+X'80'+(DIRACR-LCACR)<<56;! AND SSN+1 LSTKSSN(2)=6; ! SIGNAL STACK LST(7)=LST(5)+X'80'; ! AND SIGNAL SSN+1 %CYCLE I=3,1,LSTKN LSTKSSN(I)=0 %REPEAT LST(DIRCSEG)=LST(0)&X'FFFC0000FFFFFFFF'+8+(DIRACR-LCACR)<<56+%C LENGTHENI(DIRCSEGL)<<32 DIROUTP==RECORD(DIROUTPAD) ALLOUTP==DIROUTP SIGOUTP==RECORD(SIGOUTPAD) CBTA==ARRAY(CBTAD,CBTAF) SST==ARRAY(SSTAD,SSTF) %IF MONLEVEL&4#0 %START %IF PROC_STATUS&4=0 %THEN LPIT==FLPIT %ELSE LPIT==BLPIT %FINISH !----------------------------------------------------------------------- ! INITIALISE CLAIMED BLOCK TABLES %CYCLE I=0,1,LSTLEN-1 SST(I)=255; ! ALL SEGMENTS UNCONNECTED LST(I)=LST(I)!X'7F00000000'; ! ALL SEGMENTS INACTIVE %REPEAT ASFREE=X'FFFFFFFF'; ! ALL FREE ASWAP=0 ASWIP=0 PROCACTAD1=X'28000004' PROCACTAD2=ADDR(PROC_ACTW0); ! %INTEGERNAME DESCRIPTOR SUSP=0 ASDESTROY=0 ! FILL IN SCTI(3)[ALIGNED] INTEGER(SCTI0+24)=X'38000004' INTEGER(SCTI0+28)=SCTJ30 ! AND J-VECTOR FOR SCTI(3) LONG INTEGER(SCTJ30)=0 LONG INTEGER(SCTJ30+8)=0 ! REQUEST INPUT AS J=1 ENTRY LONG INTEGER(SCTJ30+16)=X'80F0000000140001' LONG INTEGER(SCTJ30+24)=RTDR(REQUEST INPUT);! YIELDS DESCR-DESCR ! REQUEST OUTPUT AS J=2 ENTRY LONG INTEGER(SCTJ30+32)=X'80F0000000140001' LONG INTEGER(SCTJ30+40)=RTDR(REQUEST OUTPUT); ! YIELDS DESCR-DESCR ! CHANGE CONTEXT AS J=3 ENTRY LONG INTEGER(SCTJ30+48)=X'80F0000000140001' LONG INTEGER(SCTJ30+56)=RTDR(CHANGE CONTEXT) !----------------------------------------------------------------------- ! CONNECT DIRECTOR FILES ! CODE AS SEG2 USING CBT0&1 ! GLA AS SEG3 USING CBT2 ! STACK AS SEG4 USING CBT3 SST(2)=CBTLEN-2; SST(3)=0; SST(4)=1 LST(2)=X'5003FFFF00000000'!DIRACR<<52;! EXECUTE &READ CBTA(CBTLEN-2)_DA=P_P2 CBTA(CBTLEN-2)_TAGS=MAXBLOCK-1 CBTA(CBTLEN-1)_DA=P_P2+MAXBLOCK CBTA(CBTLEN-1)_TAGS=MAXBLOCK-1 CBTA(CBTLEN-1)_LINK=CONTINUATN BLK LST(3)=X'400003FF00000000'!DIRACR<<52!DIRACR<<56! %C (DGLAEPAGES*EPAGESIZE-1)<<42 CBTA(0)_DA=P_P3 CBTA(0)_TAGS=DGLAEPAGES-1 LST(4)=X'4FF003FF00000000'!(LONGONE*MAXBLOCK*EPAGESIZE-1)<<42 CBTA(1)_DA=P_P4 CBTA(1)_TAGS=MAXBLOCK-1 !----------------------------------------------------------------------- %IF PROCESS=1 %THEN %START; ! SET UP IST ENTRIES ONCE ONLY ! BUT WRITE TO BOTH IST SEGMENTS ! FOR MULTI-PROCESSOR INSTALLATIONS ! SET UP DUMMY IST VECTOR *STLN_I ISTDUM_LNB=I ISTDUM_PSR=X'00140001' ISTDUM_PC=0 ISTDUM_SSR=X'01800BFE'; ! ONLY EVENT PENDING & SYSERR *STSF_I ISTDUM_SF=I ISTDUM_IT=MAXIT ISTDUM_IC=MAXIT ISTDUM_CTB=0 J=X'80000000'!COM_OCPPORT0<<18; ! IST ADDRESS FOR IPL PROC K=J!!X'40000'; ! TOTHER OCP IIST ! SET VS ERROR IST ENTRY *JLK_ ; *LSS_%TOS ; *ST_I ISTDUM_PC=I RECORD(J+X'80')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'80')<-ISTDUM ! SET INTERVAL TIMER IST ENTRY *JLK_ ; *LSS_%TOS ; *ST_I ISTDUM_PC=I RECORD(J+X'A0')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'A0')<-ISTDUM ! SET PROG ERROR IST ENTRY *JLK_ ; *LSS_%TOS ; *ST_I ISTDUM_PC=I RECORD(J+X'C0')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'C0')<-ISTDUM ! SET UP OUT IST ENTRY *JLK_ ; *LSS_%TOS ; *ST_I ISTDUM_PC=I RECORD(J+X'100')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'100')<-ISTDUM ! SET INSTRUCTION COUNTER IST ENTRY *JLK_ ; *LSS_%TOS ; *ST_I ISTDUM_PC=I RECORD(J+X'160')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'160')<-ISTDUM ! SET SYSTEM CALL IST ENTRY ISTDUM_LNB=0 ISTDUM_PSR=X'00140001' ISTDUM_PC=SYSTEMCALL ISTDUM_SF=ADDR(PROCACTAD1) ISTDUM_IC=X'30000000'+SCTIENTRIES;! 64 BIT VECTOR DESCRIPTOR TO SCTI ISTDUM_CTB=SCTI0 RECORD(J+X'E0')<-ISTDUM %IF MULTIOCP=YES %THEN %C RECORD(K+X'E0')<-ISTDUM ! SET LOCAL CNTRLR REACTIVATE CONTEXT *STLN_I LSSNP1_LNB=I LSSNP1_PSR=X'00140001' *JLK_ ; *LSS_%TOS ; *ST_I LSSNP1_PC=I LSSNP1_SSR=X'01800BFE' *STSF_I LSSNP1_SF=I LSSNP1_IT=MAXIT LSSNP1_IC=MAXIT LSSNP1_CTB=0 %FINISH !----------------------------------------------------------------------- ! SET UP DIRECTOR CONTEXT NEWSTK=LSTKSSN(1)<<18 SSNP1==RECORD(NEWSTK!X'40000') SSNP1=0 SSNP1_LNB=NEWSTK SSNP1_PSR=X'00040001'!DIRACR<<20; ! PROG ERRORS UNMASKED SSNP1_PC=X'00080010'; ! TO M-C CODE DIRLOADER SSNP1_SSR=X'01800000'; ! ALL INTS ALLOWED SSNP1_SF=NEWSTK!X'14'; ! 5 WORDS ON FROM LNB SSNP1_IT=0 SSNP1_IC=MAXIT SSNP1_B=DIROUTPAD SSNP1_DR0=X'B1000000'; ! DESCRIPTOR TO ENTRY DESCRIPTOR SSNP1_DR1=X'000C0000'; ! AT START OF GLA PROC_STACK=NEWSTK; ! DIRECTOR STACK ON INITIAL ENTRY !----------------------------------------------------------------------- ! ! THE FOLLOWING RECORDS ARE SQUEEZED INTO THE SPARE WORDS OF SEGMENT 5 ! IOSTAT : WORDS 18 - 26 ! ICREVS : WORD 27 ! ACNT : WORDS 28 - 30 ! WORD 31 : USED BY DIRECTOR FOR COUNT OF KINSTRNS ! THERE IS NO MORE SPACE LEFT !!!! ! IOSTAT==RECORD(NEWSTK!X'40048') IOSTAT=0 ACNT==RECORD(NEWSTK!X'40070') ACNT=0 ICREVS==INTEGER(NEWSTK!X'4006C') ICREVS=X'12345678' !----------------------------------------------------------------------- ! SET UP SIGNAL CONTEXT NEWSTK=LSTKSSN(2)<<18 SSNP1==RECORD(NEWSTK!X'40000') SSNP1=0 SSNP1_LNB=NEWSTK SSNP1_PSR=X'0004FF01'!DIRACR<<20; ! PROGRAM ERRORS MASKED SSNP1_PC=X'00080010'; ! TO M-C DIRLOADER ENTRY POINT SSNP1_SSR=X'01800800'; ! NO INSTRUCTION COUNTER INTS SSNP1_SF=NEWSTK!X'14' SSNP1_IT=0 SSNP1_IC=MAXIT SSNP1_B=0; ! ZERO FOR SIGNAL ENTRY !!!!! SSNP1_DR0=X'B1000000' SSNP1_DR1=X'000C0000' ! ! THE FOLLOWING WORDS ARE SQUEEZED INTO SPARE WORDS OF SEGMENT 7 ! IE SSN+1 OF THE SIGNAL STACK ! WORD18 = SEMAHELD SET BY DIRECTOR WHEN A SEMAPHORE IS HELD ! SEMAHELD==INTEGER(NEWSTK!(X'40000'+4*18)) !----------------------------------------------------------------------- ! INITIALISATIONS FOR DIRECTOR STRING(DIROUTPAD)=SUPID DIROUTP_SRCE=EPAGESIZE<<16!MAXBLOCK DIROUTP_P1=PROCESS STRING(ADDR(DIROUTP_P2))=PROC_USER BYTEINTEGER(ADDR(DIROUTP_P3)+3)=PROC_INCAR DIROUTP_P4=SIGOUTPAD DIROUTP_P5=SCTI0 DIROUTP_P6=1; ! DACT FOR INT MESSGES FROM FE SIGOUTP_DEST=LSTLEN SIGOUTP_SRCE=SSTAD SIGOUTP_P1=CBTLEN-1; ! HIGHEST CBT ENTRY ! WAS ADDR(CBTASL) SIGOUTP_P2=CBTAD SIGOUTP_P3=ADDR(ACNT) SIGOUTP_P4=ADDR(ICREVS) SIGOUTP_P5=ADDR(IOSTAT) !----------------------------------------------------------------------- ! REPLY TO SCHEDULE POUT=0 POUT_DEST=X'30002'; ! SCHEDULE PROCESS CREATED POUT_SRCE=ME POUT_P1=PROCESS PON(POUT) !----------------------------------------------------------------------- RETURN: ! INTERRUPT BACK TO KERNEL *LSS_X'01800FFF'; ! NO SYSTEM ERROR INTS *ST_(3) LSSNP1P=LSSNP1; ! LOCAL CNTRLR REACTIVATE CONTEXT ! ! TO RETURN TO KERNEL REACTIVATE LOCAL CONTROLLER WITH EP SET ! THIS HORRENDOUS PROCEDURE WORKS SINCE WE ARE CERTAIN THAT:- ! 1) II (INSTRUCTION INCOMPLETE) IS NOT SET IN LC CONTEXTJUST SET ! 2) ALL OTHER INTERUPTS ARE MASKED ! HENCE EFFECT IS OF AN "OUT" TO KERNEL !!! ! WILL WORK OK FOR MULTIPROCESSORS (UNLIKE ACTIVATING BACK) ! *LXN_PROCACTAD2 *LSD_(%XNB+0) *OR_X'0000000100000000' *SLSD_0; ! LC STACK ADDRESSS (0) NOT PARAMETERISED *ST_%TOS %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT LCIC=LCIC+MAXIT-IC LCIT=LCIT+MAXIT-IT %FINISH *ACT_%TOS *IDLE_X'B00B' !----------------------------------------------------------------------- ENTERI:*JLK_%TOS ! NORMAL CALLS REACTIVATE TO HERE ! ****SEMAPHORE******** SUPPOFF(SERV0,P); ! OBTAIN PARAMETER RECORD %IF MONLEVEL&2#0 %AND KMON&1 #0 %THEN %C PKMONREC("LOCALC:",P) ->ACTIVITY(P_DEST&X'FFFF') !----------------------------------------------------------------------- ACTIVITY(1): ! START RESIDENCE PERIOD ! P_P1=EPAGE LIMIT ! P_P2=RESIDENCE TIME LIMIT ! P_P3=ACTIVE EPAGES LIMIT EPLIM=P_P1 RTLIM=P_P2 ! SET UP SSN+1 CONTEXT ADDRESSES K=INTEGER(LSTVAD+12); ! SEG 1 REAL ADDRESS %CYCLE I=1,1,LSTKN J=LSTKSSN(I) %IF J#0 %THEN INTEGER(LSTVAD+12+8*J)=K+I*X'80' %REPEAT INTEGER(LSTVAD+4+8*DIRCSEG)=INTEGER(LSTVAD+4)+8 SEMAHELD=0 PROC_STATUS=PROC_STATUS&(\(HADTONFLY!HADPONFLY!X'11')) ! RESET FOR NEW RESIDENCE XSTROBE=0 %IF SNOOZING=YES %THEN SNOOZES=0 PTEPS=0 PTP=0 LASTDA=0 EPN=0 HIGHSEG=2 RETIME: ! START NEW TIMESLICE SSNP1==RECORD(PROC_STACK!X'40000');! PROCESS CONTEXT %IF SSNP1_IT&X'FF800000'=0 %THEN %START %IF MONLEVEL&4#0 %THEN LPIT=LPIT-SSNP1_IT ACNT_LTIME=ACNT_LTIME-COM_ITINT*SSNP1_IT;! UNUSED TIME %FINISH SSNP1_IT=TIMESLICE; ! START NEW TIMESLICE %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE ACNT_LTIME=ACNT_LTIME+COM_ITINT*TIMESLICE RTN=0 ! SEMAPHORE FOR TESTING SERV? %IF SERV3_P<<2#0 %AND PROC_STACK#LSTKSSN(2)<<18 %THEN ->ASYNCH %IF SUSP#0 %THEN ->DIRPONREPLY ACT: ! ACTIVATE INTO USER PROCESS %IF KERNELQ#0 %THEN ->ONFRUNQ; ! DO ANY KERNEL SERVICES ! ! COUNT ACTIVATIONS TO PROCESS ! %IF MONLEVEL&4#0 %THEN %START %IF PROC_STATUS&4=0 %THEN FLPN=FLPN+1 %ELSE BLPN=BLPN+1 *LSS_(6); *ST_IC; *LSS_(5); *ST_IT LCIC=LCIC+MAXIT-IC LCIT=LCIT+MAXIT-IT %FINISH *LSS_(3); *AND_X'FFFFFFF5'; *ST_(3);! UNMASK PERI&EXTERNAL INT *LXN_PROCACTAD2; ! ADRRESS OF ACTIVATE WORDS *ACT_(%XNB+0) !----------------------------------------------------------------------- ACTIVITY(2): ! CONTINUE WITH CORE RESIDENCE PROC_STATUS=PROC_STATUS&(\2); ! IN CASE CAME FROM ONFRUNQ ACTIVATE: ! CHECK ASYNCH MESSAGE ! **** SEMAPHORE FOR CHECK? %IF SERV3_P<<2=0 %OR PROC_STACK=LSTKSSN(2)<<18 %THEN ->ACT !----------------------------------------------------------------------- ASYNCH: ! ASYNCHRONOUS MESSAGE POFFABLE SUPPOFF(SERV3,P) I=P_DEST&X'FFFF' %IF I=0 %THEN ->ASYN0(P_P1) %IF I=X'FFFF' %THEN OPMESS("PROCESS ".STRINT(PROCESS). %C " TERMINATED") %AND NEWSTK=PROC_STACK %AND ->TERMINATE %IF I=X'FFFE' %THEN %START *OUT_99; ! CRASH WITH MASKED OUT INT %FINISH %UNLESS I=1 %THEN ->SIGINT INTMESS<-STRING(ADDR(P_P3)) %IF LENGTH(INTMESS)=1 %THEN %START %IF P_P2>=0 %AND IOSTAT_IAD#P_P2 %THEN IOSTAT_IAD=P_P2 SIGINT: SIGOUTP<-P SIGOUTP_TYPE=3 SIGOUTP_SSN=CURSSN SIGOUTP_SSNAD=PROC_STACK SIGOUTP_SUSP=SUSP; ! PRESERVE SUSPEND STATUS SUSP=0 NEWSTK=LSTKSSN(2)<<18 SIGACT: ! SWOP IT & IC ALLOUTP==SIGOUTP LONG INTEGER(NEWSTK!X'40014')=LONG INTEGER(PROC_STACK!X'40014') PROC_STACK=NEWSTK SSNP1==RECORD(NEWSTK!X'40000') %IF SSNP1_LNB>>18#NEWSTK>>18 %OR SSNP1_LNB>>18#SSNP1_SF>>18 %C %OR SSNP1_PSR&3=0 %THEN PRINT STRING(" ACTIVATE CONTEXT INVALID") %AND ->TERMINATE ->ACTIVATE %FINISH %ELSE %START %IF LENGTH(INTMESS)>1 %THEN IOSTAT_INTMESS=INTMESS %IF P_P2>=0 %AND IOSTAT_IAD#P_P2 %THEN %START IOSTAT_IAD=P_P2 %IF SUSP<0 %THEN SUSP=0 %FINISH RESUSP: ! **** SEMAPHORE NEEDED FOR TEST? %IF SERV3_P<<2#0 %THEN ->ASYNCH %IF SUSP=0 %THEN ->ACT ! AVOID RESUSPENDING IF UNNECESSARY %IF SUSP&X'7FFFFFFF'<=LOCSN3 %THEN %START SERV==SERVA(SUSP) %IF SERV_P<<2#0 %THEN ->DPR;! DIRPONREPLY %FINISH SRCE=SUSP ->SUSPWS; ! MAY JUST HAVE SWAPPED STACK ! %FINISH !----------------------------------------------------------------------- ASYN0(1): ! DISC READ FAILS PEPARM=P_P2!18; ! TOP 22 BITS ARE VIRTADDR OF PAGE ->PE ASYN0(2): ! RELEASE ACTIVE BLOCKS DEACTIVATE(\ASFREE); ! IE ALL USED ACTIVATE BLKS PROC_STATUS=PROC_STATUS!24; ! SET AMT GOING & AMT GONE BITS ->RESUSP !----------------------------------------------------------------------- ACTIVITY(3): ! CONTINUE AFTER SUSP ON FLY %IF SNOOZING=YES %THEN %START %IF MONLEVEL&4#0 %THEN SNOOZN=SNOOZN+EPN EPLIM=P_P1 RTLIM=P_P2 SNOOZES=SNOOZES+1 STROBE %IF SNOOZES&15=0 ACNT_PTURNS=ACNT_PTURNS+EPN PROC_STATUS=PROC_STATUS&(\(HADPONFLY!HADTONFLY)) ! RESET FOR NEW RESIDENCE ->RETIME %FINISH !---------------------------------------------------------------------- VSERRI:*JLK_%TOS ! VIRTUAL STORE INTS ENTER HERE *LSS_%TOS *LSS_%TOS; ! PARAMETER *ST_VSPARM %IF VSPARM<0 %THEN PEPARM=9 %AND ->PE;! PUBLIC VSI VSSEG=VSPARM>>18 %IF 0>32&127 VSEPAGE=VSPARM>>EPAGESHIFT&(SEGEPSIZE-1) ->VSCAUSE(VSPARM&7) !----------------------------------------------------------------------- VSCAUSE(0):VSCAUSE(2):VSCAUSE(3): VSE: ! VS ERRORS SIGOUTP_P1=VSPARM SIGOUTP_P2=PROC_STACK SIGOUTP_TYPE=1 SIGOUTP_SSN=CURSSN SIGOUTP_SSNAD=PROC_STACK SIGOUTP_SUSP=0 NEWSTK=LSTKSSN(2)<<18 %IF PROC_STACK=NEWSTK %THEN %START PRINT STRING("VS ERROR ON SIGNAL STACK PARM=".STRHEX(VSPARM)." ") ->TERMINATE %FINISH ->SIGACT !----------------------------------------------------------------------- VSCAUSE(1): ! SEGMENT NOT AVAILABLE %IF SST(VSSEG)=255 %THEN ->VSE; ! NO CONNECTION SEGLEN=LST(VSSEG)>>(32+EPAGESHIFT)&(SEGEPSIZE-1)+1 ! ! IF THE SEGMENT IS NOT AVAILABLE THE HARDWARE HAS NOT CHECKED THAT ! THE PAGE IS WITHIN THE SEGMENT LIMIT. DO THIS BY SOFTWARE ! %IF VSEPAGE>=SEGLEN %THEN VSPARM=VSPARM!3 %AND ->VSE %IF SEGLEN<=PTEPS %THEN ->OLDPTP %IF EPN>=EPLIM %THEN ->NOPAGES %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SSEMAGOT: %FINISH %IF FREE EPAGES>0 %THEN STOREX=QUICK EPAGE(0) %AND %C STORESEMA=-1 %AND ->ACT9 POUT_SRCE=ME!9 POUT_P2=0; ! CLEAR TO ZERO GET EPN=GET EPN+1 %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF PAGEFREES<=1 %AND GETEPN>=MPLEVEL+1-COM_NOCPS %THEN %C POUT_DEST=X'20000' %AND PON(POUT) POUT_DEST=X'50000' PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(9): ! REPLY FROM GET EPAGE FOR PT STOREX=P_P2 %IF STOREX=0 %THEN ->DEAD; ! DEADLY EMBRACE RECOVERY ACT9: ! PAGE TABLE EPAGE HERE ST==STORE(STOREX) ST_LINK=PTP; ! LIST OF PAGE TABLE PAGES PTP=STOREX PTAD=ST_REALAD EPN=EPN+1 PTEPS=256 OLDPTP: ! ROOM IN OLD PAGETABLE PAGE LST(VSSEG)=LST(VSSEG)!X'0000000080000001'!PTAD %IF VSSEG>HIGHSEG %THEN HIGHSEG=VSSEG PTEPS=PTEPS-SEGLEN PTAD=PTAD+((SEGLEN*EPAGESIZE+1)//2)<<3;! 8 BYTE BOUNDARY ! ! RUN ON INTO A VSCAUSE(4) !----------------------------------------------------------------------- VSCAUSE(4): ! PAGE NOT AVAILABLE %IF EPN>=EPLIM %THEN ->NOPAGES CBTP=SST(VSSEG)+VSEPAGE//MAXBLOCK EPX=VSEPAGE&(MAXBLOCK-1) CBT==CBTA(CBTP) %IF CBT_TAGS&X'20'=0 %THEN %START;! BLOCK NOT ACTIVE %IF TSTPTR&127=127 %THEN %START;! SEGMENT NOT ACTIVE %IF ASFREE=0 %THEN FREE AS; ! NO FREE SLOTS *LSS_ASFREE *SHZ_ASP TSTPTR=ASP I=LSTVAD+8*VSSEG INTEGER(I)=INTEGER(I)&X'FFFFFF80'!ASP ASEG(ASP)=VSSEG AS(ASP)=0 ASB=TOPBIT>>ASP ASWIP=ASWIP!ASB; ! INSERT BIT ASFREE=ASFREE&(\ASB); ! REMOVE BIT %FINISH POUT_DEST=X'80001'; ! GET AMTX POUT_SRCE=0 POUT_P1=PROCESS POUT_P2=CBT_DA POUT_P3=CBT_AMTX<<16!(CBT_TAGS&X'80')<<24!CBT_TAGS ! NEWBIT<<31 ! LENGTH (COMPATIBLY) %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_AMIT; *ST_AMIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_AMIC; *ST_AMIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC AMCALLN=AMCALLN+1 %FINISH %IF POUT_P2<=0 %THEN ->AMTXSW(POUT_P2) CBT_AMTX=POUT_P2 CBT_TAGS=CBT_TAGS&X'7F'!X'20'; ! NO LONGER NEW BUT ACTIVE %FINISH POUT_DEST=X'40001'; ! PAGETURN/PAGE-IN POUT_SRCE=ME!X'8000000A'; ! REPLY TO ACTIVITY 10 POUT_P1=CBT_AMTX<<16!EPX %IF MONLEVEL&2#0 %THEN %C POUT_P2=VSPARM; ! NOT USED.FOR KMON ONLY %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF CBT_LINK&ADVISORY SEQ#0 %THEN PAGEOUT(VSSEG,VSEPAGE-2,CBT) %IF POUT_DEST#0 %THEN PTE=X'80000001'!POUT_P2 %AND ->ACT10 PROC_STATUS=PROC_STATUS!2; ! DEMAND PAGE PRIORITY ->RETURN !----------------------------------------------------------------------- ACTIVITY(10): ! EPAGE HERE ! P_P1=RUBBISH IDENT ! P_P2=STORE(EPAGE)_REALAD ! VSSEG,VSEPAGE&TSTPTR INTACT !! EPH: PROC_STATUS=PROC_STATUS&X'FFFFFFFD' PTE=X'80000001'!P_P2 ACT10: ! ENTERS HERE IF PAGE NOT TRANFRD ASP=TSTPTR AS(ASP)=AS(ASP)!LTOPBIT>>VSEPAGE ASB=TOPBIT>>ASP ASWAP=ASWAP!ASB ASWIP=ASWIP&(\ASB) EPN=EPN+1 ACNT_PTURNS=ACNT_PTURNS+1 ! ! PT==ARRAY(VIRTAD+LST(VSSEG)&X'0FFFFFF8'+VSEPAGE*EPAGESIZE<<2,PTF) ! %CYCLE I=0,1,EPAGESIZE-1 ! PT(I)=PTE+I<<10 ! %REPEAT ! THIS HAND CODE ASSUMES EPAGESIZE=4 I=VIRTAD+LST(VSSEG)&X'0FFFFFF8'+VSEPAGE*16 *LXN_I *LSS_PTE; *ST_(%XNB+0) *IAD_1024; *ST_(%XNB+1) *IAD_1024; *ST_(%XNB+2) *IAD_1024; *ST_(%XNB+3) ->ACTIVATE !-------------------------------------------- ACTIVITY(11): ! PAGE READ FAILURE %IF P_P3<0 %THEN ->DEAD POUT_DEST=LSN3<<16 POUT_P1=1 POUT_P2=VSSEG<<18!VSEPAGE*EPAGESIZE<<10 PON(POUT) ->EPH !----------------------------------------------------------------------- ! DEADLOCK RECOVERY DEAD: WORKSET(0); ! DEPART TO FREE STORE POUT_DEST=X'3000E' POUT_P1=PROCESS PON(POUT) ->RETURN !----------------------------------------------------------------------- AMTXSW(0): ! CHANGE BLOCK SIZE IN SITU ? WAIT(2,1); ! TRY AGAIN IN 1 SEC ->RETURN AMTXSW(-1): ! NO AMT CELLS AVAILABLE AMTXSW(-2): ! NOT ENOUGH GARBAGE DEACTIVATE(\ASFREE) ->ACTIVATE AMTXSW(-3): ! CHANGE BLOCK SIZE WHEN STILL IN USE PEPARM=19 ->PE !----------------------------------------------------------------------- ITIMERI:*JLK_%TOS ! INTERVAL TIMER INTERRUPTS ENTER HERE *LSS_%TOS ; *LSS_%TOS ! ! IF A SEMA HELD GIVE A SMALL AMOUNT MORE TIME WITHOUT LETTING NEXT ! PERSON ON RUNQ GET THE CPU AS HE MIGHT ALSO WANT THE SEMA ! %IF SEMAHELD#0 %START SEMAHELD=0 SSNP1==RECORD(PROC_STACK!X'40000') SSNP1_IT=TIMESLICE>>3; ! EIGHTH OF TIME SLICE %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE>>3 ACNT_LTIME=ACNT_LTIME+COM_ITINT*(TIMESLICE>>3) ->ACT %FINISH RTN=RTN+1 %IF RTN=1 %THEN %START PROC_RUNQ=CATTAB(PROC_CATEGORY)_RQTS2 %IF MONLEVEL&1#0 %THEN %C UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) %FINISH %ELSE %START %IF RTN=RTLIM %THEN %START POUT_DEST=X'3000B'; ! MORE TIME ON THE FLY ? POUT_SRCE=0 POUT_P1=PROCESS POUT_P2=EPN %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH SCHEDULE(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_ICC; *LSS_(5); *ST_ITT SERVIT(3)=SERVIT(3)+(IT-ITT) LCIT=LCIT-(IT-ITT) SERVIC(3)=SERVIC(3)+(IC-ICC) LCIC=LCIC-(IC-ICC) SERVN(3)=SERVN(3)+1 %FINISH %IF POUT_P1=0 %THEN %START WORKSET(0) POUT_DEST=X'30004'; ! OUT OF TIME POUT_SRCE=ME!1 POUT_P1=PROCESS POUT_P2=EPN; ! EPAGES USED SO FAR PON(POUT) ->RETURN %FINISH EPLIM=POUT_P1 RTLIM=POUT_P2 RTN=0 STROBE %IF POUT_P3#0; ! NEWCAT_STROBEI#0 %FINISH %ELSE %START I=CATTAB(PROC_CATEGORY)_STROBEI %IF I#0 %AND RTN-(RTN//I)*I=0 %THEN STROBE %FINISH %FINISH SSNP1==RECORD(PROC_STACK!X'40000') SSNP1_IT=TIMESLICE %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE ACNT_LTIME=ACNT_LTIME+COM_ITINT*TIMESLICE %IF RUNQ1#0 %OR (PREEMPTED!RUNQ2#0 %AND PROC_RUNQ=2) %START POUT_DEST=ME!2 PON(POUT) ->RETURN %FINISH ->ACTIVATE; ! START NEXT TSLICE AT ONCE !----------------------------------------------------------------------- ONFRUNQ: ! PUT ON FRONT OF RUNQ POUT_DEST=ME!2 ONFRUNQA: PROC_STATUS=PROC_STATUS!2; ! SET PRIORITY BIT PON(POUT) ->RETURN !----------------------------------------------------------------------- NOPAGES: ! NO EPAGES FOR PAGEFLT %IF EPLIMACTIVATE %FINISH %FINISH %IF XSTROBE<0 %THEN %START; ! HAD A CHANGE CONTEXT SINCE LAST STROBE STROBE %IF EPNACTIVATE;! GOT SOME BACK ! %FINISH WORKSET(1) POUT_DEST=X'30003'; ! OUT OF EPAGES POUT_SRCE=ME!1 POUT_P1=PROCESS POUT_P2=RTN; ! TIMESLICES USED SO FAR PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(7): ! MORE ALLOCATION AVAILABLE !----------------------------------------------------------------------- PROGERRI:*JLK_%TOS ! PROGRAM ERROR INTERRUPTS ENTER HERE *LSS_%TOS *LSS_%TOS *ST_PEPARM ! ! SOME P4 TAKES PHOTO ON PROGERRORS SO CLEAR INHIBIT PHOTOT BIT OR WE ! MAY LOSE THE PHOTO ON SUBSEQUENT M-C FAILURE ! %IF BASICPTYPE=4 %START *LSS_(X'4012'); *AND_X'FEFFFFFF'; *ST_(X'4012') %FINISH PE: ! SOFTWARE DETECTED ERRORS JOIN ! 16 = ILLEGAL SYSTEM CALL ! 17 = EXCESS INTRUCTIONS ! 18 = DISC READ FAILS ! 19 = CHANGE BLOCK SIZE ! 20 = H-W ERROR (OCP OR STORE) ! 21 = ILLEGAL OUT SIGOUTP_P1=PEPARM SIGOUTP_P2=PROC_STACK SIGOUTP_TYPE=2 SIGOUTP_SSN=CURSSN SIGOUTP_SSNAD=PROC_STACK SIGOUTP_SUSP=0 NEWSTK=LSTKSSN(2)<<18 %IF PROC_STACK=NEWSTK %THEN %START PRINT STRING("PROGRAM ERROR ON SIGNAL STACK CLASS="%C .STRINT(PEPARM&255)." SUBCLASS=".STRINT(PEPARM>>8&255)." ") ->TERMINATE %FINISH ->SIGACT !----------------------------------------------------------------------- OUTI:*JLK_%TOS ! LOCAL OUTS ENTER HERE *LSS_%TOS *ST_J *LSS_%TOS *ST_OUTN %IF 0<=OUTN<=MAXDIROUT %THEN %START %IF PROC_STACK=LSTKSSN(2)<<18 %AND 1< ILLEGAL OUT ! ALLOWS OUT 0,1,3,6,8,10,14,15 ! 16,19,27,28 FROM SIGNAL STACK ->DIROUT(OUTN) %IF INTEGER(J!X'40004')>>20&X'F'<=MAXOUTACR %FINISH ILLEGAL OUT: ! GIVE PROGRAM ERROR OUT ACR CHK PEPARM=21!OUTN<<8 ->PE FREACT: ! REACTIVATE AFTER INVALID OUT ! NB OUT19 USES SIGOUTP! ALLOUTP_DEST=-1 ->ACTIVATE REACT: ! REACTIVATE AFTER VALID OUT ALLOUTP_DEST=0 ->ACTIVATE !----------------------------------------------------------------------- TERMINATE: ! STOP THE PROCESS(EMERGENCY!) J=NEWSTK>>18+1; ! SSN+1 NUMBER J=LST(J)&X'0FFFFF80'; ! ITS REAL ADDRESS PRINTSTRING("FAILING SSN+1") DUMP TABLE(0,X'81000000'+J,72) ! CREATE STOPPING MSGE TO DIRECT ALLOUTP_P1=PROCESS ALLOUTP_P2=PROC_INCAR STRING(ADDR(ALLOUTP_P3))=PROC_USER ASDESTROY=0; ! PRESERVE EVERYTHING DOUT0: ! NORMAL STOPS JOIN HERE DEACTIVATE(\ASFREE) ASDESTROY=0 %IF SEMAHELD#0 %THEN %C OPMESS("PROC".STRINT(PROCESS)." DIES WITH SEMA") RETURN PTS ALLOUTP_DEST=(LOCSN1+1)<<16!X'17';! DIRECT=PROCESS 1 ! X'17' NOT YET PARAMETERISED !!! ALLOUTP_SRCE=(LOCSN1+PROCESS)<<16 PON(ALLOUTP) POUT_DEST=X'30008'; ! SCHEDULE/DESTROY POUT_SRCE=ME POUT_P1=PROCESS PON(POUT) ->RETURN !----------------------------------------------------------------------- DIROUT(0): ! DIRECTOR STOPS PROCESS(NORMAL) ASDESTROY=1; ->DOUT0; ! DESTROY ALL (REMAINING) FILES DIROUT(1): ! PRINT STRING FOR DIRECTOR %IF ALLOUTP_DEST>>24>31 %THEN ->FREACT PRINT STRING(STRING(ADDR(ALLOUTP_DEST))) ->REACT !----------------------------------------------------------------------- DIROUT(2): ! INPUT REQUEST MESSAGE %IF ALLOUTP_P3#IOSTAT_IAD %THEN ->ACTIVATE;! INPUT ALREADY HERE POUT=ALLOUTP POUT_DEST=X'00370006' POUT_SRCE=LSN3<<16!1 PON(POUT) SRCE=X'80000000'!LSN3; ! TOP BIT SET FOR INPUT WAIT ->SUSPWS !----------------------------------------------------------------------- DIROUT(3): ! DISCONNECT SEGMENT ! ALLOUTP_P1=SEG, P2#0 DESTROY VSSEG=ALLOUTP_P1 ->FREACT %UNLESS 0<=VSSEG>32&127 DA=CBTA(SST(VSSEG))_DA %IF TSTPTR#127 %THEN ASOUT(TSTPTR) ASDESTROY=0 LST(VSSEG)=LST(VSSEG)&X'FFFFFFFF00000000' %IF TSTPTR=127 %OR ALLOUTP_P2#0 %OR PROCESS<=3 %THEN ->REACT ! ! SINCE PROCESSES ARE ARE ALLOWED TO RUN ON AFTER DISCONNECT VERY ! LARGE NUMBERS OF PAGEOUTS AND CLEARS CAN BUILD UP. THIS RUINS RESPONSE ! SO IF THERE ARE A LARGE NUMBER OF CLEARS HOLD THIS PROCESS UNTIL ! PREVIOUS DISCONNECT(WHICH INVOLVED TRANSFERS) HAS COMPLETED ! ACTIVITY(16): ! RE-ENTRY AFTER WAIT FOR CLEARS %IF TSTPTR#127 %AND DCLEARS+PAGEFREES>100 %AND LASTDA#0 %C %AND CHECKDA(LASTDA)>0 %THEN WAIT(16,1) %AND ->RETURN LASTDA=DA ->REACT !----------------------------------------------------------------------- DIROUT(4): ! NOT USED ->FREACT !----------------------------------------------------------------------- DIROUT(5): ! PON FOR DIRECTOR SRCE=PROCESS+LOCSN1 DIRPONS: ! OTHER PONS JOIN HERE ! USE BYTEINTEGER TO GET DEST ! IN CASE UNASSIGNED CHECKING DEST=ALLOUTP_DEST>>16 %IF DEST=X'FFFF' %THEN %START; ! RELAY MESSAGE %IF FIND PROCESS=0 %THEN ->ACTIVATE;! NOT LOGGED ON %FINISH %ELSE %START %UNLESS 0<=DEST<=MAXSERV %THEN ->FREACT %FINISH %IF DEST#0 %THEN %START I=ALLOUTP_SRCE&X'FFFF' %IF SRCE=LSN3 %AND (I=0 %OR I=X'FFFF') %THEN ->FREACT ALLOUTP_SRCE=SRCE<<16!I PON(ALLOUTP) %FINISH POUT_DEST=ME!12 ->ONFRUNQA !----------------------------------------------------------------------- ACTIVITY(12): ! RE-ENTRY AFTER DIRECTOR PON PROC_STATUS=PROC_STATUS&(\2) %IF SRCE>LOCSN3 %THEN %START %IF SERV3_P<<2#0 %THEN ->ASYNCH %FINISH %ELSE %START SERV==SERVA(SRCE) %IF SERV_P<<2#0 %THEN SUPPOFF(SERV,ALLOUTP) %AND ->ACTIVATE %FINISH SUSPWS: !SUSPEND AWAITING A REPLY ! TRY TO STAY IN STORE IF CORE ! IS PLENTIFUL %IF SNOOZING=YES %THEN %START ->DEPART %IF PROC_STATUS&16#0 ->DEPART %UNLESS PROC_CATEGORY=3 %OR PROCESS<=3 %OR LOCKST#0 %C %OR (EPN*COM_USERS)>>1RETURN %FINISH %FINISH ACTIVITY(8):DEPART: ! SUSPED BUT MUST NOW GO WORKSET(1) POUT_DEST=X'30005'; ! SUSPEND POUT_SRCE=SRCE&X'7FFFFFFF'; ! TO UNINHIBIT SRCE IN "SCHEDULE" POUT_P1=PROCESS POUT_P2=EPN; ! EPAGES USED SO FAR POUT_P5=EPN POUT_P6=PROC_CATEGORY PON(POUT) SUSP=SRCE %IF PROC_STACK=LSTKSSN(2)<<18 %THEN PRINT STRING(" SUSPENDED IN SIGNAL STATE") %AND NEWSTK=LSTKSSN(2)<<18 %AND ->TERMINATE ->RETURN !----------------------------------------------------------------------- DIRPONREPLY: ! REPLY HAS WOKEN PROCESS UP SERV==SERVA(SUSP) DPR: SUPPOFF(SERV,ALLOUTP) SUSP=0 ->ACTIVATE !----------------------------------------------------------------------- DIROUT(6): ! PON & CONTINUE SRCE=PROCESS+LOCSN1 DIRPONC: ! OTHER PONS JOIN HERE DEST=ALLOUTP_DEST>>16 %IF DEST=X'FFFF' %THEN %START %IF FIND PROCESS=0 %THEN ->ACTIVATE %FINISH %ELSE %START %UNLESS 0<=DEST<=MAXSERV %THEN ->FREACT %FINISH %IF DEST#0 %THEN %START; ! DEST#0 PON &CONTINUE I=ALLOUTP_SRCE&X'FFFF' %IF SRCE=LSN3 %AND (I=0 %OR I=X'FFFF') %THEN ->FREACT ALLOUTP_SRCE=SRCE<<16!I PON(ALLOUTP) ->ONFRUNQ %FINISH ! DEST=0 TOFF & CONTINUE %IF SRCE>LOCSN3 %THEN %START %IF SERV3_P<<2#0 %THEN ->ASYNCH ALLOUTP_DEST=0 %FINISH %ELSE %START SERV==SERVA(SRCE) %IF SERV_P<<2#0 %THEN SUPPOFF(SERV,ALLOUTP) %C %ELSE ALLOUTP_DEST=0 %FINISH ->ACTIVATE !---------------------------------------------------------------------- DIROUT(7): ! ALTERNATE PON FOR DIRECTOR SRCE=PROCESS+LOCSN2 ->DIRPONS !----------------------------------------------------------------------- DIROUT(8): ! ALT PON & CONTINUE SRCE=PROCESS+LOCSN2 ->DIRPONC !----------------------------------------------------------------------- DIROUT(9): ! ASYNCHRONOUS REPLY PON & SUSPEND SRCE=LSN3 ->DIRPONS !----------------------------------------------------------------------- DIROUT(10): ! ASYNCHRONOUS REPLY PON & CONTINUE SRCE=LSN3 ->DIRPONC !----------------------------------------------------------------------- DIROUT(11): ! PON & WAIT IN STORE PONWAIT: DEST=ALLOUTP_DEST>>16 %UNLESS 0FREACT SRCE=ALLOUTP_SRCE ALLOUTP_SRCE=ME!13 PON(ALLOUTP) ->RETURN; ! WAIT IN STORE FOR REPLY !----------------------------------------------------------------------- ACTIVITY(13): ! REPLY TO PON & WAIT IN STORE ALLOUTP=P ALLOUTP_DEST=SRCE I=PROC_STACK+X'40014' INTEGER(I)=(INTEGER(I)-OUT18CHARGE)&X'1FFFFFF' INTEGER(I+4)=(INTEGER(I+4)-OUT18INS)&X'1FFFFFF' ->ACTIVATE !----------------------------------------------------------------------- DIROUT(12): ! NOMINATE STACK SSN I=ALLOUTP_P1; ! STACK NO J=ALLOUTP_P2; ! SSN %UNLESS 1<=I<=LSTKN %AND LSTKSSN(I)=0 %AND 4<=JFREACT LSTKSSN(I)=J LST(J!1)=LST(5)+(I-1)*X'80'; ! USE USERSTACK SSN+1 TO GET ACRS ->REACT !----------------------------------------------------------------------- DIROUT(13): ! DENOMINATE STACK I=ALLOUTP_P1; ! STACK NO %UNLESS 1<=I<=LSTKN %THEN ->FREACT J=LSTKSSN(I); ! SSN %UNLESS 0#J#PROC_STACK>>18 %THEN ->FREACT LST(J!1)=X'1FF3FF8000000000' LSTKSSN(I)=0 ->REACT !----------------------------------------------------------------------- DIROUT(14): ! SWOP STACK DIROUT(19): ! SWOP STACK FROM SIGNAL STACK I=ALLOUTP_P1; ! NEW LOCAL STACK NO K=ALLOUTP_P2 %UNLESS 1<=I<=LSTKN %THEN ->FREACT J=LSTKSSN(I) %UNLESS 0#J#PROC_STACK>>18 %THEN ->FREACT SSNP1==RECORD((J!1)<<18) %IF SSNP1_LNB>>18#J %OR SSNP1_LNB>>18#SSNP1_SF>>18 %OR %C SSNP1_PSR&3=0 %THEN ->FREACT NEWSTK=J<<18 ! MOVE IT & IC TO NEW STACK LONG INTEGER(NEWSTK!X'40014')=LONG INTEGER(PROC_STACK!X'40014') PROC_STACK=NEWSTK SUSP=K; ! GO BACK TO CORRECT SUSPEND STATUS %IF PROC_STACK=LSTKSSN(2)<<18 %THEN ALLOUTP==SIGOUTP %C %ELSE ALLOUTP==DIROUTP ->RESUSP !----------------------------------------------------------------------- DIROUT(15): ! SYSTEM CALL ERROR ! (AFTER STACK SWITCH) ! SUB-IDENT. IN OLD XNB PEPARM=INTEGER(PROC_STACK!X'40020')<<6!16 ->PE !----------------------------------------------------------------------- DIROUT(16): ! INSTRUCTION COUNTER INTERRUPT ! (AFTER STACK SWITCH) PEPARM=17; ! TREAT AS PROGRAM ERROR ->PE !----------------------------------------------------------------------- DIROUT(17): ! CHECK ACTIVE BLOCKS ON DESTROY J=0 %CYCLE I=0,1,7 RECHECK: K=INTEGER(DIROUTPAD+4*I) %IF K=0 %THEN %EXIT K=CHECKDA(K) %IF K#0 %THEN %START %IF K<0 %AND J>0 %THEN %C OPMESS("? BLK ACTIVTY ".STRHEX(INTEGER(DIROUTPAD+4*I)))%C %AND ->FREACT ! ! CAN BE A RACE CONDITIONS BETWEEN PONS ON STOPPING A PROCESS. SO ! IF AMT BLOCK STILL HAS USERS WAIT JUST ONCE TO CLEAR ANY BACKLOG ! OF PONNED DEALLOCATES. CONDITION SEEN ON A DUAL SUSPECTED AT KENT ! %IF J=10 %THEN OPMESS("BLOCK PAGE-OUTS ?") %AND ->FREACT WAIT(14,PAGEOUT DELAY(J)) ->RETURN %FINISH %REPEAT ->REACT !----------------------------------------------------------------------- ACTIVITY(14): ! REPLY FROM DESTROY CHECK J=J+1 ->RECHECK !----------------------------------------------------------------------- DIROUT(18): ! CHECK & FORWARD I-O REQUEST ! P5=WRIT<<31!ACR<<24!LEN ! P6=ADDRESS %IF CHECK RES(ALLOUTP_P5>>31,ALLOUTP_P5&X'FFFFFF',ALLOUTP_P6)#0 %C %THEN ->FREACT; ! NOT RESIDENT ALLOUTP_P5=PROC_ACTW0!ALLOUTP_P5<<4>>28;! LSTBR!ACR ALLOUTP_P6=PROC_LSTAD ->PONWAIT !------------------------------------------------------------------- !----------------------------------------------------------------------- DIROUT(20): ! PROCMON ENABLE DIROUT(21): ! DISABLE PROCMON DIROUT(22): ! PROCMON ON DIROUT(23): ! PROCMON OFF DIROUT(24): ! PROCMON INSERT TEXT ->FREACT DIROUT(25): ! LOCK IO AREA AND RETURN ST ADDR ! P_P5/P_P6=DESCR TO AREA. ALLOUTP_P5=ALLOUTP_P5&X'FFFFFF'; ! P_P1=1 LOCK ,=-1 UNLOCK %IF ALLOUTP_P1>0 %AND CHECK RES(0,ALLOUTP_P5,ALLOUTP_P6)#0 %C %THEN ->FREACT %IF LOCKST=0 %THEN %START; ! NO SEG TABLE AROUND ->FREACT %UNLESS ALLOUTP_P1>0 %IF MULTIOCP=YES %THEN %START *INCT_(STORESEMA) *JCC_8, SEMALOOP(STORESEMA) SSEMAGOT2: %FINISH %IF FREE EPAGES>0 %THEN %START STOREX=QUICK EPAGE(0) %IF MULTIOCP=YES %THEN STORESEMA=-1 ->ACTF %FINISH POUT_SRCE=ME!X'F' POUT_P2=0; ! CLEAR TO ZERO GET EPN=GET EPN+1 %IF MULTIOCP=YES %THEN STORESEMA=-1 %IF PAGEFREES<=1 %AND GETEPN>=MPLEVEL+1-COM_NOCPS %THEN %C POUT_DEST=X'20000' %AND PON(P) POUT_DEST=X'50000' PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(15): ! REPLY FROM GET EPAGE ! WITH PAGE FOR LOCKED SEG TABLE STOREX=P_P2 %IF STOREX=0 %THEN ALLOUTP_DEST=-1 %AND ->DEAD ! DEADLOCK PAGE. DIR WILLTRY AGN ACTF: LOCKSTX=STOREX LOCKST=STORE(STOREX)_REALAD&X'0FFFFFFF';! COULD BE FLAWED K=LOCKST+VIRTAD J=8*LSTLEN; ! USE REST OF EPAGE AS PAGETABLES INTEGER(K+4)=J; ! HEAD OF PT LIST(F BIT NOT SET!) %WHILE J<=1024*(EPAGESIZE-2) %CYCLE INTEGER(K+J)=J+1024 J=J+1024 %REPEAT %FINISH %ELSE K=LOCKST&X'0FFFFFF0'+VIRTAD VSSEG=ALLOUTP_P6>>18 %IF ALLOUTP_P1>0 %START; ! LOCK AREA %IF LONGINTEGER(K+8*VSSEG)#0 %THEN ->FREACT;! SEG LOCKED ALREADY %IF INTEGER(K+4)=0 %THEN ->FREACT;! ALL PAGETABLES USED LTAD=K+INTEGER(K+4); ! VIRT AD OF PAGETABLE INTEGER(K+4)=INTEGER(LTAD) LOCKST=LOCKST+(1<<28); ! KEEP COUNT IN TOP 4 BITS LONGINTEGER(K+8*VSSEG)=LST(VSSEG)&X'EFFFFF8080000001' %C !(LTAD-VIRTAD) %FINISH %ELSE %START; ! UNLOCK AREA %IF LONGINTEGER(K+8*VSSEG)=0 %THEN ->FREACT LTAD=(INTEGER(K+8*VSSEG+4)&X'0FFFFFF0'+VIRTAD) INTEGER(LTAD)=INTEGER(K+4) INTEGER(K+4)=LTAD-K LONGINTEGER(K+8*VSSEG)=0 LOCKST=LOCKST-1<<28 %IF LOCKST>>28=0 %START POUT_DEST=X'60000' POUT_P2=LOCKSTX P_SRCE=ME!15 %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH RETURN EPAGE(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_RETIT; *ST_RETIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_RETIC; *ST_RETIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC RETCALLN=RETCALLN+1 %FINISH LOCKST=0 %FINISH %FINISH PT==ARRAY(VIRTAD+LST(VSSEG)&X'0FFFFFF8',PTF) J=ALLOUTP_P6-VSSEG<<18 %CYCLE I=J>>10,1,(J+ALLOUTP_P5-1)>>10 %IF ALLOUTP_P1>0 %THEN K=PT(I) %ELSE K=0 INTEGER(LTAD+4*I)=K %REPEAT %CYCLE VSEPAGE=J>>EPAGESHIFT,1,(J+ALLOUTP_P5-1)>>EPAGESHIFT CBTP=SST(VSSEG)+VSEPAGE//MAXBLOCK EPX=VSEPAGE&(MAXBLOCK-1) CBT==CBTA(CBTP) %IF CBT_AMTX=0 %THEN ->FREACT %IF ALLOUTP_P1>0 %START POUT_DEST=X'40001'; ! PAGE IN AGAIN TO LOCK POUT_SRCE=ME!X'8000000A' POUT_P3=0 %FINISH %ELSE %START POUT_DEST=X'40002'; ! PAGE OUT TO UNLOCK POUT_SRCE=0 POUT_P2=8+4; ! WRITTEN TO+UPDATE DRUM %FINISH POUT_P1=CBT_AMTX<<16!EPX %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF POUT_DEST=0 %AND ALLOUTP_P1>0 %THEN %C MONITOR("LOCK GOES WRONG?") %REPEAT ALLOUTP_P5=PROC_ACTW0 ALLOUTP_P6=LOCKST&X'0FFFFFF0' ->REACT !----------------------------------------------------------------------- DIROUT(26): ! CHANGE CONTEXT CLEAR ACCESSED BITS XSTROBE=XSTROBE!X'80000000'; ! NOTE CHANGED CONTEXT ->ACTIVATE DIROUT(27): ! EXIT TO NOMINATED ENV(SAME STK) ! ALLOUTP_P1-5==LNB->SF K=PROC_STACK ->FREACT %UNLESS K=ALLOUTP_P1>>18<<18=ALLOUTP_P5>>18<<18 K=K+X'40000' %CYCLE I=0,4,16 INTEGER(K+I)=INTEGER(ADDR(ALLOUTP)+8+I) %REPEAT ->ACTIVATE !----------------------------------------------------------------------- DIROUT(28): ! HARD STORE ERROR IN PROCESS ! FROM ROUTINE SYSERR ACTIVITY(4): ! L-C HAS CRASHED ONE OCP IN DUAL ! FROM MULTIPROCESSOR INT ROUTINE PEPARM=20 ->PE !----------------------------------------------------------------------- ICOUNTERI:*JLK_%TOS ! INSTRUCTION COUNTER INTERRUPTS ! STACK NOT SWITCHED YET !!! *STXN_%TOS; ! SAVE XNB *LXN_X'14006C'; ! ADDR(ICREVS) *SLB_(%XNB+0); ! SAVE B & LOAD ICREVS *SBB_1 *STB_(%XNB+0) *CPB_0 *LB_%TOS; ! RESTORE B & XNB *LXN_%TOS *JCC_11,; ! JUMP IF B>=0 *OUT_16; ! TO SWITCH STACKS OUT16:*EXIT_-1; ! TO RESTORE PM,CC,ACS ETC. ! SIGNAL MECHANISM INVOKED AT DIROUT(16) !----------------------------------------------------------------------- %INTEGERFN CHECKDA(%INTEGER DA) !*********************************************************************** !* CHECKS A DISC ADDRESSAND REPLIES AS FOLLOWS * !* RESULT=0 ADDRESS NOT ACTIVE * !* RESULT=1 TRANSFERS OR CLEARS IN PROGRESS * !* RESULT<0 OTHER USERS OF SAME * !*********************************************************************** %RECORD POUT(PARMF) POUT_DEST=X'80005' POUT_P1=DA %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_AMIT; *ST_AMIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_AMIC; *ST_AMIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC AMCALLN=AMCALLN+1 %FINISH %RESULT=POUT_DEST %END %INTEGERFN CHECK RES(%INTEGER WRIT,LEN,AD) !*********************************************************************** !* CHECKS THAT THE AREA OF LEN AT AD IS LOCKED DOWN AND ORS WRIT * !* INTO THE WRITE MARKER IN THE PAGE TABLES * !* RESULT=0 AREA LOCKED DOWN * !* RESULT#0 SOME OF THE AREA IS NOT RESIDENT * !*********************************************************************** %INTEGER I,J %INTEGERARRAYNAME PT %CYCLE I=AD>>10,1,(AD+LEN-1)>>10; ! THROUGH THE EPAGES PT==ARRAY(VIRTAD+(LST(I>>8)&X'0FFFFFF8'),PTF) J=I&X'FF' %IF PT(J)&1=0 %THEN %RESULT=1 PT(J)=PT(J)!WRIT<<28 %REPEAT %RESULT=0 %END !----------------------------------------------------------------------- %ROUTINE PAGEOUT(%INTEGER VSSEG,VSEPAGE,%RECORDNAME CBT) !*********************************************************************** !* PAGES OUT A PAGE AS A RESULT OF WORKING ON A SEQUENTIAL FILE * !* NOTE PAGE<0 IS VALID INDICATING PREVIOUS SEGMENT(MUST CHECK!) * !*********************************************************************** %RECORDSPEC CBT(CBTF) %RECORD P(PARMF) %INTEGER I,ASP %LONGINTEGER L %IF VSEPAGE<0 %THEN %START; ! PREVIOUS SEGMENT %IF CBT_LINK&CONTINUATN BLK=0 %THEN %RETURN VSSEG=VSSEG-1 VSEPAGE=VSEPAGE+SEGEPSIZE %FINISH L=LST(VSSEG) ASP=L>>32&127 %IF ASP#127 %AND AS(ASP)&(LTOPBIT>>VSEPAGE)#0 %START;! PAGE IN STORE I=VIRTAD+L&X'0FFFFFF8'+VSEPAGE*16 *LXN_I *LSS_(%XNB+0); *OR_(%XNB+1) *OR_(%XNB+2); *OR_(%XNB+3) *ST_I; *LSQ_0; *ST_(%XNB+0); ! CLEAR PT AFTER NOTING MARKERS I=I<<3>>31<<3 CBT==CBTA(SST(VSSEG)+VSEPAGE//MAXBLOCK) P_DEST=X'40002'; ! PAGETURN/PAGE-OUT P_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1)) P_P2=I; ! NOTE NO DRUM OR RECAP %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(P) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF I&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 EPN=EPN-1 AS(ASP)=AS(ASP)!!(LTOPBIT>>VSEPAGE) %FINISH %END %ROUTINE ASOUT(%INTEGER ASP) !*********************************************************************** !* DISCARD ONE SEGMENT (INDEXED BY ASP) FROM ACTIVE STORAGE. * !* MAY INVOLVE WRITING PAGES OUT FROM STORE AND WILL INVOLVE * !* RETURNING ANY AMTXS ALLOCATED * !*********************************************************************** %RECORDNAME CBT(CBTF) !%INTEGERARRAYNAME PT; ! NOT USED IN HAND CODING %INTEGER MARK,VSSEG,VSEPAGE,SH,CBTP,PBLENS,ASB,POFL,I,PTAD,LASTEP %LONGINTEGER MASK VSSEG=ASEG(ASP) LASTEP=(LST(VSSEG)>>(32+EPAGESHIFT))&(SEGEPSIZE-1) %IF AS(ASP)=0 %THEN ->NOP MASK=AS(ASP) PTAD=VIRTAD+LST(VSSEG)&X'0FFFFFF8' ! PT==ARRAY(PTAD,PTF) CBTP=SST(VSSEG) CBT==CBTA(CBTP) PBLENS=MAXBLOCK VSEPAGE=-1 %WHILE MASK#0 %CYCLE *LSD_MASK ; *SHZ_SH ; *USH_1 ; *ST_MASK VSEPAGE=VSEPAGE+SH+1 %IF VSEPAGE>=PBLENS %START PBLENS=PBLENS+MAXBLOCK CBTP=CBTP+1 CBT==CBTA(CBTP) %FINISH ! PAGE=VSEPAGE*EPAGESIZE ! MARK=0 ! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1 ! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER ! PT(I)=0; ! MARK PAGE AS UNAVAILABLE ! %REPEAT ! THIS HANDCODING ASSUMES EPAGESIZE=4 ! I=PTAD+4*EPAGESIZE*VSEPAGE *LXN_I *LSS_(%XNB+0); *OR_(%XNB+1); *OR_(%XNB+2); *OR_(%XNB+3) *ST_MARK *LSQ_0 *ST_(%XNB+0) %IF ASDESTROY=0 %THEN POFL=MARK<<3>>31<<3 %ELSE POFL=0 ! NOTE:- DRUM NOT UPDATED POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1)) POUT_P2=POFL %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 EPN=EPN-1 %REPEAT NOP: CBTP=SST(VSSEG) CBT==CBTA(CBTP) %CYCLE %IF CBT_TAGS&X'20'#0 %THEN %START POUT_DEST=X'80002'; ! RETURN AMTX POUT_SRCE=0 POUT_P1=PROCESS POUT_P2=CBT_AMTX POUT_P3=ASDESTROY; ! DESTROY FLAG %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_AMIT; *ST_AMIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_AMIC; *ST_AMIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC AMCALLN=AMCALLN+1 %FINISH CBT_AMTX=0; ! NEW BITS CBT_TAGS=CBT_TAGS&X'DF' ACNT_PTURNS=ACNT_PTURNS+POUT_P6;! CHARGE FOR ANY CLEARS %FINISH %IF LASTEP>ASP ASWAP=ASWAP&(\ASB) ASWIP=ASWIP&(\ASB) ! ! IT IS JUST POSSIBLE FOR A SEGMENT TO BE REACTIVATED AND BECOME ! INACTIVE AGAIN IN THE SAME RESIDENCE(EXTENDED ON THE FLY) TO ! PREVENT PREMATURE DISCARDING OF DRUM IN THIS RARE CASE REMOVE BIT ! FROM OLD ASIPS ! OLDASWIPS(0)=OLDASWIPS(0)&(\ASB) ASFREE=ASFREE!ASB %END !----------------------------------------------------------------------- %ROUTINE STROBE !*********************************************************************** !* WHIP THROUGH ALL THE ACTIVE PAGES IN EACH ACTIVE SEGMENT * !* ANY PAGES NOT REFERNECED ARE PAGED OUT. THE REFERENCE BITS ARE * !* CLEARED IN CASE THIS PAGES IS NOT USED FURTHER. * !* A CRITICAL ROUTINE FOR PERFORMANCE HENCE HAND CODING * !*********************************************************************** %RECORDNAME CBT(CBTF) !%INTEGERARRAYNAME PT; ! NOT USED IN HANDCODING ! %CONSTINTEGER USEMASK=X'DFFFFFFF' %CONSTLONGINTEGER DUSEMASK=X'DFFFFFFFDFFFFFFF' %INTEGER MARK,POFL,ASMASK,ASP,VSSEG,VSEPAGE,PTB,CBTP,PBLENS,ASB, %C PTEAD,I %IF MONLEVEL&16#0 %THEN %START %INTEGER CAT %FINISH %LONGINTEGER EPMASK ASMASK=ASWAP; ! ALL SLOTS WITH ACTIVE PAGES ASP=-1 %IF MONLEVEL&16#0 %THEN %START CAT=PROC_CATEGORY STROBEN(CAT)=STROBEN(CAT)+1 STREPN(CAT)=STREPN(CAT)+EPN %FINISH %WHILE ASMASK#0 %CYCLE; ! FOR EACH ACTIVE SEGMENT *LSS_ASMASK ; *SHZ_%B ; *USH_1 ; *ST_ASMASK *ADB_ASP; *ADB_1; *STB_ASP VSSEG=ASEG(ASP) CBTP=SST(VSSEG) CBT==CBTA(CBTP) %IF CBT_LINK&ADVISORY SEQ#0 %THEN %CONTINUE PBLENS=MAXBLOCK EPMASK=AS(ASP) VSEPAGE=-1 PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8' ! PT==ARRAY(PTB,PTF) %WHILE EPMASK#0 %CYCLE; ! FOR EACH ACTIVE PAGE *LSD_EPMASK ; *SHZ_%B ; *USH_1 ; *ST_EPMASK *ADB_VSEPAGE; *ADB_1; *STB_VSEPAGE %IF VSEPAGE>=PBLENS %START PBLENS=PBLENS+MAXBLOCK CBTP=CBTP+1 CBT==CBTA(CBTP) %FINISH ! PAGE=EPAGE*EPAGESIZE ! MARK=0 ! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1 ! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER ! PT(I)=PT(I)&USEMASK ! %REPEAT ! ! THIS HAND CODE ASSUMES THAT EPAGESIZE IS 4 ! PTEAD=PTB+4*EPAGESIZE*VSEPAGE *LXN_PTEAD *LSD_(%XNB+0); *OR_(%XNB+2) *STUH_%B; *OR_%B *ST_MARK *LSD_(%XNB+0) ; *AND_DUSEMASK ; *ST_(%XNB+0) *LSD_(%XNB+2) ; *AND_DUSEMASK ; *ST_(%XNB+2) POFL=MARK<<3>>31<<3!(1<<2!1);! WRIT,UPDATE DRUM&RECAPTURE %IF MARK>>29&1=0 %THEN %START;! STROBE OUT %IF MONLEVEL&16#0 %THEN STROUT(CAT)=STROUT(CAT)+1 POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1)) POUT_P2=POFL %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 ! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1 ! PT(I)=0 ! %REPEAT ! ! THIS BIT OF HAND CODE ASSUMES EPAGESIZE=4 ! *LXN_PTEAD *LSQ_0 *ST_(%XNB+0) EPN=EPN-1 AS(ASP)=AS(ASP)&(\(LTOPBIT>>VSEPAGE)) %FINISH %REPEAT %IF AS(ASP)=0 %THEN %START ASB=TOPBIT>>ASP ASWAP=ASWAP&(\ASB) ASWIP=ASWIP!ASB %FINISH %REPEAT XSTROBE=XSTROBE&X'FFFF'+1; ! LOSE CHNGE CONTEXT BIT IF SET %END !----------------------------------------------------------------------- %ROUTINE WORKSET(%INTEGER RECAP) !*********************************************************************** !* PAGE OUT THE WORKING SET BY GOING THROUGH THE ACTIVE SEGMENT * !* LIST AND WRITING OUT ACTIVE EPAGES IN THAT SEGMENT * !*********************************************************************** %RECORDNAME CBT(CBTF) !%INTEGERARRAYNAME PT; ! NEEDED IN ALL IMP VERSION ONLY %INTEGER MARK,POFL,ASMASK,VSSEG,VSEPAGE,ASP,CBTP,PBLENS,I,J,PTB %LONGINTEGER EPMASK ASMASK=ASWAP ASP=-1 %WHILE ASMASK#0 %CYCLE; ! THROUGH ACTIVE SEGMENNTS *LSS_ASMASK; *SHZ_%B; *USH_1 *ST_ASMASK; *ADB_1; *ADB_ASP; *STB_ASP VSSEG=ASEG(ASP) CBTP=SST(VSSEG) CBT==CBTA(CBTP) PBLENS=MAXBLOCK EPMASK=AS(ASP) VSEPAGE=-1 PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8' ! PT==ARRAY(PTB,PTF) %WHILE EPMASK#0 %CYCLE *LSD_EPMASK; *SHZ_%B; *USH_1; *ST_EPMASK *ADB_1; *ADB_VSEPAGE; *STB_VSEPAGE %IF VSEPAGE>=PBLENS %START PBLENS=PBLENS+MAXBLOCK CBTP=CBTP+1 CBT==CBTA(CBTP) %FINISH ! PAGE=VSEPAGE*EPAGESIZE ! MARK=0 ! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1 ! MARK=MARK!PT(I); ! GANG MARKERS TOGETHER ! %REPEAT ! ! THIS HAND CODING ASSUMES EPAGESIZE=4 ! I=PTB+4*EPAGESIZE*VSEPAGE *LXN_I *LSD_(%XNB+0); *OR_(%XNB+2) *STUH_%B; *OR_%B *ST_MARK POFL=MARK<<3>>31<<3!1<<2!RECAP;! WRIT & UPDATE DRUM & RECAPTURE POUT_DEST=X'40002'; ! PAGETURN/PAGE-OUT POUT_P1=CBT_AMTX<<16!(VSEPAGE&(MAXBLOCK-1)) POUT_P2=POFL %IF MONLEVEL&4#0 %THEN %START *LSS_(6); *ST_IC; *LSS_(5); *ST_IT %FINISH PAGETURN(POUT) %IF MONLEVEL&4#0 %THEN %START *LSS_(5); *IRSB_IT; *IMYD_1; *ST_%TOS *IAD_PTIT; *ST_PTIT *LSD_LCIT; *ISB_%TOS; *ST_LCIT *LSS_(6); *IRSB_IC; *IMYD_1; *ST_%TOS *IAD_PTIC; *ST_PTIC *LSD_LCIC; *ISB_%TOS; *ST_LCIC PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 %IF MARK&(1<<29)=0 %THEN EPN=EPN-1 %REPEAT AS(ASP)=0 %REPEAT ASWAP=0 ! ! SHUFFLE DOWN LIST OF OLD ASWIPS AND REMOVE ANY SEGMENTS NOT USED OVER ! "RESIDENCES" RESIDENCES PERIODS FROM ACTIVE LIST ! J=ASWIP %CYCLE I=MAXRESIDENCES-1,-1,0 J=J&OLD ASWIPS(I) %IF I RETURN PTS %END !----------------------------------------------------------------------- %ROUTINE CLEAR ACCESSED BITS !*********************************************************************** !* CALLED AFTER A "CHANGE CONTEXT" TO CLEAR THE USED BITS ON EACH * !* PAGE ACTUALLY IN CORE. THEREAFTER A STROBE OR EXTRA STROBE WILL * !* DISCARD ANY PAGES FROM THE OLD CONTEXT WITHOUT BOUNCING PROCESS * !*********************************************************************** !%INTEGERARRAYNAME PT; ! NOT USED IN HAND CODED VERSION %CONSTINTEGER USEMASK=X'DFFFFFFF' %CONSTLONGINTEGER DUSEMASK=X'100000000'*USEMASK!USEMASK %INTEGER ASMASK, PTB, VSEPAGE, ASP, I %LONGINTEGER EPMASK ASMASK=ASWAP; ! ACTIVE SLOTS WITH ACTIVE PAGES ASP=-1 %WHILE ASMASK#0 %CYCLE; ! FOR EACH ACTIVE SEGMENT *LSS_ASMASK; *SHZ_%B; *USH_1; *ST_ASMASK *ADB_ASP; *ADB_1; *STB_ASP VSSEG=ASEG(ASP) VSEPAGE=-1 EPMASK=AS(ASP) PTB=VIRTAD+LST(VSSEG)&X'0FFFFFF8' ! PT==ARRAY(PTB,PTF) %WHILE EPMASK#0 %CYCLE; ! FOR EACH ACTIVE PAGE *LSD_EPMASK; *SHZ_%B; *USH_1; *ST_EPMASK *ADB_VSEPAGE; *ADB_1; *STB_VSEPAGE ! PAGE=VSEPAGE*EPAGESIZE ! %CYCLE I=PAGE,1,PAGE+EPAGESIZE-1 ! PT(I)=PT(I)&USEMASK ! %REPEAT ! ! THIS HAND CODE ASSUMES EPAGESIZE=4 ! I=PTB+4*EPAGESIZE*VSEPAGE *LXN_I *LSD_(%XNB+0); *AND_DUSEMASK; *ST_(%XNB+0) *LSD_(%XNB+2); *AND_DUSEMASK; *ST_(%XNB+2) %REPEAT %REPEAT %END !----------------------------------------------------------------------- %ROUTINE DEACTIVATE(%INTEGER MASK) !*********************************************************************** !* DEACTIVATE ALL ACTIVE SEGMENTS DEFINED BY BITMASK "MASK" * !*********************************************************************** %INTEGER ASP ASP=-1 %WHILE MASK#0 %CYCLE *LSS_MASK; *SHZ_%B; *USH_1; *ST_MASK *ADB_ASP; *ADB_1; *STB_ASP ASOUT(ASP) %REPEAT %END %ROUTINE FREE AS !*********************************************************************** !* CALLED WHEN ASFREE IS ZERO. IT DEACTIVATES A SEGMENT. FIRST * !* TRY TO DEACTIVATE THE OLDEST CURRENTLY INACTIVE SEGMENT. * !* IF ALL SEGMENTS ARE ACTIVE ONE IS CHOSEN AT RANDOM * !*********************************************************************** %INTEGER I,J,K %IF ASWIP=0 %THEN %START *RRTC_0; *AND_31; ! USE BOTTOM 5 BITS OF CLOCK *ST_I; ! AS PSEUDO RANDOM NO I=1<>18 %CYCLE I=1,1,LSTKN %IF J=LSTKSSN(I) %THEN %RESULT=I %REPEAT MONITOR("CURRENT STACK ?") %END !----------------------------------------------------------------------- %ROUTINE WAIT(%INTEGER DACT,N) POUT_DEST=X'A0002' POUT_SRCE=0 POUT_P1=ME!DACT POUT_P2=N PON(POUT) %END !----------------------------------------------------------------------- %END !----------------------------------------------------------------------- %END !*********************************************************************** !* THESE THREE ROUTINES ARE SYTEMCALLED DIRECTLY FROM USER * !*********************************************************************** %INTEGERFN REQUEST INPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %RECORDNAME IOSTAT(IOSTATF) %RECORDNAME DIROUTP(PARMF) IOSTAT==RECORD(X'140048') DIROUTP==RECORD(DIROUTPAD) %UNLESS IOSTAT_OUTBUFLEN>0 %AND 0<=OUTPUT POSN0 %AND 0<=TRIGGER POSN0 %AND 0<=OUTPUT POSN