! %include "ercc07.ibmsup_page0" ! ! These const integers define sizes and layout of important tables ! they have to be here to be global to all routines including I/O ones ! %constlonginteger DISAWAIT=PSW0!X'2000000000000' %constlonginteger ALLOW INTS=x'0306000000000000' %constlonginteger ONE SECOND=x'00000000F4240000' ! %ownlonginteger PSW,WPSW,L ! %include "ercc07.ibmsup_lcform1s" ! %externalintegerfnspec REQUEST INPUT(%integer OUTPUT POSN,TRIGGER POSN) %externalintegerfnspec REQUEST OUTPUT(%integer OUTPUT POSN,TRIGGER POSN) %externalintegerfnspec CHANGE CONTEXT %externalroutine SUP01 !----------------------------------------------------------------------- %ownstring (3) SUPID="01A" !--------------------- ! EMAS/370 vsn 1A ! %conststring (3) CHOPID="01A"; ! EARLIEST COMPATABLE CHOPSUPE !----------------------------------------------------------------------- %include "ercc08.comf370" %include "ercc08.page0f" %constinteger EPAGESHIFT=12; ! 4*1024==1<<12 !----------------------------------------------------------------------- ! MISC. ROUTINE SPECS %externalstringfnspec HTOS(%integer N,PL) %externalstring (15) %fnspec STRINT(%integer N) %externalstring (8) %fnspec STRHEX(%integer N) %externalstring (63) %fnspec STRSP(%integer N) %externalroutinespec PKMONREC(%string (20) TEXT, %record (PARMF) %name P) %externalroutinespec MONITOR(%string (63) S) %externalroutinespec MOVE(%integer LEN,FROM,TO) %externalroutinespec NDIAG %alias "S#NDIAG"(%integer PC,LNB,FAULT,XTRA) %externalroutinespec OPMESS(%string (63) S) %externalroutinespec DISPLAY TEXT(%integer SCREEN,LINE,CHAR, %string (41) S) %externalroutinespec UPDATE TIME %externalroutinespec DPONPUTONQ(%record (PARMF) %name P) %externalroutinespec DUMP TABLE(%integer TABNO,ADR,LEN) %if MONLEVEL&4#0 %start %longintegername IDLEIT,NOWORKIT,LCIT,FLPIT,BLPIT,PTIT,PDISCIT,RETIT,AMIT %integername IDLEN,NOWORKN,LCN,FLPN,BLPN,PTCALLN,PDISCCALLN,RETCALLN, AMCALLN %finish %shortintegername FSTASL,BSTASL %integer I,J,K,FREEEPAGES,SHAREDEPS,UNALLOCEPS,OVERALLOC,MAXP4PAGES,P4PAGES, SXPAGES,NPQ,OLDLNB,IDLE,DONT SCHED,MPLEVEL,PAGEFREES,DCLEARS,GETEPN, PREEMPTED,MAX OVERALLOC,SNOOZTIME %longinteger L %string (3) STRPROC !----------------------------------------------------------------------- ! CONFIGURATION DECLARATIONS !----------------------------------------------------------------------- %constintegerarrayname SEG TAB=SEGTABVA %if XA=YES %thenstart %integerarrayformat PTF(0:63) %finishelsestart %shortintegerarrayformat PTF(0:63); ! page table format %finish %record (CONTEXTF) LC ICONTEXT; ! initial Local controller context !----------------------------------------------------------------------- ! STORE TABLE ETC. DECLARATIONS %recordformat STOREF(%shortinteger FLAGS,USERS,LINK,BLINK,FLINK) %constrecord (STOREF) %arrayname STORE=STORE0AD; ! one record per page %constinteger OVERALLOC PERCENT=25 %constinteger STOREFSIZE=10; ! size of element of store array %externalinteger STORE SEMA=-1 %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 %if XA=NO %thenstart %constinteger MAXAMTAK=32 %constinteger MAXAMTDDK=64 %else %constinteger MAXAMTAK=MAXPROCS//2 %constinteger MAXAMTDDK=MAXPROCS %finish %recordformat AMTF(%integer DA, %shortinteger DDP,USERS,LINK, %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 %constrecord (AMTF) %arrayname AMTA=AMTASEG<>2) %integerarrayname PROC PICT; ! SPACE FOR PROCESS PICTURE PROC PICT==ARRAY(COM_PROC PICT AD,PROC PICTF) PROC PICT(0)=OPERSPACE; ! FIRST WORD=LENGTH OF REM !----------------------------------------------------------------------- ! LOCAL CONTROLLER DECS ETC. %routinespec LOCAL CONTROL %routinespec GLOBAL CONTROL %ownintegerarrayformat LSTF(0:LSTLEN-1) %owninteger TIMESLICE=X'4000'; ! 131072 MICROSECS %owninteger OUT18CHARGE=X'800'; ! CHARGE FOR OUT 18 =8 MILLESECS %owninteger OUT18INS; ! CHARGE *INS RATE %if XA=AMDAHL %start %constbyteinteger API=x'0C' %finishelsestart %constbyteinteger API=X'04' %finish %ownbyteinteger ALLOW PERI INTS=API; ! changed in schedule - act 0 %ownbyteinteger MASKPX=API; ! mask peri & external ints ! COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE ! %if COM_TSLICE>0 %then TIMESLICE=COM_TSLICE//COM_ITINT OUT18CHARGE=TIMESLICE>>3; ! ONE EIGHTH OF TSLICE OUT18INS=OUT18CHARGE*COM_INSPERSEC*COM_ITINT//1000 ! ! Set up kernel context ! *mvi_640(0),0; ! flag byte.... ! ... 0 = executing in kernel ! ff = executing in LC or user *stm_4,14,656(0); ! general registers *stctl_0,11,704(0); ! control registers INTEGER(704)=INTEGER(704)!X'800'; ! enable clock comparator I=INTEGER(704) *lctl_0,0,I ! ! set up initial Local Controller context ! used by create process in Schedule ! PSW=PSW0 *basr_1,0; *using_1 *la_2,; *drop_1 *st_2,PSW+4 LC ICONTEXT_PSW=PSW I=ADDR(LC ICONTEXT) *l_1,I *mvc_24(44,1),656(0); ! GRs *mvc_104(48,1),704(0); ! CRs LC ICONTEXT_GR(11)=ADDR(LC TABLES_END) LC ICONTEXT_CPU TIMER=MAX CPU TIMER ! FSTASL==STORE(0)_FLINK BSTASL==STORE(0)_BLINK SPSTOREX=0 GETEPN=0 PREEMPTED=0; ! NO PROCESS PRE-EMPTED DONT SCHED=0 FREE EPAGES=STORE(0)_LINK; ! LEFT HERE BY CHOPSUPE !----------------------------------------------------------------------- %cycle I=0,1,MAXPROCS PROCA(I)=0 %repeat I=PPINIT(NEW EPAGE) OVERALLOC=OVERALLOC PERCENT*FREE EPAGES//100; ! 25% OVERALLOCATION MAX OVERALLOC=OVERALLOC SHAREDEPS=0 UNALLOCEPS=FREEEPAGES+OVERALLOC P4PAGES=0 SXPAGES=0 MAXP4PAGES=P4PERCENT*COM_SEPGS//100 NPQ=0 IDLE=0 %if SNOOZING=YES %then SNOOZTIME=20 %begin %record (PARMF) P !----------------------------------------------------------------------- ! INITIALISE DEVIO & DISC ROUTINES P_DEST=X'300002' P_P1=COM_SLDEVTABAD P_P2=ADDR(PROC PICT(0)); ! SPACE FOR OPER PICTURE PON(P) P_DEST=X'370000' P_P1=PAGESIZE//1024 P_P2=COMMS EPAGES; ! COMMSALLOC P_P3=ADDR(PARM(0)) PON(P) P_DEST=X'200000' PON(P) ! 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'70004' PON(P); ! SEMAPHORE EVERY 10 SECS P_P1=X'00100000' P_P2=600 PON(P); ! KICK OVERALLOC CNTRL EVERY 10 MIN %end ! ! Enter Global controller ! GLOBAL CONTROL; ! does not return ! !----------------------------------------------------------------------- ! LCCALL: LOCAL CONTROL; ! initial call(does not return!) ! *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *slr_0,0; *bctr_0,0; *st_0,2048(0) *la_0,2989 {BAD}; *st_0,2228(0) *lpsw_2224(0); ! it just might tho! ! !--------------------------------------------------------------------- ! %routine GLOBAL CONTROL %routinespec UNQUEUE(%integername QUEUE,UNQUED SERVICE) %integer I,J,K,SELN,SESTK,KSERVICE,LSERVICE,TSERVICE %longinteger L %if MONLEVEL&4#0 %start %longinteger IT,KIT %integer IT CORRN %constinteger IINC=20; ! ins. not counted in idle %finish %integername CURPROC %switch SERVROUT(0:LOCSN0); ! KERNEL SERVICES %record (PROCF) %name PROC; ! STATUS BITS SIGNIFY AS FOLLOWS %record (SERVF) %name KSERV,LSERV,LSERVQ %integername RUNQ %record (PARMF) P ! ! !------------------------------------------------------------------------------ ! *stm_4,14,656(0); ! reset context LONGINTEGER(2224)=DISAWAIT WPSW=PSW0!ALLOW INTS ->GO; ! branch around interrupt handler ! !----------------------------------------------------------------------- ! INTERRUPT ENTRY POINTS MCINT: ! machine check *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),48(0); ! failing PSW *la_0,204 {CC}; *icm_0,4,232(0) {reason}; *st_0,2228(0) *lpsw_2224(0) !----------------------------------------------------------------------- EXINT: ! external *stm_0,1,2048(0) *basr_1,0; *using_1 *cli_640(0),0; *bc_8,; ! from kernel - context ok *cli_134(0),16; *bc_7,; ! not CPU timer... *cli_135(0),5; *bc_7,; ! ...so context switch neccessary *l_1,2052(0) *lpsw_528(0); ! -> Local Controller *drop_1 EXLC: *mvi_640(0),0; ! kernel flag *stm_2,15,2056(0); ! switch context *lm_4,14,656(0) I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_0(8,1),24(0); ! PSW *mvc_8(64,1),2048(0); ! GRs *std_0,72(1); *std_2,80(1); ! FPRs *std_4,88(1); *std_6,96(1) *stctl_0,1,104(1); ! CRs 0,1 *stpt_168(1); ! CPU timer EXK: %if MONLEVEL&4#0 %and IDLE#0 %start *stpt_KIT %if MPLEVEL+NPQ>12 %else %c IDLEIT=IDLEIT+(MAX CPU TIMER-KIT)>>12 IDLE=0 %finish *spt_MAXCPUTIMER %if PAGE0_EXT CODE=x'1004' %start; ! clock comparator *stck_l; L=L+ONE SECOND; *sckc_l; ! reset for 1 sec tick P_DEST=X'A0000' ELAPSED INT(P) %if MONLEVEL&4#0 %then TSERVICE=10 %and ->KTIMES ->KSERVE %finishelseif PAGE0_EXT CODE=x'1005' %start; ! cpu timer OPMESS("CPU timer int?") %if MONLEVEL&4#0 %then TSERVICE=1 %and ->KTIMES ->KSERVE %finish OPMESS("External int?: ".HTOS(PAGE0_EXT CODE,4)) %if MONLEVEL&4#0 %then TSERVICE=1 %and ->KTIMES ->KSERVE !----------------------------------------------------------------------- IOINT: ! peripheral *stm_0,1,2048(0) *basr_1,0; *using_1 *cli_640(0),0; *bc_8,; ! from kernel - context ok *drop_1 *mvi_640(0),0 *stm_2,15,2056(0); ! switch context *lm_4,14,656(0) I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_0(8,1),56(0); ! PSW *mvc_8(64,1),2048(0); ! GRs *std_0,72(1); *std_2,80(1); ! FPRs *std_4,88(1); *std_6,96(1) *stctl_0,1,104(1); ! CRs 0,1 *stpt_168(1); ! CPU timer IOK: %if MONLEVEL&4#0 %and IDLE#0 %start *stpt_KIT %if MPLEVEL+NPQ>12 %else %c IDLEIT=IDLEIT+(MAX CPU TIMER-KIT)>>12 IDLE=0 %finish *spt_MAXCPUTIMER P_DEST=3 P_P1=PAGE0_IO ADDR P_P2=PAGE0_CSW1 P_P3=PAGE0_CSW2 I=BYTEINTEGER(COM_STEER INT+P_P1) P_P4=I; ! dev slot %if I<128 %start DISC(P) %if MONLEVEL&4#0 %then TSERVICE=34 %finishelseif I#255 %start DEVIO(P) %if MONLEVEL&4#0 %then TSERVICE=58 %finishelseif PAGE0_IO ADDR&255=0=PAGE0_CSW %start; ! CAI (channel available int.) P_P4=-1 %if COM_CHANNELT&(1<<(PAGE0_IO ADDR>>8))=0 %start DISC(P) %if MONLEVEL&4#0 %then TSERVICE=34 %finish %else %start DEVIO(P) %if MONLEVEL&4#0 %then TSERVICE=58 %finish %finish %else %start PKMONREC("Kernel - I/O int? :",P) %if MONLEVEL&4#0 %then TSERVICE=1 %finish %if MONLEVEL&4#0 %then ->KTIMES %else ->KSERVE ! !----------------------------------------------------------------------- !---------------------------------------- program error PEINT: *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),40(0); ! failing PSW *la_0,206 {CE}; *icm_0,4,143(0) {code}; *st_0,2228(0) *lm_4,14,656(0) *la_11,4088(11) NDIAG(-2,0,SHORTINTEGER(142),0) *lpsw_2224(0) ! !---------------------------------------- svc SVCINT: *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),32(0); ! failing PSW *la_0,10 {0A}; *icm_0,4,139(0) {code}; *st_0,2228(0) *lpsw_2224(0) ! !---------------------------------------------------------------------------- SWERR: ! software detected error *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *slr_0,0; *bctr_0,0; *st_0,2048(0) *la_0,3358 {D1E}; *st_0,2228(0) *lpsw_2224(0) ! !---------------------------------------------------------------------------- ! GO: ! set up interrupt PSWs ! *la_1,; *st_1,I PAGE0_EXT NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_SVC NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_PE NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_MC NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_IO NEW PSW=PSW0!I ! *la_1,; *st_1,I; ! s/w error PSW LONGINTEGER(512)=PSW0!I ! *basr_1,0; *using_1; ! Local Controller exit PSW *la_2,; *st_2,I; *drop_1 LONGINTEGER(544)=PSW0!I ! *spt_MAXCPUTIMER *stck_L; L=L+ONE SECOND; *sckc_L; ! 1 second clock tick ! CURPROC==COM_CURPROC CURPROC=0 KSERVICE=0 KSERV==SERVA(0) LSERV==KSERV; ! Initialise pointers. Here after ! address field only update ! in assembler sequences %if MONLEVEL&4#0 %start IT CORRN=1+1024*IINC//(COM_INSPERSEC*COM_ITINT) %finish !----------------------------------------------------------------------- ! SERVICE LOOPS KSERVE: ! KERNEL SERVICES *spt_MAXCPUTIMER ! *ssm_ALLOWPERIINTS *ssm_MASKPX; ! mask peri & external %if MULTI OCP=YES %start *basr_2,0; *using_2 *slr_1,1; *lr_0,1; *bctr_0,0 *l_3,MAINQSEMA *cs_0,1,0(3); *bc_8,; *drop_2 SEMALOOP(MAINQSEMA) MQS1: %finish KSKIP: %if KSERVICE!KERNELQ=0 %thenstart %if CURPROC#0 %thenstart ! PROC MAPPED AT LAST LSERVE %if RUNQ1#0 %and PREEMPTED=0 %and PROC_RUNQ=2 %start PREEMPTED=CURPROC RUNQ==RUNQ1 ->LSERVE; ! PREMPTED LOWPRIO FOR HIGHPRIO %finish KACT: ! activate direct kernel->user %if MULTI OCP=YES %then MAINQSEMA=-1 %if MONLEVEL&4#0 %start %if PROC_STATUS&4#0 %then BLPN=BLPN+1 %else FLPN=FLPN+1 %finish I=PROC_LSTAD %if XA=YES %then I=I!X'14' %else I=I!14<<24 *lctl_1,1,I; ! segment table length/origin I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_2048(8,0),0(1); ! PSW to page 0 *ld_0,72(1); *ld_2,80(1); ! FPRs *ld_4,88(1); *ld_6,96(1) *lctl_0,1,104(1); ! CRs 0,1 *spt_168(1); ! CPU timer *lm_0,15,8(1); ! GRs *mvi_640(0),255; ! kernel flag *lpsw_2048(0); ! to Local Controller or user %finish %if RUNQ1#0 %then RUNQ==RUNQ1 %and ->LSERVE %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 ! ! No process needs CPU. Enter and time the idle loop ! For multi processors other CPU can generate work ! %if MULTI OCP=YES %then MAINQSEMA=-1 %if MONLEVEL&4#0 %thenstart %if MPLEVEL+NPQKSKIP %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' P_DEST=X'30007'; ! RESCHEDULE LOCAL CONTROLLER P_SRCE=0 P_P1=I-LOCSN3 SCHEDULE(P) TSERVICE=3 ->KTIMES %finish %if MULTI OCP=YES %then MAINQSEMA=-1 SUPPOFF(KSERV,P) ->SERVROUT(KSERVICE) !----------------------------------------------------------------------- ! SERVICE ROUTINE CALLS SERVROUT(1): SNOOZTIME=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&X'3C'#0 %then TIMEOUT; ->KEXIT SERVROUT(10): ELAPSEDINT(P); ->KEXIT SERVROUT(11): UPDATE TIME; ->KEXIT SERVROUT(12): DPONPUTONQ(P); ->KEXIT SERVROUT(16): OVERALLOC CONTROL; ->KEXIT SERVROUT(32): DISC(P) ->KEXIT SERVROUT(33): PDISC(P); ->KEXIT SERVROUT(36): SERVROUT(37): BMOVE(P); ->KEXIT SERVROUT(48): DEVIO(P); ->KEXIT SERVROUT(49): TAPE(P); ->KEXIT SERVROUT(50): OPER(P); ->KEXIT SERVROUT(51): LP ADAPTOR(P); ->KEXIT SERVROUT(52): %if CRFITTED=YES %then CR ADAPTOR(P) %and ->KEXIT %else ->INVALID 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 %then COMBINE(P) %and ->KEXIT %else ->INVALID SERVROUT(57): MK1FEADAPTOR(P); ->KEXIT 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(*): ->INVALID !----------------------------------------------------------------------- KEXIT: %if MONLEVEL&4#0 %then TSERVICE=KSERVICE KTIMES: ! RECORD SERVICE ROUTINE TIMES %if MONLEVEL&4#0 %thenstart *stpt_L IT=(MAX CPU TIMER-L)>>12+IT CORRN PERFORM_SERVIT(TSERVICE)=IT+PERFORM_SERVIT(TSERVICE) PERFORM_SERVN(TSERVICE)=PERFORM_SERVN(TSERVICE)+1 %finish ->KSERVE !----------------------------------------------------------------------- LINVALID: ! LOCAL CNTRL NOT RESIDENT CURPROC=0 SUPPOFF(LSERV,P) LSERV_P=LSERV_P&X'BFFFFFFF'; ! remove executing bit %if MULTI OCP=YES %then MAINQSEMA=-1; ! & drop thru for msg INVALID: ! invalid service called PKMONREC("INVALID POFF:",P) ->KSERVE !----------------------------------------------------------------------- LSERVE: ! Local Controller services UNQUEUE(RUNQ,LSERVICE) LSERV==SERVA(LSERVICE) ! ! L-C is only inhibitied before process start and after stopping ! so the logically necessary test for inhibition can be omitted ! unless codeing elsewhere is changed. code left as comment as ! a reminder ! ! I=LSERV_P&X'BFFFFFFF'; ! without "executing" bit ! %if I<=0 %then LSERV_P=I %and ->KSKIP;! INHIBITED CURPROC=LSERVICE-LOCSN0 PROC==PROCA(CURPROC) %if PROC_ACTIVE#255 %then ->LINVALID %if MULTI OCP=YES %then MAINQSEMA=-1 ! ! To activate to Local Controller set the segment table from the ! LSTAD word in the process list then load the context from LC TABLES ! %if MONLEVEL&4#0 %thenstart LCN=LCN+1 %finish I=PROC_LSTAD %if XA=YES %then I=I!X'14' %else I=I!14<<24 *lctl_1,1,I; ! segment table length/origin *ptlb_0; ! just in case I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *lctl_0,1,104(1); ! CRs 0,1 *spt_168(1); ! CPU timer *lm_4,14,24(1); ! GRs *mvi_640(0),255; ! kernel flag *lpsw_0(1); ! to Local Controller ! !----------------------------------------------------------------------- LCEXIT: ! Local Controller returns to here ! ! Local Controller has saved any context ! *lm_4,14,656(0); ! Kernel GRs *spt_MAXCPUTIMER *mvi_640(0),0; ! kernel flag ! CURPROC=0 %if MULTI OCP=YES %start *basr_2,0; *using_2 *slr_1,1; *lr_0,1; *bctr_0,0 *l_3,MAINQSEMA *cs_0,1,0(3); *bc_8,; *drop_2 SEMALOOP(MAINQSEMA) MQS2: %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 %thenstart %if PROC_RUNQ=1 %then RUNQ==RUNQ1 %else RUNQ==RUNQ2 %if RUNQ=0 %then LSERV_L=LSERVICE %elsestart LSERVQ==SERVA(RUNQ) LSERV_L=LSERVQ_L LSERVQ_L=LSERVICE %finish RUNQ=LSERVICE %unless PROC_STATUS&3#0 %and RUNQ#0 %else *lctl_1,1,708(0); ! l-c may page out revert to kernal pst %finish %if MULTI OCP=YES %then MAINQSEMA=-1 ->KSERVE !----------------------------------------------------------------------- %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 %record (SERVF) %name SERVQ; ! MAPPED ON TO SERVICE AT BACK OF Q %record (SERVF) %name SERV; ! 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(%record (PARMF) %name 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: SNOOZING HAS TIMED OUT * !* ACTIVITY 13: RESCHEDULE ALL RESIDENT TO FREE SMAC * !* 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 %constinteger PRATMAX=255,PRIQS=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,SCHTICKS=0 !----------------------------------------------------------------------- ! PRIORITY QUEUE ARRAY ETC. %ownbyteintegerarray PQ(1:MAXPROCS)=0(MAXPROCS) %ownbyteintegerarray PQH(1:PRIQS)=0(PRIQS); ! NUMBER OF PRIORITIES=PRIQS %ownbyteintegerarray PQN(1:PRIQS)=0(PRIQS) %if MONLEVEL&1#0 %thenstart %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" %integer SRCE,ACT,PROCESS,PTY,LSTAD,LLSTVAD,LSTACKDA,DCODEDA,DSTACKDA,DGLADA, XEPS,OLDCATSLOT,NEWCATSLOT,INCAR,LCDDP,I,J,K,L,LCSTX %integer LIM %string (15) USER %string (2) PSTATE %record (CATTABF) %name OLDCAT,NEWCAT %record (LCFORM) %name LLCTABLES %record (PROCF) %name PROC %switch ACTIVITY(0:20) %if MONLEVEL&2#0 %and KMON&1<<3#0 %then PKMONREC("SCHEDULE:",P) ACT=P_DEST&X'FFFF' PROCESS=P_P1 %if 0; *drop_2 SEMALOOP(SCHEDSEMA,0) SSG: %finish ->ACTIVITY(ACT&255) !----------------------------------------------------------------------- ACTIVITY(0): ! INITIALISE %if STRING(ADDR(COM_SUPVSN))COM_MAXPROCS %then OPMESS("Bad Confign") %andreturn STRING(ADDR(COM_SUPVSN))=SUPID 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 370 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 %thenstart DISPLAY TEXT(0,2,0,"RQ1 RQ2 P1 P2 P3 P4 P5 Total STF Outs") DISPLAY TEXT(0,3,0," 0 0 0 0 0 0 0 0 100 0") %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 VIDEO & BOOTING %finish ALLOW PERI INTS=ALLOW PERI INTS!3; ! permits ints between kernel ! services now initialisation ! is completed ! ! 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'700'; ! 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=P_USER INCAR=P_INCAR %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 USER="FTRANS" %then PROCESS=5 %if PROCESS>0 %start PROC==PROCA(PROCESS) %if PROC_USER#"" %then P_P1=3 %and ->STARTREP %finishelsestart %cycle PROCESS=FIRST UPROC,1,MAXPROCS-1 PROC==PROCA(PROCESS) %if PROC_USER="" %thenexit %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; ! SUSPENDED PROC_CATEGORY=0 %if MONLEVEL&1#0 %then SUSPN=SUSPN+1 %if MULTIOCP=YES %then SCHEDSEMA=-1 %if ACT=16 %start %for I=1,1,6 %cycle J=BYTEINTEGER(ADDR(USER)+I) %if 'A'<=J<='Z' %then J=J!32 BYTEINTEGER(ADDR(USER)+I)=J %repeat %finish UPDISP(PROCESS,4,USER) CLEAR PARMS(PROCESS+LOCSN0) CLEAR PARMS(PROCESS+LOCSN1) %unless PROCESSSTOUT !----------------------------------------------------------------------- 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 %if OLDCAT_PRIORITY<=3 %and PROC_STATUS&HADPONFLY=0 %and %c 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 PROC_EPA=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 %and PROC_P4TOP4<255 %and %c PROCESS>=FIRST UPROC %then PROC_P4TOP4=PROC_P4TOP4+1 %if MONLEVEL&32#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 OLDCAT_PRIORITY>=4 %and P4PAGES>=MAXP4PAGES %and %c SXPAGES>(SHAREDEPS+UNALLOCEPS) %and PROCESS>=FIRST UPROC %then %c ->WAYOUT NEWCATSLOT=OLDCAT_MORET NEWCAT==CATTAB(NEWCATSLOT) %if PROC_STATUS&HADTONFLY=0 %and PQN(1)+PQN(2)=0 %then ->GIVE 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 P4PAGES<=OLDCAT_EPLIM %then %c ->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 PROC_EPA=NEWCAT_EPLIM ->CONT !----------------------------------------------------------------------- ACTIVITY(18): ! SUSPEND ON FLY(IE WITHOUT ! PAGING WOKSET OUT)? %if SNOOZING=YES %thenstart !%if SHAREDEPS+UNALLOCEPS1 %c !%then ->WAYOUT; ! NO ! I=(PQN(1)+PQN(2))*MAXEPAGES>>1; ! PAGES NEEDED TO CLERAR QS ! ! THE NEXT CONDITION IS CRUCIAL FOR SATISFACTORY SNOOZING ! CAN NOT AFFORD IN GENERAL TO ALLOW ANYONE TO SNOOZE WHEN THERE ARE ! NOT ENOUGH FREE PAGES TO CLEAR QUEUEING INTEGERACTIVE PROCESSES ! HOWEVER IN LARGE STORE NO DRUM CONFIGURATIONS QUEUEING MAY BE ! DUE TO LARGE NUMBER OF PAGE FREES BUILDING UP. IN THESE CIRCUMSTANCES ! IT IS BETTER TO LET THIS CHAP SNOOZE TILL THING QUIETEN DOWN. ! THE BIGGER THE STORE THE TRUEUER THIS IS SO DO NOT SCALE PAGE FREES ! FOR BIGGER CORE SIZES ! %if I>FREE EPAGES+PAGE FREES %and PAGE FREES>2 %then %c ->WAYOUT NEWCATSLOT=OLDCAT_SUSP %if MONLEVEL&1#0 %thenstart SUSPN=SUSPN+1 UPDISP(PROCESS,11,"Z ") %finish I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS)) PUNINH(PROCESS,I) PROC_ACTIVE=0 PROC_STATUS=PROC_STATUS!SNOOZED PARE EPAGES PROC_EPA=NEWCAT_EPLIM UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-PROC_EPN %if MONLEVEL&32#0 %then %c FLYCAT(NEWCATSLOT,OLDCATSLOT)<-FLYCAT(NEWCATSLOT,OLDCATSLOT)+1 MPLEVEL=MPLEVEL-1 %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES-OLDCAT_EPLIM ! PEDANTIC ! P_DEST=X'A0002'; P_SRCE=X'30012'; ! KICK ELAPSED INT P_P1=X'3000C'!PROCESS<<8 P_P2=SNOOZTIME; P_P3=PROCESS PON(P) P_P1=0; ! YES MAY SUSPEND ON FLY %finish %if NPQ#0 %then P_DEST=X'30006' %and PON(P) ->WAYOUT !---------------------------------------------------------------------- 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 (PROCESSSTOUT !----------------------------------------------------------------------- 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 PROC_RUNQ=OLDCAT_RQTS1 %if MONLEVEL&4#0 %then PERFORM_SNOOZOK=PERFORM_SNOOZOK+1 %if MONLEVEL&1#0 %then 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 UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES+OLDCAT_EPLIM PROC_ACTIVE=255 PON(P) %if MONLEVEL&4#0 %then PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP ->WAYOUT %finish PROC_ACTIVE=255 %if OLDCAT_PRIORITY<4 %and PROC_STATUS&(STATEX+4)=STATEX %then %c SXPAGES=SXPAGES-PROC_EPN 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 %and PROC_P4TOP4<255 %and %c PROCESS>=FIRST UPROC %then PROC_P4TOP4=PROC_P4TOP4+1 %if MONLEVEL&32#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 PROC_EPA=0 !----------------------------------------------------------------------- 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 %or DONT SCHED#0 %then ->WAYOUT AGN: %cycle PTY=PRAT(PRATP) %exitif PQH(PTY)#0 PRATP=(PRATP+1)&PRATMAX %repeat %if PTY>=3 %and PAGEFREES>=40 %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 %thenstart %if P4PAGES>0 %and P4PAGES+OLDCAT_EPLIM>MAXP4PAGES %and %c SXPAGES>(SHAREDEPS+UNALLOCEPS) %start %if NPQ>PQN(4)+PQN(5) %then PRATP=(PRATP-31)&PRATMAX %and ->AGN ->WAYOUT %finish %finish I=OLDCAT_EPLIM+LSTACKLEN %if I>SHAREDEPS+UNALLOCEPS %and MPLEVEL>0 %thenstart; ! NOT ENOUGH ROOM ->WAYOUT %finish PROC_EPA=OLDCAT_EPLIM 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 %else PQ(PQH(PTY))=PQ(PROCESS) NPQ=NPQ-1 PQN(PTY)=PQN(PTY)-1 %if MULTIOCP=YES %then SCHEDSEMA=-1 ! PAGE IN LOCAL CONTROLLER STACK P_DEST=X'40001'; ! PAGETURN/PAGE-IN P_SRCE=X'30009' %if PROC_STATUS&STATEX#0 %then I=LSTACKLENP %else I=0 PQ(PROCESS)=LSTACKLEN-I; ! TO COUNT PAGE-TURN REPLIES %cycle I=I,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I P_P2=PROCESS<<8!I P_P3=X'10'; ! SSK 1 PON(P) %repeat %if NPQ#0 %and 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): ! SNOOZING TIMED OUT FROM ELAPSED INT %if SNOOZING=YES %and PROC_STATUS&SNOOZED#0 %start PROC_STATUS=PROC_STATUS&(\SNOOZED) PROC_ACTIVE=255 UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA MPLEVEL=MPLEVEL+1 %if MONLEVEL&4#0 %then PERFORM_SNOOZTO=PERFORM_SNOOZTO+1 %if MONLEVEL&1#0 %then SUSPN=SUSPN-1 P_DEST=(PROCESS+LOCSN0)<<16!8 P_SRCE=X'3000C' PON(P) %finish %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(13): ! RESCHEDULE ALL RESIDENT TO FREE SMAC %cycle I=1,1,MAXPROCS PROC==PROCA(I) %if PROC_USER#"" %and (PROC_ACTIVE=255 %or %c PROC_STATUS&(SNOOZED!STATEX)#0) %start P_DEST=(COM_ASYNCDEST+I)<<16 P_SRCE=X'3000D' P_P1=3; ! DUMMY ACT PON(P) %finish %repeat ->WAYOUT !----------------------------------------------------------------------- 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 LC stack - destroy process PRINT STRING("Local Controller stack read fail, process ".STRINT %c (PROCESS)) ->DESTROY %finish LSTAD=PROC_LSTAD LLSTVAD=RTV(LSTAD) MOVE(LCSTKSEG*4,SEGTAB VA,LLSTVAD); ! public segments LLCTABLES==RECORD(LLSTVAD) %if XA=NO %then LIM=15<<28 %else LIM=0 LLCTABLES_SEGTABLE(LCSTKSEG)=LSTAD+(LSTLEN*4)!LIM; ! LC stack seg LLCTABLES_SEGTABLE(3)=LLCTABLES_SEGTABLE(LCSTKSEG) ! fill in page table entries ! by digging in amt and store tables LCDDP=AMTA(PROC_LAMTX)_DDP; ! DD POINTER FOR PAGE O OF LC %if PROC_STATUS&STATEX#0 %thenstart PROC_STATUS=PROC_STATUS!!STATEX %if MONLEVEL&4#0 %then PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP I=LSTACKLENP %finishelse I=0 %cycle I=I,1,LSTACKLEN-1 LCSTX=AMTDD(LCDDP+I); ! store pointer ! nb page must be incore ! not all cases need to be tested K=LCSTX*PAGESIZE %if PTE SIZE=2 %then LLCTABLES_LCHPTABLE(I)<-K>>8 %else %c LLCTABLES_LCPTABLE(I)=K %repeat PROC_RUNQ=OLDCAT_RQTS1 %if MONLEVEL&1#0 %then UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) MPLEVEL=MPLEVEL+1 %if OLDCATSLOT=0 %thenstart; ! process being created %if XA=YES %then J=x'20' %else J=1 %for I=LCSTKSEG+1,1,255 %cycle; ! invalidate unused segments LLCTABLES_SEGTABLE(I)=J %repeat %for I=LSTACKLEN,1,15 %cycle; ! invalidate unused (as yet) pages %if XA=YES %then LLCTABLES_LCPTABLE(I)=-1 %else %c LLCTABLES_LCHPTABLE(I)=-1 %repeat LLC TABLES_PROCNO=PROCESS LLC TABLES_CONTEXTS(0)=LC ICONTEXT; ! LC initial context UNINHIBIT(PROCESS+LOCSN0); ! let create PON go %finishelsestart 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*(300-PROC_P4TOP4)//300 PON(P) %finish %if XA=YES %then K=PROC_LSTAD!(LSTLEN//16-1) %else %C K=PROC_LSTAD!(LSTLEN//16-1)<<24 LLC TABLES_CONTEXTS(0)_CONTROLR(1)=K I=RTV(-1); ! invalidate entry %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(15): ! UPDATE OPER INFO(EVERY 5 SECS) SCHTICKS=SCHTICKS+1 %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#"" %thenstart %if I>=FIRST UPROC %and PROC_ACTIVE=3*MINSINACTIVE %and %c PROC_STATUS&X'404'=0 %start ! NOT BATCH OR DAP 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 %thenstart %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#"" %thenstart 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(COM_USERS)." ") I=100*FREE EPAGES//COM_SEPGS DISPLAY TEXT(0,3,31,STRINT(I)."% ") 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, PQN(1)<<24!PQN(2)<<16!PQN(3)<<8!PQN(4), PQN(5)<<24!SUSPN<<16!SNOOS<<8,PAGEFREES<<16!UNALLOCEPS, FREEEPAGES<<16) %if TRACE=YES %and TRACE EVENTS&(1<<1)#0 %finish %end %finish %return !----------------------------------------------------------------------- ACTIVITY(19): ! SET BITS IN P_P2 INTO STATUS ! OF PROCESS IN P_P1 PROC_STATUS=PROC_STATUS!P_P2 ->WAYOUT ACTIVITY(20): ! CONVERSE OF 19 PROC_STATUS=PROC_STATUS&(\P_P2) ->WAYOUT %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 P_P2+LEEWAY>CATTAB(NEWCAT_LESSP)_EPLIM %then %c PROC_CATEGORY=NEWCATSLOT %andreturn 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 (PROCESS=1 %or 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(%record (PARMF) %name P) !*********************************************************************** !* FOR ALL ACTS : P_P1=AMTX<<16!EPX * !* ACTIVITY 1 : "PAGE IN" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=RETURNABLE IDENTIFIER * !* : P_P3 THE KEY REQUIRED (NOT SET FOR SHRD PAGES) * !* ACTIVITY 2 : "PAGE OUT" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=FLAGS (BEING THE BOTTOM 4 BITS OF STOREFLAG* !* ACTIVITY 3 : REPLY FROM "EPAGE" WITH EPAGE P_P2=STOREX * !* ACTIVITY 4 : ZERO "NEW" DISC EPAGE * !* ACTIVITY 5 : REPLY FROM DISC/WRITE * !* ACTIVITY 6 : (WAS REPLY) FROM DRUM/READ ON FAILURE ONLY * !* ACTIVITY 7 : (WAS REPLY FROM DRUM/WRITE) * !* ACTIVITY 8 : REPLY FROM ZERO DISC EPAGE * !* * !* STORE FLAGS SIGNIFY AS FOLLOWS : * !* BIT 15: PAGE HAS HAD A SINGLE BIT ERROR * !* BIT 7 : DISC TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) * !* BIT 6 : DISC INPUT(0)/OUTPUT(1) * !* BIT 5 : NOT USED * !* BIT 4 : NOT USED * !* BIT 3 : WRITTEN TO MARKER * !* BIT 2 : NOT USED * !* BIT 1 : MAKE NEW IE DONT PAGE OUT & SUPPLY ZEROPAGE ON REREAD * !* BIT 0 : RECAPTURABLE(IF ON FREE LIST ON PAGING OUT) * !*********************************************************************** %routinespec PUSHPIT %constinteger ZEROPAGEAD=4096; ! SEG 0 PAGE 1 BOTH REAL & VIRTUAL %integer AEX,AMTX,EPX,DDX,FLAGS,STOREX,SRCE,CALL,ID,I,B,F,KEY %if MONLEVEL&12=12 %thenstart %longinteger TIMER1,TIMER2 %finish %shortintegername AMTDDDDX %record (AMTF) %name AMT %record (STOREF) %name ST %record (PARMXF) %name PP %record (PARMF) TDISC %switch ACTIVITY(0:8) %if MONLEVEL&2#0 %and KMON&1<<4#0 %then PKMONREC("PAGETURN:",P) AEX=P_P1 AMTX=AEX>>16 EPX=AEX&X'FFFF' AMT==AMTA(AMTX) DDX=AMT_DDP+EPX AMTDDDDX==AMTDD(DDX) %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish STOREX=AMTDDDDX&STXMASK ->ACTIVITY(P_DACT) !----------------------------------------------------------------------- ACTIVITY(1): ! PAGE-IN (ALLOWS PAGETURN TO BE CALLED) %if MONLEVEL&4#0 %then PERFORM_PTURNN=PERFORM_PTURNN+1 AMT_USERS=AMT_USERS+1 CALL=P_SRCE KEY=P_P3 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 STORE(B)_FLINK=F STORE(F)_BLINK=B FREEEPAGES=FREEEPAGES-1 %if XA=YES %thenstart *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,STOREX *SLL_1,12 *L_2,KEY *SSK_2,1 %finishelsestart *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSK_2,1 *LA_1,2048(1); *SSK_2,1 %finish %if FREEEPAGES=0 %then INHIBIT(5) %if MONLEVEL&4#0 %then PERFORM_RECAPN=PERFORM_RECAPN+1 ->PAGEIN REPLY NOTRECAP: ! PAGE MUST BE SHARED %if ST_USERS=0 %thenstart; ! PAGE-OUT IN PROGRESS PAGEFREES=PAGEFREES-1 %finishelsestart SHAREDEPS=SHAREDEPS+1 %finish ST_USERS=ST_USERS+1 %if MONLEVEL&4#0 %then PERFORM_PSHAREN=PERFORM_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' %start PUSHPIT 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=STOREX*PAGESIZE P_P3=0; ! SUCCESS %if MONLEVEL&256#0 %start P_P5=ST_USERS P_P6=ST_FLAGS %finish %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,KEY) %and ->ACT3 P_SRCE=X'40003' P_P1=AEX P_P2=I; ! =0 FOR ZEROED P_P3=KEY; ! USER KEY F NO READ PROTECTION 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 %thenstart; ! 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 %thenstart; ! PAGE HAS ARRIVED BEFORE P_DEST=X'60000'; ! RETURN EPAGE P_SRCE=X'40003' 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 %if AMTDDDDX&NEWEPBIT#0 %thenstart; ! NEW EPAGE AMTDDDDX=STOREX; ! NOT "NEW" & NOT DRUM ST_FLAGS=8; ! "WRITTEN" %if MONLEVEL&4#0 %then PERFORM_NEWPAGEN=PERFORM_NEWPAGEN+1 ->PAGEIN REPLY %finish ! PUSHPIT 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): ! WAS REPLY FROM DRUM READ !----------------------------------------------------------------------- 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 %thenstart 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 %thenstart; ! \NEW&WRITTEN THEN WRITE TO DISC %if MONLEVEL&4#0 %then PERFORM_PAGEOUTN=PERFORM_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 FLAGS=0 %thenstart; ! NO TRANSFERS INITIATED %if ST_FLAGS&2#0 %then %c AMTDDDDX<-NEWEPBIT!STXMASK %and ST_FLAGS<-ST_FLAGS&X'8000' ->REP; ! TO RETURN EPAGE %finish ST_FLAGS<-ST_FLAGS&X'80F1' %if MULTIOCP=YES %then STORESEMA=-1 TRANSFER NEEDED: ! TO COMPLETE PAGETURN %if FLAGS&X'80'#0 %thenstart; ! DISC TRANSFER TO START %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish PDISC(TDISC) %if MONLEVEL&12=12 %thenstart PDISCCALLN=PDISCCALLN+1 *STPT_TIMER2 PDISCIT=PDISCIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish %finish %return !----------------------------------------------------------------------- ACTIVITY(4): ! ZERO "NEW" EPAGE ON DEACTIVATION %if MONLEVEL&4#0 %then PERFORM_PAGEZN=PERFORM_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'803F'; ! NO DISC TRANSFER %if P_P2=4 %thenstart; ! WAS ABORTED %if MONLEVEL&4#0 %then PERFORM_ABORTN=PERFORM_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&X'8001' %if ST_FLAGS&1=0 %start; ! NOT RECAPTURABLE AMTDDDDX<-AMTDDDDX!STXMASK %finishelsestart ST_LINK=DDX %finish P_DEST=X'60001' P_P2=STOREX PAGEFREES=PAGEFREES-1 %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish RETURN EPAGE(P) %if MONLEVEL&12=12 %thenstart RETCALLN=RETCALLN+1 *STPT_TIMER2 RETIT=RETIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish RAMTX: ! RETURN AMTX IF UNUSED %if AMT_USERS=0 %and AMT_OUTS=0 %thenstart P_DEST=X'00080003' P_P2=AMTX %if MULTIOCP=YES %then PON(P) %elsestart %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish ACTIVE MEM(P) %if MONLEVEL&12=12 %thenstart AMCALLN=AMCALLN+1 *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish %finish %finish %if MULTIOCP=YES %then STORESEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(7): ! WAS REPLY FROM DRUM WRITE ->REP !----------------------------------------------------------------------- ACTIVITY(8): ! REPLY FROM ZERO DISCPAGE ! IGNORE FAILURES SEE ACT 5 DCLEARS=DCLEARS-1 AMTDDDDX<-AMTDDDDX&(\NEWEPBIT); ! CLEAR NEW MARKER AMT_OUTS=AMT_OUTS-1 ->RAMTX !---------------------------------------------------------------------- %routine PUSHPIT; ! AWAIT TRANSFER USING THE PIT LIST I=NEWPPCELL PP==PARM(I) PP_DEST=SRCE PP_SRCE=X'40003' PP_P1=ID PP_P2=STOREX*PAGESIZE PP_P3=0; ! SUCCESS FLAG PP_LINK=ST_LINK ST_LINK=I %end %end !---------------------------------------------------------------------- %integerfn QUICK EPAGE(%integer ZEROED,KEY) !*********************************************************************** !* CAN BE CALLED BY ANYONE HOLDING STORESEMA TO GET THE NEXT FREE * !* NEXT FREE EPAGE. GIVES THE STORE INDEX OR -1 * !*********************************************************************** %record (STOREF) %name ST %integer I,STAD,STOREX,RA %if FREE EPAGES=0 %thenresult=-1 STOREX=FSTASL ST==STORE(STOREX) FSTASL=STORE(FSTASL)_FLINK STORE(FSTASL)_BLINK=0 ST_USERS=1 %if ST_FLAGS=1 %thenstart; ! RECAPTURABLE FLAG I=ST_LINK AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %finish RA=STOREX*PAGESIZE %if ZEROED=0 %thenstart; ! CLEAR TO ZERO %if XA=YES %thenstart *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish I=RTV(RA) *l_0,i; *l_1,pagesize *lr_2,0; *slr_3,3; *mvcl_0,2 %finish FREEEPAGES=FREEEPAGES-1 %if FREEEPAGES=0 %then INHIBIT(5) %if XA=YES %thenstart *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSKE_2,1 %finish %ELSE %if XA=AMDAHL %start *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish %result=STOREX %end %routine GET EPAGE(%record (PARMF) %name P) !*********************************************************************** !* SERVICE 5.CAN BE PONNED (BUT NOT CALLED!) TO PROVIDE AN EPAGE. * !* REQUESTS HAVE P_P1 AS RETURNABLE IDENTIFIER * !* P_P2 ZERO IF PAGE TO BE SEROED * !* P_P3 BOTTOM 8 BITS HAVE STORE KEY IN SSKE FORMAT * !* REPLIES HAVE STORE INDEX IN P_P2 AND REALADDR IN P_P4 * !*********************************************************************** %integer STOREX,PS %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %if FREEEPAGES=0 %thenstart; ! SHOULD ONLY OCCUR IN MULTIOCPS %if MULTIOCP=YES %start; STORESEMA=-1; %finish PON(P); ! SERVICE NOW INHIBITED %return %finish %if MONLEVEL&2#0 %and KMON&1<<5#0 %then PKMONREC("GET EPAGE:",P) STOREX=QUICK EPAGE(P_P2,P_P3) P_P2=STOREX; ! LEAVE P1 & P3 & P5 & P6 INTACT P_P4=STOREX*PAGESIZE 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 %start; STORESEMA=-1; %finish PON(P) %end %integerfn NEW EPAGE !*********************************************************************** !* HANDS OUT A NEW EPAGE TO EXTEND A VITAL RESIDENT TABLE * !*********************************************************************** %integer I %if MULTIOCP=YES %thenstart { TEST BUT DO NOT WAIT FOR STORE SEMA} {IF NOT AVAILABLE THEN ->USE SPARE} *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 %finish %if FREE EPAGES>0 %thenstart I=QUICK EPAGE(0,X'18'); ! ZEROED KEY=1+READ PROTECTION %if MULTI OCP=YES %start; STORESEMA=-1; %finish %if I<0 %then ->USE SPARE STORE(I)_USERS=X'7FFF' %result=I*PAGESIZE %finish USE SPARE: ! try emergency spare page %if SPSTOREX>0 %start I=SPSTOREX*PAGESIZE SPSTOREX=0 %result=I %finish %result=-1 %end %routine RETURN EPAGE(%record (PARMF) %name P) !*********************************************************************** !* SEVICE NO 6. * !* 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 * !* DACT=0 FOR PON OR CALL WITHOUT STORESEMA * !* DACT=1 SPECIAL CALL FROM HOLDER OF STORESEMA * !* P_P2 HAS THE STORE INDEX OF THE RETURNED PAGE. THERE IS NO REPLY * !*********************************************************************** %routinespec STOP RECAPTURE %record (STOREF) %name ST %integer I,STOREX,STAD,ACT,RA ACT=P_DEST&1 %if MULTIOCP=YES %and ACT=0 %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %if MONLEVEL&2#0 %and KMON&1<<6#0 %then PKMONREC("RETURNEPAGE:",P) STOREX=P_P2 RA=STOREX*PAGESIZE ST==STORE(STOREX) ST_USERS=0 %if STOREX=0 %then MONITOR("PAGE 0 RETURNED???") %if ST_FLAGS&X'8000'#0 %thenstart OPMESS("PAGE ".STRINT(STOREX)." ABANDONNED") STOP RECAPTURE ->RETURN %finish %if SPSTOREX=0 %start STOP RECAPTURE %if XA=YES %thenstart *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish I=RTV(RA) *l_0,i; *l_1,pagesize *lr_2,0; *slr_3,3; *mvcl_0,2 SPSTOREX=STOREX %finishelsestart %if ST_FLAGS&1#0 %start; ! RECAPTURABLE TO BACK ST_FLINK=0 ST_BLINK=BSTASL STORE(BSTASL)_FLINK=STOREX BSTASL=STOREX %finishelsestart; ! NOT RECAPTURABLE ON FRONT ST_BLINK=0 ST_FLINK=FSTASL STORE(FSTASL)_BLINK=STOREX FSTASL=STOREX %finish %if FREEEPAGES=0 %then UNINHIBIT(5) FREEEPAGES=FREEEPAGES+1 %finish %if XA=YES %thenstart *L_1,RA; *LA_2,248 {X'78'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,248 {X'78'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,248 {X'78'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish RETURN: %if MULTIOCP=YES %and ACT=0 %start; STORESEMA=-1; %finish %return %routine STOP RECAPTURE; ! SUBROUTINE TO BREAK LINK %if ST_FLAGS=1 %thenstart; ! RECAPTURABLE I=ST_LINK AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %finish %end %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 (PARMF) P %integer I,N,K %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %unless PAGEFREES<=1 %and GETEPN>=MPLEVEL+1-COM_NOCPS %start %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return; ! NOT A TRUE DEADLOCK %finish N=GETEPN GETEPN=GETEPN-1; ! ASSUMES WE WILL CURE DEADLOCK %if MULTIOCP=YES %start; STORESEMA=-1; %finish %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//100; ! 1% 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 !*********************************************************************** !* SERVICE NO 16. * !* 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. * !*********************************************************************** %integer K K=1+COM_SEPGS//400; ! 0.25% OF STORE %if OVERALLOC+K *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish DACT=P_DEST&X'F' ->ACT(DACT) ACT(0): ! INITIALISE %if MULTIOCP=YES %start; STORESEMA=-1; %finish REALAD=NEW EPAGE %if XA=NO %then LIM=(MAXAMTAK-4)//4 %else LIM=(MAXAMTAK-4)//64 ! PT SIZE WORST CASE %if XA=YES %start SEGTAB(AMTASEG)=REALAD!X'80'!LIM; ! COMMON BIT SET %else SEGTAB(AMTASEG)=LIM<<28!REALAD %finish ! ! SET UP PUBLIC SEGMENT 'AMTASEG' FOR AMTA RECORD ARRAY WITH ! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF ! AMTAPT==ARRAY(AMTASEG<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 AMTX=0 %and ->RETURN %repeat DEALLOCDD(AMT_DDP+LEN,AMT_LEN-LEN) AMT_LEN=LEN %finish %if AMT_USERS=0 %and AMT_OUTS>0 %start %cycle I=AMT_DDP,1,AMT_DDP+LEN-1 %if AMTDD(I)&NEWEPBIT#0 %then AMTX=-4 %and ->RETURN %repeat %finish AMT_USERS=AMT_USERS+1; ! USERS ->RETURN %finish AMTX=AMT_LINK %repeat %if AMTASL=0 %thenstart; ! 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(PAGESIZE,REALAD) %finish ! ALLOCATE NEW SPACE GARB=0; ! NOT GARBAGE COLLECTED YET %cycle %if DDASL(LEN)#0 %thenstart 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 %thenstart 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(PAGESIZE,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 %start; STORESEMA=-1; %finish %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 %thenstart; ! 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 %thenstart 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 %start; STORESEMA=-1; %finish Q_DEST=X'40004'; ! ZERO PAGE Q_SRCE=X'80080002' %cycle I=0,1,CN-1 Q_P1=CLEARS(I) PON(Q); ! PON to limit call depth & so %repeat; ! avoid possible LC stack o'flow %finish %end %if CN>0 %thenreturn; ! 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=0 %and AMT_OUTS=0 %and AMT_DA#X'FF000000' %start %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return; ! AWAIT TRANSFERS %finish DEALLOCDD(AMT_DDP,AMT_LEN) DEALLOCAMT %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return ACT(4): ! ENTERED EVERY 10 SECS %if MULTIOCP=YES %start; STORESEMA=-1; %finish ! CODE WAS HERE TO ADJUST RESIDENCES ! BETWEEN MIN&MAX ACCORDING TO ! DRUM SATURATION. HARDLY SEEMS WORTH ! KEEPING THIS TO SAVE AMT SPACE 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#"" %thenstart %if PROC_STATUS&AMTLOST=0 %and K>12<<4 %if AMTANEXT=0 %start; ! FIRST PT ENTRY I=RTV(REALAD); ! SET A GLOBAL MAPPING %if XA=YES %then INTEGER(I)=PTE %else SHORTINTEGER(I)<-PTE %if XA=NO %then LIM=(MAXAMTAK-4)//4 %else LIM=((MAXAMTAK-4)//64)*16+15 %for J=1,1,LIM %cycle AMTAPT(J)=-1 %repeat %finishelse AMTAPT(AMTANEXT)<-PTE AMTANEXT=AMTANEXT+1 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,LIM,PTE %if XA=YES %then PTE=REALAD %else PTE=REALAD>>12<<4 %if AMTDDNEXT=0 %start; ! FIRST PT ENTRY I=RTV(REALAD); ! SET A GLOBAL MAPPING %if XA=YES %then INTEGER(I)=PTE %else SHORTINTEGER(I)<-PTE %if XA=NO %then LIM=(MAXAMTDDK-4)//4 %else %c LIM=((MAXAMTDDK-4)//64)*16+15 %for J=1,1,LIM %cycle AMTDDPT(J)=-1 %repeat %finishelse AMTDDPT(AMTDDNEXT)<-PTE AMTDDNEXT=AMTDDNEXT+1 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 %thenstart AMTDD(FROM)=DDASL(MAXBLOCK) DDASL(MAXBLOCK)=FROM FREEMAX=FREEMAX+1 FROM=FROM+MAXBLOCK %finishelsestart %if FROM<=TO %then 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 %record (AMTF) %name AMT %shortintegername PTR AMT==AMTA(AMTX) DA=AMT_DA AMT_DA=X'FF000000' *SR_0,0; *L_1,DA; *LA_2,509; *DR_0,2; *ST_0,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 J=AMTDD(I)&STXMASK AMTDD(I)=0 %if J#STXMASK %then STORE(J)_FLAGS=0 %repeat I=DDASL(LEN) AMTDD(DDX)=I DDASL(LEN)=DDX %end %end !----------------------------------------------------------------------- %if MONLEVEL&X'3C'#0 %thenstart %externallongintegerspec SEMATIME %routine TIMEOUT !*********************************************************************** !* Print out the session timing measurements * !*********************************************************************** %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","", "Activemem(Poll)","Schedule(Oper)","Overalloc cntrl",""(14), "", "Disc","Disc transfers","Disc interrupt","","Move requests", "Move transfers",""(2), "","","",""(5),"Devio requests","Tape", "Oper","LP adaptor","CR adaptor","CP adaptor","Printer", "Comms control","Combine","FEP adaptor","Devio interrupt", ""(2),"Bmrep","COmrep",""(2),"Local control","Foregrnd users", "Backgrnd users" %integer I,J,K %longreal PERIOD,TOTAL,IDLETIME,PROCTIME,SERVTIME,RSEMATIME %string (15) S %string (31) %fnspec STRPRINT(%longreal X, %integer A,B) %if MULTIOCP=YES %then RESERVE LOG %if MONLEVEL&4#0 %start PERIOD=(CLOCK-PERFORM_CLOCK)>>12 I=ADDR(COM_DATE0)+3 NEWPAGE PRINT STRING(" EMAS370 Sup".SUPID." Timing measurements ".STRING(I)." ".STRING(I+12)." Period=".STRPRINT(PERIOD/1000000,1,3)." Secs") %if MULTIOCP=YES %then PERIOD=PERIOD*COM_NOCPS IDLETIME=COM_ITINT*(IDLEIT+NOWORKIT) PROCTIME=COM_ITINT*(FLPIT+BLPIT) PRINT STRING(" Service Calls Time Average % of ". %c "% of % of (Secs) (Msecs) Total ". %c "Non-idle Supvsr ") TOTAL=0 %cycle I=0,1,LOCSN0+3 S=SERVROUT(I) J=PERFORM_SERVN(I) %if S#"" %and J>0 %thenstart PRINT STRING(" ".S.STRSP(16-LENGTH(S)).STRPRINT(J,9,0)) SERVTIME=COM_ITINT*PERFORM_SERVIT(I) PRINT STRING(STRPRINT(SERVTIME/1000000,6, 3).STRPRINT((SERVTIME/1000)/J,6, 3).STRPRINT(100*SERVTIME/PERIOD,7, 1)."%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME),6, 1)."%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME-PROCTIME), 6,1)." ") TOTAL=TOTAL+SERVTIME %finish %repeat RSEMATIME=SEMATIME PRINT STRING(" Interrupt/Activate etc.=".STRPRINT((PERIOD-TOTAL)/1000000,1, 3)." secs (".STRPRINT(100*(PERIOD-TOTAL)/PERIOD,1,1)."%) Semalockout=".STRPRINT(RSEMATIME/1000000,1, 3)."secs(".STRPRINT(100*RSEMATIME/PERIOD,1,1)."%) ") PRINTSTRING(" Overalloc=".STRINT(OVERALLOC)." Pageins=".STRINT(PERFORM_PTURNN)." Recaptures=".STRINT(PERFORM_RECAPN)." Shared pages=".STRINT(PERFORM_PSHAREN)." New pages=".STRINT(PERFORM_NEWPAGEN)." Writeouts=".STRINT(PERFORM_PAGEOUTN)." Pages zeroed=".STRINT(PERFORM_PAGEZN)." Pages snoozed=".STRINT(PERFORM_SNOOZN)." Pages aborted=".STRINT(PERFORM_ABORTN)) PRINTSTRING(" Snoozes complete =".STRINT(PERFORM_SNOOZOK)." Snoozes timedout =".STRINT(PERFORM_SNOOZTO)." Snoozes abandoned=".STRINT(PERFORM_SNOOZAB)." ") %finish %if MONLEVEL&32#0 %thenstart NEWPAGE PRINTSTRING(" Category table transitions TO->") %cycle I=4,1,MAXCAT WRITE(I,4) %repeat NEWLINE %cycle J=1,1,MAXCAT WRITE(J,3) %cycle I=4,1,MAXCAT K=CATREC(I,J) WRITE(K,4) %repeat NEWLINE SPACES(4) %cycle I=4,1,MAXCAT K=FLYCAT(I,J) %if K#0 %then WRITE(K,4) %else SPACES(5) %repeat NEWLINE %repeat %finish %if MONLEVEL&16#0 %thenstart PRINTSTRING(" Cat Seqout Strobes Epsexamined Epsout ") %cycle I=1,1,MAXCAT %if STROBEN(I)#0 %start WRITE(I,2) WRITE(SEQOUT(I),7) 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 LENGTH(S)=127; ! avoid charno check 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 %thenexit; ! 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 * !*********************************************************************** %integer I,J %if MONLEVEL&4#0 %thenstart %cycle I=0,1,LOCSN0+3 PERFORM_SERVIT(I)=0 PERFORM_SERVN(I)=0 %repeat PERFORM_RECAPN=0 PERFORM_PTURNN=0 PERFORM_PSHAREN=0 PERFORM_NEWPAGEN=0 PERFORM_PAGEOUTN=0 PERFORM_PAGEZN=0 PERFORM_SNOOZN=0 PERFORM_ABORTN=0 PERFORM_SNOOZOK=0 PERFORM_SNOOZTO=0 PERFORM_SNOOZAB=0 SEMATIME=0 PERFORM_CLOCK=CLOCK %finish %if MONLEVEL&32#0 %thenstart %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 %thenstart %cycle I=0,1,MAXCAT STROBEN(I)=0 STREPN(I)=0 STROUT(I)=0 SEQOUT(I)=0 %repeat %finish %end %finish %routine UPDISP(%integer PROCESS,OFFSET, %string (13) S) %integer LINE,POS PROCESS=PROCESS-1 LINE=PROCESS//3; ! 3 PER LINE +HEADER POS=(PROCESS-3*LINE)*13; ! 40CHARS FOR EACH 3 PROCS DISPLAY TEXT(-1,LINE+5,POS+OFFSET,S); ! CURRENTLY 5 HEADER LINES %end ! !----------------------------------------------------------------------- ! %include "ercc07.lcs" !%include "ercc08.lcs" !----------------------------------------------------------------------- %end !*********************************************************************** !* THESE THREE ROUTINES ARE SYTEMCALLED DIRECTLY FROM USER * !*********************************************************************** %externalintegerfn REQUEST INPUT(%integer OUTPUT POSN,TRIGGER POSN) %unless IOSTAT_OUTBUFLEN>0 %and 0<=OUTPUT POSN0 %and 0<=TRIGGER POSN0 %and 0<=OUTPUT POSN