! Changes for vsn 12F ! 1) Quicker reversion to standard seg table on lcexit in case at destroy ! too much assistance is received from the other idle cpu. ! ! Changes for vsn 12E ! 1) Corrections to timing to remove errors around LC activation ! ! Changes for vsn 12D ! 1) Convert count od services to long integers ! Changes for vsn 12C ! 1) Corrections to semaphoring for duals ! 2) Single mode forces com_nocps=1 ! 3) Changes to clock tick code for greater symmetry in duals ! ! Changes for vsn 12B ! 1) Increase in category table for bigger working sets ! 2) Increase also in CBT space needs a Director change ! ! Changes for vsn 12A ! 1) AMTDD expanded from short to full array and corresponding changes ! to store and AMT arrays so as to avoid the restriction of 16 bit pntrs ! ! Changes for vsn 11B ! 1) Removal of DEADlock code ! 2) Reduction of the TIMESLICE ! 3) Change to write protection via page tables ! ! Changes for vsn 11a ! 1) Reactivation of dualling code ! ! Changes for vsn 10m ! 1) Strobing frequency reduced as overstrobing occurred saturatin ! the disc channels ! ! Changes for 10N ! 1) Changes in case mc check in activate sequence ! 2) Fast changes to merge pons of update output (STH) ! %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 ! %CONST %LONG %INTEGER DISAWAIT=PSW0!X'2000000000000' %CONST %LONG %INTEGER ALLOW INTS=x'0306000000000000' %CONST %LONG %INTEGER ONE SECOND=x'00000000F4240000' ! %OWN %LONG %INTEGER PSW,WPSW,L ! %INCLUDE "ercc07:ibmsup_lcform7s" ! %if xa=2900 %then %Start %EXTERNAL %INTEGER %FN %SPEC REQUEST INPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %EXTERNAL %INTEGER %FN %SPEC REQUEST OUTPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %EXTERNAL %INTEGER %FN %SPEC CHANGE CONTEXT %finish %EXTERNAL %ROUTINE SUP01 !----------------------------------------------------------------------- %OWN %STRING (3) SUPID="12F" !--------------------- ! EMAS/370 vsn 10B ! %CONST %STRING (3) CHOPID="01A"; ! EARLIEST COMPATABLE CHOPSUPE !----------------------------------------------------------------------- %INCLUDE "ercc07:ibmsup_comf370" %INCLUDE "ercc07:ibmsup_page0f" %INCLUDE "ERCC07:IBMSUP_XAIOFORM" %CONST %INTEGER EPAGESHIFT=12; ! 4*1024==1<<12 !----------------------------------------------------------------------- ! MISC. ROUTINE SPECS %EXTERNAL %STRING %FN %SPEC HTOS(%INTEGER N,PL) %EXTERNAL %STRING (15) %FN %SPEC STRINT(%INTEGER N) %EXTERNAL %STRING (8) %FN %SPEC STRHEX(%INTEGER N) %EXTERNAL %STRING (63) %FN %SPEC STRSP(%INTEGER N) %EXTERNAL %ROUTINE %SPEC PKMONREC(%STRING (20) TEXT, %RECORD (PARMF) %NAME P) %EXTERNAL %ROUTINE %SPEC MONITOR(%STRING (63) S) %EXTERNAL %ROUTINE %SPEC MOVE(%INTEGER LEN,FROM,TO) %EXTERNAL %ROUTINE %SPEC NDIAG %ALIAS "S#NDIAG"(%INTEGER PC,LNB,FAULT,XTRA) %EXTERNAL %ROUTINE %SPEC OPMESS(%STRING (63) S) %EXTERNAL %ROUTINE %SPEC DISPLAY TEXT(%INTEGER SCREEN,LINE,CHAR, %STRING (41) S) %EXTERNAL %ROUTINE %SPEC UPDATE TIME %EXTERNAL %ROUTINE %SPEC DPONPUTONQ(%RECORD (PARMF) %NAME P) %EXTERNAL %ROUTINE %SPEC DUMP TABLE(%INTEGER TABNO,ADR,LEN) %SHORT %INTEGER %NAME FSTASL,BSTASL %INTEGER I,J,Stackbase,FREEEPAGES,SHAREDEPS,UNALLOCEPS,MAXP4PAGES,P4PAGES,SXPAGES,NPQ,OLDLNB,DONT SCHED, MPLEVEL,PAGEFREES,DCLEARS,GETEPN,PREEMPTED,SNOOZTIME %longinteger nextcc; ! Next clock comparator %STRING (3) STRPROC %IF MONLEVEL&4#0 %START %LONG %INTEGER %NAME IDLEIT,NOWORKIT,LCIT,FLPIT,BLPIT,PTIT,PDISCIT,RETIT,AMIT %LONGINTEGER %NAME IDLEN,NOWORKN,LCN,FLPN,BLPN,PTCALLN,PDISCCALLN,RETCALLN,AMCALLN %LONGINTEGER CMAX CPU TIMER; ! Corrected version for timings %FINISH !----------------------------------------------------------------------- ! CONFIGURATION DECLARATIONS !----------------------------------------------------------------------- %CONST %INTEGER %ARRAY %NAME SEG TAB=SEGTABVA %IF XA=YES %THEN %START %INTEGER %ARRAY %FORMAT PTF(0:63) %FINISH %ELSE %START %SHORT %INTEGER %ARRAY %FORMAT PTF(0:63); ! page table format %FINISH %RECORD (CONTEXTF) LC ICONTEXT; ! initial Local controller context !----------------------------------------------------------------------- ! STORE TABLE ETC. DECLARATIONS %RECORD %FORMAT STOREF(%SHORT %INTEGER FLAGS,USERS, %integer LINK, %short %integer BLINK,FLINK) %CONST %RECORD (STOREF) %ARRAY %NAME STORE=STORE0AD; ! one record per page %CONST %INTEGER STOREFSIZE=12; ! size of element of store array %EXTERNAL %INTEGER STORE SEMA=-1 %INTEGER SPSTOREX; ! for keeping emergency spare page !----------------------------------------------------------------------- ! ACTIVE MEMORY TABLE DECLARATIONS %CONST %INTEGER MIN RESIDENCES=3,MAXRESIDENCES=15; ! FOR AMT TIMEOUTS %OWN %INTEGER RESIDENCES=MAXRESIDENCES; ! ADJUSTED DOWN AS DRUM FILLS %IF XA=NO %THEN %START %CONST %INTEGER MAXAMTAK=32 %CONST %INTEGER MAXAMTDDK=64 %ELSE %CONST %INTEGER MAXAMTAK=MAXPROCS//2 %CONST %INTEGER MAXAMTDDK=3*MAXAMTAK %FINISH %RECORD %FORMAT AMTF(%INTEGER DA,DDP, %SHORT %INTEGER SPARE,USERS,LINK, %BYTE %INTEGER 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 %CONST %INTEGER AMTFLEN=16 %CONST %RECORD (AMTF) %ARRAY %NAME AMTA=AMTASEG<>2) %longintegerarray mcel(-1:127); ! 1024 byte logout area %INTEGER %ARRAY %NAME 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. %ROUTINE %SPEC LOCAL CONTROL %ROUTINE %SPEC GLOBAL CONTROL(%integer param) %OWN %INTEGER %ARRAY %FORMAT LSTF(0:LSTLEN-1) %OWN %INTEGER TIMESLICE=X'2000'; ! 8192 MICROSECS %OWN %INTEGER OUT18CHARGE=X'800'; ! CHARGE FOR OUT 18 =8 MILLESECS %OWN %INTEGER OUT18INS; ! CHARGE *INS RATE %IF XA=AMDAHL %START %CONST %BYTE %INTEGER API=x'0C' %FINISH %ELSE %START %CONST %BYTE %INTEGER API=X'04' %FINISH %OWN %BYTE %INTEGER ALLOW PERI INTS=API; ! changed in schedule - act 0 %OWN %BYTE %INTEGER MASKPX=API; ! mask peri & external ints ! COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE ! %IF COM_TSLICE>0 %THEN TIMESLICE=COM_TSLICE//COM_ITINT COM_TSLICE=TIMESLICE OUT18CHARGE=TIMESLICE>>3; ! ONE EIGHTH OF TSLICE OUT18INS=OUT18CHARGE*COM_INSPERSEC*COM_ITINT//1000 ! ! Enable Machine Check extended logouts may help Engineers ! mcel(-1)=x'4D43454C41524541' mcel(i)=0 %for i=1,1,127 i=addr(Mcel(0)) *l_1,i; *lra_2,0(1); *st_2,i; *lctl_15,15,i;! addr logout ares mcel(0)=i *stctl_14,14,i i=i!X'00800000' *lctl_14,14,i *st_11,Stackbase; ! Global controller stacks start here ! ! Set up kernel context ! *mvi_640(0),0; ! flag byte.... ! ... 0 = executing in kernel ! ff = executing in LC or user *l_15,stackbase *stm_4,15,656(0); ! general registers *stctl_0,15,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 *o_2,PSW+4; ! add bit 32 - needed on xa for 31 bit addressing *st_2,PSW+4 LC ICONTEXT_PSW=PSW I=ADDR(LC ICONTEXT) *l_1,I *mvc_24(44,1),656(0); ! GRs *mvc_104(64,1),704(0); ! CRs LC ICONTEXT_GR(11)=ADDR(LC TABLES_END) LC ICONTEXT_CPU TIMER=MAX CPU TIMER ! ! Set up restart context for multiocp used to bring in an ocp ! %if multi ocp=yes %start PSW=PSW0 *basr_1,0; *using_1 *la_2,; *drop_1 *O_2,PSW+4; *st_2,Psw+4 longinteger(X'A00')=PSW integer(X'A08')=X'B70F02C0'; ! LCTL 0,15,704(0) integer(X'A0C')=X'82000A00'; ! LPSW X'A00'(0) PSW=X'001C0E0000000A08'; ! No DAT,24 bit Add=X'a08' longinteger(0)=PSW %else com_nocps=1 %finish ! ! Set up clock comparator for a tick every second. In multiple OCPs ! the tick cycles round the IPs. If an Ip drops out the ticks will still ! come every second on remaining OCPs. A good algorithm which is not ! semaphored since the ticks should be far aprt and never simultaneous ! *STCK_Nextcc Next CC=Next CC+One second *SCKC_Next CC Next CC=NextCC+one second ! 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 SHAREDEPS=0 UNALLOCEPS=FREEEPAGES-comms epages-8{Bulk mover etc} !----------------------------------------------------------------------- %CYCLE I=0,1,MAXPROCS PROCA(I)=0 %REPEAT I=PPINIT(NEW EPAGE) P4PAGES=0 SXPAGES=0 MAXP4PAGES=P4PERCENT*COM_SEPGS//100 NPQ=0 %IF SNOOZING=YES %THEN SNOOZTIME=30 %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 EVERY 2 SECS 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'120000'; P_P2=1 PON(P); ! kick random tagtest every second %END ! ! Enter Global controller ! GLOBAL CONTROL(0); ! 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! RESTARTEP: ! To bring in further OCPs ! *LCTL_0,15,704(0) ! Now done on page 0 before coming here *LM_4,15,656(0) *LR_11,15; ! Stack pointer set up by config *SCKC_Next CC Next CC=NextCC+one second global control(1) ! !--------------------------------------------------------------------- ! %ROUTINE GLOBAL CONTROL(%integer param) !*********************************************************************** !* Thread of contro stays here in concept throughout * !* There is a separate incarnation of G-C for each CPU * !* Param=0 for IPL entry =1 for CPU configured in * !*********************************************************************** %ROUTINE %SPEC UNQUEUE(%INTEGER %NAME QUEUE,UNQUED SERVICE) %INTEGER Myport,I,J,K,SELN,SESTK,KSERVICE,LSERVICE,MCERR1,MCerr2,fsa,errbit,IDLE %IF MONLEVEL&4#0 %START %INTEGER TSERVICE %FINISH %LONG %INTEGER L,CC,MCTEMP %RECORD (IRBF) IRB; ! for xa interrupt response block %IF MONLEVEL&4#0 %START %LONG %INTEGER IT,KIT %INTEGER IT CORRN %CONST %INTEGER IINC=20; ! ins. not counted in idle %FINISH %INTEGER %NAME CURPROC %SWITCH SERVROUT(0:LOCSN0); ! KERNEL SERVICES %RECORD (PROCF) %NAME PROC; ! STATUS BITS SIGNIFY AS FOLLOWS %RECORD (SERVF) %NAME KSERV,LSERV,LSERVQ %INTEGER %NAME 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 ! Registers saved for us but may be validated *lm_4,14,656(0); ! restore env but must be used with care *LCTL_0,0,704(0); *lctl_14,14,760(0);! Turn off low store protection ! Should we reset CTR1?? mcerr1=integer(232); mcerr2=integer(236) fsa=integer(248) %if XA=Amdahl %then fsa=fsa&X'00FFFFFF' fsa=fsa>>12; ! failing store address as page errbit=mcerr1&x'80' %if errbit#0 %and mcerr1&x'e000'#0 %and fsaMCOUT; ! recovered condition %if (mcerr1&x'dc000000'=x'08000000' %or mcerr1&x'dc000000'= %c X'10000000') %and mcerr1&x'f1c' =x'f1c' %then ->mcclock ! clock or timer damge but regs ok ! ! Can not continue but set up regs for dump program ! *MVC_2048(8,0),48(0); ! psw *MVC_2056(64,0),384(0); ! GRS *MVC_2152(64,0),448(0); ! CTR Regs *MVC_2120(32,0),352(0); ! FPR *MVC_2216(8,0),216(0); ! Timer *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); *stctl_14,14,160(1);! CRs 0,1 *stpt_168(1); ! CPU timer *lctl_0,0,704(0); *lctl_14,14,760(0);! turn off lowstore protection EXK: %IF MONLEVEL&4#0 %AND IDLE#0 %START *stpt_KIT %IF MPLEVEL+NPQ>12 %ELSE %C IDLEIT=IDLEIT+(CMAX CPU TIMER-KIT)>>12 IDLE=0 %FINISH *spt_MAXCPUTIMER %if mcerr1#0 %start %if multiocp=NO %then opmess("Recovered MC Check") %else %c opmess("Recovered MC CHK OCP".strint(getmyport)) opmess("P=".strhex(mcerr1).strhex(mcerr2)) mcerr1=0 %finish %IF PAGE0_EXT CODE=x'1004' %START; ! clock comparator P_P3=INTEGER(ADDR(L)) P_P4=INTEGER(ADDR(L)+4) *sckc_Next CC Next CC=Next CC+ONE SECOND; ! reset for 1 sec tick P_P5=INTEGER(ADDR(L)) P_P6=INTEGER(ADDR(L)+4) P_DEST=X'A0000' P_SRCE=M'EINT' %if MULTIOCP=no %then ELAPSED INT(P) %else pon(P) %IF MONLEVEL&4#0 %THEN TSERVICE=10 %AND ->KTIMES ->KSERVE %FINISH %ELSE %IF 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); *stctl_14,14,160(1);! CRs 0,1 *stpt_168(1); ! CPU timer *lctl_0,0,704(0); *lctl_14,14,760(0);! turn off lowstore protection IOK: ! ! parameters of the interrupt pon ! on non XA machines ! P_P1 = channel unit interupting ! P_P2 and P_P3 are the csw1&2 from page 0 ! P_P4 is the device slot via a chopsupe table ! ! on XA machines ! P_P1 is the IP which has the virtad of the device slot ! P_P2&P3 are words 1&2 of SCSW (very close to csw1&2) ! P_P4 is SCSW word 0 (no nonxa equivalent) ! P_P5 is the extended Subchannel status word ! %IF MONLEVEL&4#0 %AND IDLE#0 %START *stpt_KIT %IF MPLEVEL+NPQ>12 %ELSE %C IDLEIT=IDLEIT+(CMAX CPU TIMER-KIT)>>12 IDLE=0 %FINISH *spt_MAXCPUTIMER %IF XA=YES %START I=PAGE0_XASIW J=PAGE0_XAIOIP; ! interrupt param is address of device slot *basr_3,0 *using_3 *l_1,i *la_2,irb *tsch_0(2) *bc_1,; ! failed to get interrupt data *l_1,j; *lra_2,0(1); ! Validate slot address *bc_7, *drop_3 P_P1=J P_DEST=INTEGER(J); !_iserv in slot is the interrupt service P_SRCE=M'INT' P_P2=IRB_CSW1 P_P3=IRB_CSW2 P_P4=IRB_KEYCNTR P_P5=IRB_XSTATUSW %IF P_DSNO=32 %THEN %START DISC(P) %IF MONLEVEL&4#0 %THEN TSERVICE=34 %ELSE DEVIO(P) %IF MONLEVEL&4#0 %THEN TSERVICE=58 %FINISH %IF MONLEVEL&4#0 %THEN ->KTIMES %ELSE ->KSERVE FAILCC: OPMESS("cc=3 on get int slot=".strhex(j)) ->KSERVE %ELSE P_DEST=3 P_SRCE=M'INT' 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 %FINISH %ELSE %IF I#255 %START DEVIO(P) %IF MONLEVEL&4#0 %THEN TSERVICE=58 %FINISH %ELSE %IF 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 %FINISH ! !----------------------------------------------------------------------- !---------------------------------------- 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) *lctl_0,0,704(0); *lctl_14,14,760(0);! turn off lowstore protection *la_11,4088(11) Stop other OCP Com_Failingport=myport 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) Stop other OCP Com_Failingport=myport *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) Stop other OCP Com_Failingport=myport *lpsw_2224(0) ! !---------------------------------------------------------------------------- ! MCCLOCK: ! Recover from clock or timer damage *STCK_mctemp; ! recalculate clock comparator mctemp=mctemp+one second>>1; ! half a second from now longinteger(224)=mctemp longinteger(216)= Timeslice<<11; ! Half average timeslice MCOUT: ! Exit from mc check sequence %if mcerr1&x'20000000'#0 %then integer(448+4*14)=integer(448+4*14)&(\x'08000000') ! Suppress further recovered error pro tem *LD_0,352(0); *LD_2,360(0); *LD_4,368(0); *LD_6,376(0) *SCKC_224(0) *SPT_216(0) *LCTL_0,15,448(0) *LM_0,15,384(0) *LPSW_2048(0) ! ! End of machine check recovery sequence ! GO: ! set up interrupt PSWs %if Param=0 %start; ! Ipl set up 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&X'FFFBFFFFFFFFFFFF')!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 %finish ! CURPROC==COM_CURPROC %if multiocp=yes %then %Start Myport=getmyport %for j=1,1,com_Nocps %cycle %if Myport=COM_OCP Port(j) %then CURPROC==COM_OCP Proc(j) %and %exit %repeat %finish CURPROC=0 mcerr1=0; ! No machine checks yet idle=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=2048+1024*(IINC<<12)//(COM_INSPERSEC*COM_ITINT) CMAX CPU TIMER =MAX CPU TIMER+ IT CORRN;! Correct for overhed ! involved in timer swopping etc %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 %THEN %START %IF XA#YES %and com_schannelq#0 %THEN P_dest=x'30000E' %AND devio(p) %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 ->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 *ld_0,72(1); *ld_2,80(1); ! FPRs *ld_4,88(1); *ld_6,96(1) *lctl_0,1,104(1); *lctl_14,14,160(1);! CRs 0,1 *spt_168(1); ! CPU timer *mvc_2048(8,0),0(1); ! PSW to page 0 *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) ! ! in duals it is possible that there will still be TLB entries relating ! to this user in this ocp even tho the other OCP was the last to execute ! this users. Hence need a purge tlb on each activation of a different proc ! %if multi ocp=yes %then %start; *PTLB_0(0); %finish ->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 %THEN %START %IF MPLEVEL+NPQ>12&511 %cycle; ! random traverses %repeat *SSM_maskpx %IF MONLEVEL&4#0 %START *stpt_KIT %IF MPLEVEL+NPQ>12 %ELSE %C IDLEIT=IDLEIT+(CMAX CPU TIMER-KIT)>>12 IDLE=0 %FINISH ->KSERVE %FINISH %FINISH ! ! MAIN QUEUE SERVICING SECTION ! %IF KSERVICE=0 %THEN %START UNQUEUE(KERNELQ,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) %IF MONLEVEL&4#0 %THEN 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(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(17): CONFIG CONTROL(P); ->KEXIT SERVROUT(18): TAGTEST(P); ->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 unalloceps+sharedeps<0 %then Monitor("Store Scheduling?") %IF MONLEVEL&4#0 %THEN %START *stpt_L IT=(CMAX CPU TIMER-L)>>12 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 ! I=PROC_LSTAD %IF XA=YES %THEN I=I!X'14' %ELSE I=I!14<<24 %IF MONLEVEL&4#0 %THEN %START LCN=LCN+1 *STPT_L LCIT=LCIT+(CMAX CPU TIMER-L)>>12;! Count this activation overhead as part of LC %FINISH *lctl_1,1,I; ! segment table length/origin ! ! in duals it is possible that there will still be TLB entries relating ! to this user in this ocp even tho the other OCP was the last to execute ! this users. Hence need a purge tlb on each activation of a different proc ! %if multi ocp=yes %then %start; *PTLB_0(0); %finish I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *lctl_0,1,104(1); *lctl_14,14,160(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 *lctl_1,1,708(0); ! l-c may page out or on destroy seg table is ! made new and reused so revert to kernal pst ! 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 %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 MULTI OCP=YES %THEN MAINQSEMA=-1 ->KSERVE !----------------------------------------------------------------------- %ROUTINE UNQUEUE(%INTEGER %NAME 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 TAGTEST(%RECORD (PARMF) %NAME P) !*********************************************************************** !* Service 18. Takes a page from the free list and checks out the * !* store markers then returns the page. Called every second during * !* normal service. * !*********************************************************************** %INTEGER RA,VA,STOREX,MARK,I,J %ROUTINE %SPEC CHECK(%INTEGER EXP) %OWN %INTEGER COUNT=0 %IF MONLEVEL&2#0 %AND KMON&1<<18#0 %THEN PKMONREC("tagtest:",P) %if multi ocp=yes %then semaloop(storesema) STOREX=QUICK EPAGE(1,x'10') %if multiocp=yes %then storesema=-1 %RETURN %IF STOREX<=0; ! free list is empty COUNT=(COUNT+1)&x'ffffff'; ! avoid overflow in long seesions RA=4096*STOREX; ! test different byte in page each time VA=RTV(RA)+COUNT&2047; ! get virtual address ! ! check that key sets and reads ok there have been problems ! end up with key back to 1 as it is now ! %cycle i=2,1,17 j=(i&15)<<4 *L_1,ra; *l_2,J; *sr_0,0 %if xa=yes %start *SSKE_2,1; *ISKE_0,1; *ST_0,MARK %finish %else %if XA=Amdahl %Start *SSK_2,1; *ISK_0,1; *ST_0,mark %else *SSK_2,1; *isk_0,1; *ST_0,mark *LA_1,2048(1) *SSK_2,1; *ISK_0,1; *O_0,MARK; *ST_0,MARK %finish CHECK(j) %repeat *l_1,va; *ic_0,0(1); ! read one byte *l_2,RA; *SR_0,0; %IF XA#YES %THEN %START; ! XA does not get this right so omoit check!!!! %if XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK %ELSE *ISK_0,2; *ST_0,MARK; ! KEY ON 1ST 2 K *LA_15,2048(2); *ISK_0,15; ! 2ND SET OF MARKERS *O_0,MARK; *ST_0,MARK %FINISH CHECK(x'14') %finish ! code to reset referenced bit only *l_2,RA %IF XA=YES %THEN %START *RRBE_0,2; ! REFERENCED BIT RESET %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *RRB_0(2) %ELSE *LA_15,2048(2); ! 2ND SET OF MARKERS *RRB_0(2); *RRB_0(15); ! MARKERS RESET %FINISH *l_2,RA; *SR_0,0; %IF XA=YES %THEN %START *ISKE_0,2; *ST_0,MARK; ! MARKERS TO MARK %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK %ELSE *ISK_0,2; *ST_0,MARK; ! KEY ON 1ST 2 K *LA_15,2048(2); *ISK_0,15; ! 2ND SET OF MARKERS *O_0,MARK; *ST_0,MARK %FINISH CHECK(x'10') *l_1,va; *ic_0,0(1); *stc_0,0(1) *l_2,RA; *SR_0,0; %IF XA=YES %THEN %START *ISKE_0,2; *ST_0,MARK; ! MARKERS TO MARK %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK %ELSE *ISK_0,2; *ST_0,MARK; ! KEY ON 1ST 2 K *LA_15,2048(2); *ISK_0,15; ! 2ND SET OF MARKERS *O_0,MARK; *ST_0,MARK %FINISH CHECK(x'16') ! code to reset referenced bit only *l_2,RA %IF XA=YES %THEN %START *RRBE_0,2; ! REFERENCED BIT RESET %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *RRB_0(2) %ELSE *LA_15,2048(2); ! 2ND SET OF MARKERS *RRB_0(2); *RRB_0(15); ! MARKERS RESET %FINISH *l_2,RA; *SR_0,0; %IF XA=YES %THEN %START *ISKE_0,2; *ST_0,MARK; ! MARKERS TO MARK %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK %ELSE *ISK_0,2; *ST_0,MARK; ! KEY ON 1ST 2 K *LA_15,2048(2); *ISK_0,15; ! 2ND SET OF MARKERS *O_0,MARK; *ST_0,MARK %FINISH CHECK(x'12') P_P2=STOREX P_DEST=x'60000' STOREX=RTV(-1) RETURN EPAGE(P) %RETURN %ROUTINE CHECK(%INTEGER EXP) %IF MARK#EXP %START OPMESS("tagtest fails on page ".STRINT(STOREX)) OPMESS("Exp=".HTOS(EXP,2)." Act ".HTOS(MARK,2)) %FINISH %END %END !%routine adjusteps(%integer amount) !%owninteger previous ! %if imod(amount)>650 %then monitor("bad adjustment") ! %if unalloceps+sharedeps<0 %then monitor("Already corrupt") ! unalloceps=unalloc eps+amount ! %if unalloceps+sharedeps<0 %then monitor("Pages -ve") ! previous=unalloceps !%end %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? * !*********************************************************************** %ROUTINE %SPEC PARE EPAGES %ROUTINE %SPEC ONPQ %CONST %INTEGER PRATMAX=255,PRIQS=5 %CONST %BYTE %INTEGER %ARRAY 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 %OWN %INTEGER PRATP=0,SCHTICKS=0 !----------------------------------------------------------------------- ! PRIORITY QUEUE ARRAY ETC. %OWN %BYTE %INTEGER %ARRAY PQ(1:MAXPROCS)=0(MAXPROCS) %OWN %BYTE %INTEGER %ARRAY PQH(1:PRIQS)=0(PRIQS); ! NUMBER OF PRIORITIES=PRIQS %OWN %BYTE %INTEGER %ARRAY PQN(1:PRIQS)=0(PRIQS) %IF MONLEVEL&1#0 %THEN %START %OWN %INTEGER SUSPN=0 %CONST %STRING (2) %ARRAY STRPN(1:PRIQS)="P1","P2","P3","P4","P5" %FINISH %CONST %STRING (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) SSG: %FINISH ->ACTIVITY(ACT&255) !----------------------------------------------------------------------- ACTIVITY(0): ! INITIALISE %IF STRING(ADDR(COM_SUPVSN))COM_MAXPROCS %THEN OPMESS("Bad Confign") %AND %RETURN 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 %THEN %START 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 USER="IP ".STRINT(COM_OCPPORT(1)) DISPLAY TEXT(0,4,13,USER) 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 user="CALLER" %then process=6 %IF USER="INFORM" %THEN PROCESS=7 %IF USER="REMOTE" %then PROCESS=8 %if user="PADOUT" %then process=9 %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_INCAR=INCAR PROC_ACTIVE=0; ! SUSPENDED PROC_CATEGORY=0 %IF MONLEVEL&1#0 %THEN SUSPN=SUSPN+1 %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) %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 XEPSGIVE PAGES ->WAYOUT %IF XEPS>SHAREDEPS+UNALLOCEPS %if FREE EPAGES>4*MAXEPAGES %THEN -> GIVE PAGES;! Very large store cond 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 unalloc eps=unalloc eps-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 PROCESS>=FIRST UPROC %THEN %C PROC_P4TOP4=PROC_P4TOP4+1 %IF MONLEVEL&32#0 %THEN 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 EXECUTIVES ! BE KIND TO VOLUMS&SPOOLR P_P1=0 %IF OLDCAT_PRIORITY>=4 %AND P4PAGES>=MAXP4PAGES %AND SXPAGES>(SHAREDEPS+UNALLOCEPS) %AND %C PROCESS>=FIRST UPROC %THEN ->WAYOUT NEWCATSLOT=OLDCAT_MORET NEWCAT==CATTAB(NEWCATSLOT) %IF PROC_STATUS&HADTONFLY=0 %AND PQN(1)+PQN(2)=0 %THEN ->GIVE TIME %if FREE EPAGES>4*MAXEPAGES %THEN ->GIVE TIME;! VERY large store cond 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 EXECUTIVES MORE ! TIME IF SYSTEM IS CONFIGURED ! SO ONLY 1 P4 CAN BE IN STORE %IF PROCESS0 %AND P4PAGES<=OLDCAT_EPLIM %THEN ->WAYOUT GIVE TIME: ! WITHOUT REQUEING PROC_STATUS=PROC_STATUS!HADTONFLY PARE EPAGES; ! AND MAP NEWCAT unalloc eps=unalloc eps+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 %THEN %START !%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 ->WAYOUT NEWCATSLOT=OLDCAT_SUSP newcat==cattab(newcatslot) %IF MONLEVEL&1#0 %THEN %START 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 unalloc eps=unalloc eps+OLDCAT_EPLIM-PROC_EPN %IF MONLEVEL&32#0 %THEN 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 unalloc eps=unalloc eps+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 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=2; ! make new ie discard *ptlb_0(0) %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 PROCESS>=FIRST UPROC %THEN %C PROC_P4TOP4=PROC_P4TOP4+1 %IF MONLEVEL&32#0 %THEN 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 %START I=0 *PTLB_0(0); ! needed for some tlbs in case a different ! seg table paged into same page %FINISH %CYCLE I=I,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I %IF I>=LSTACKLENP %THEN P_P2=2 %ELSE P_P2=X'9'; ! 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 unalloc eps=unalloc eps+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) %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 INCONVENIENCED. ! %IF PTY>=4 %THEN %START %IF P4PAGES>0 %AND P4PAGES+OLDCAT_EPLIM>MAXP4PAGES %AND 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 %THEN %START; ! NOT ENOUGH ROOM ->WAYOUT %FINISH PROC_EPA=OLDCAT_EPLIM unalloc eps=unalloc eps-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 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 unalloc eps=unalloc eps+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 STORE %CYCLE I=1,1,MAXPROCS PROC==PROCA(I) %IF PROC_USER#"" %AND (PROC_ACTIVE=255 %OR 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(PROCESS)) ->DESTROY %FINISH LSTAD=PROC_LSTAD LLSTVAD=RTV(LSTAD) MOVE(LCSTKSEG*4,SEGTAB VA,LLSTVAD) %IF OLDCATSLOT=0; ! initialise 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{&X'0000FFFF'}; ! DD POINTER FOR PAGE O OF LC %IF PROC_STATUS&STATEX#0 %THEN %START PROC_STATUS=PROC_STATUS!!STATEX %IF MONLEVEL&4#0 %THEN PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP I=LSTACKLENP %FINISH %ELSE 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 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 %THEN %START; ! process being created %IF XA=YES %THEN J=x'20' %ELSE J=1 %FOR I=LCSTKSEG+1,1,LSTLEN-1 %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 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 %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 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 K=PROC_LSTAD!(LSTLEN//16-1)<<24 LLC TABLES_CONTEXTS(0)_CONTROLR(1)=K I=RTV(-1); ! invalidate entry *PTLB_0(0) %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#"" %THEN %START %IF I>=FIRST UPROC %AND PROC_ACTIVE=3*MINSINACTIVE %AND 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 %THEN %START %BEGIN %INTEGER %ARRAY 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(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 %C 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 * !*********************************************************************** %CONST %INTEGER LEEWAY=5 %CYCLE NEWCAT==CATTAB(NEWCATSLOT) %IF NEWCAT_LESSP=0 %OR P_P2+LEEWAY>CATTAB(NEWCAT_LESSP)_EPLIM %THEN 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 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 : REPLY FROM PAGE READ AHEAD * !* ACTIVITY 7 : (WAS REPLY FROM DRUM/WRITE) * !* ACTIVITY 8 : REPLY FROM ZERO DISC EPAGE * !* ACTIVITY 9 : AS 1 BUT FETCH REST OF TRK IF CONVENIENT * !* * !* 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 : Prefetched bit * !* BIT 1 : MAKE NEW IE DONT PAGE OUT & SUPPLY ZEROPAGE ON REREAD * !* BIT 0 : RECAPTURABLE(IF ON FREE LIST ON PAGING OUT) * !*********************************************************************** %ROUTINE %SPEC PUSHPIT %CONST %INTEGER ZEROPAGEAD=4096; ! SEG 0 PAGE 1 BOTH REAL & VIRTUAL %INTEGER AEX,AMTX,EPX,DDX,FLAGS,STOREX,SRCE,CALL,ID,I,B,F,KEY,DACT,XPAGES %IF MONLEVEL&12=12 %THEN %START %LONG %INTEGER TIMER1,TIMER2 %FINISH %INTEGER %NAME AMTDDDDX %RECORD (AMTF) %NAME AMT %RECORD (STOREF) %NAME ST %RECORD (PARMXF) %NAME PP %RECORD (PARMF) TDISC %SWITCH ACTIVITY(0:9) %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{&X'0000FFFF'}+EPX AMTDDDDX==AMTDD(DDX) %IF MULTIOCP=YES %THEN %START *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT: %FINISH STOREX=AMTDDDDX&STXMASK DACT=P_DACT ->ACTIVITY(DACT) !----------------------------------------------------------------------- ACTIVITY(1): ! PAGE-IN (ALLOWS PAGETURN TO BE CALLED) ACTIVITY(9): ! PAGE IN AND PREFETCH MORE %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&X'F1'=1 %AND ST_USERS=0; ! RECAPTURE %IF DDX#ST_LINK{&X'0000FFFF'} %THEN OPMESS("whops 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 %THEN %START *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSKE_2,1 %FINISH %ELSE %IF XA=AMDAHL %START *L_1,STOREX *SLL_1,12 *L_2,KEY *SSK_2,1 %FINISH %ELSE %START *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 %OR (ST_USERS=1 %AND ST_FLAGS&x'84'=x'84') %START; ! PAGE-OUT or prefetch IN PROGRESS %IF XA=YES %THEN %START *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSKE_2,1 %FINISH %ELSE %IF XA=AMDAHL %START *L_1,STOREX *SLL_1,12 *L_2,KEY *SSK_2,1 %FINISH %ELSE %START *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSK_2,1 *LA_1,2048(1); *SSK_2,1 %FINISH %FINISH %IF ST_USERS=0 %START PAGEFREES=PAGEFREES-1 %FINISH %ELSE %START SHAREDEPS=SHAREDEPS+1 %FINISH ST_FLAGS=ST_FLAGS&(\(4)); ! remove prefetched bit 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 MULTIOCP=YES %THEN STORESEMA=-1 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 KEY=P_P3 ! ! 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'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 %THEN %START; ! 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 %IF SRCE=X'40006' %THEN ST_FLAGS=x'84' %ELSE ST_FLAGS=X'80'; ! DISC->STORE TRANSIT &prefetched %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 %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH PDISC(TDISC) %IF MONLEVEL&12=12 %THEN %START PDISCCALLN=PDISCCALLN+1 *STPT_TIMER2 PDISCIT=PDISCIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %FINISH ! TDISC_P6 left set as follows ! <0 transfer already fired -_p6 pages left on trk ! >0 queued with _p6 pages left on trk ! fetch further pages and make recapturable xpages=imod(p_p6) %IF p_ssno=37 {bulk mover} %THEN xpages=amt_len-1 P_DEST=0 %AND %RETURN %UNLESS DACT=9 %AND xpages#0 %AND FREE EPAGES>100 TDISC_DEST=X'40001' TDISC_SRCE=X'40006'; ! reply to act 6 TDISC_P4=M'PREF' TDISC_P3=KEY %IF MULTIOCP=YES %THEN %START *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT1: %FINISH %FOR EPX=EPX+1,1,EPX+xpages %CYCLE %EXIT %IF EPX>=AMT_LEN AMTDDDDX==AMTDD(AMT_DDP{&X'0000FFFF'}+EPX) %EXIT %IF AMTDDDDX#STXMASK; ! already here or "new" AMT_USERS=AMT_USERS+1; ! extra user in case pons delayed by ints AMT_OUTS=AMT_OUTS+1; ! self clearing condition so check active ! will wait not fail (see activemem act 5) TDISC_P1=AMTX<<16!EPX TDISC_P2=TDISC_P1 PON(TDISC) %IF MONLEVEL&4#0 %THEN PERFORM_PREFETCHN=PERFORM_PREFETCHN+1 %REPEAT %if multiocp=YES %then Storesema=-1 P_DEST=0 %RETURN !----------------------------------------------------------------------- ACTIVITY(6): ! REPLY FROM READ ahead ST==STORE(STOREX) AMT_USERS=AMT_USERS-1; ! extra user removed AMT_OUTS=AMT_OUTS-1; ! remove extra transfer ST_FLAGS<-ST_FLAGS&X'803F'; ! no transfer P_P2=1; ! make recaptureble ! and drop through to null pageout %IF p_p3#0 %THEN p_p2=0; ! if transfer fails discard page !----------------------------------------------------------------------- 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 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 %THEN %START; ! NO TRANSFERS INITIATED %IF ST_FLAGS&2#0 %THEN AMTDDDDX<-NEWEPBIT!STXMASK %AND ST_FLAGS<-ST_FLAGS&X'8000' ->REP; ! TO RETURN EPAGE %FINISH ST_FLAGS<-ST_FLAGS&X'80F5' %IF MULTIOCP=YES %THEN STORESEMA=-1 TRANSFER NEEDED: ! TO COMPLETE PAGETURN %IF FLAGS&X'80'#0 %THEN %START; ! DISC TRANSFER TO START %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH PDISC(TDISC) %IF MONLEVEL&12=12 %THEN %START 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 1 as a result 0f 2988 experiences ! ST_FLAGS<-ST_FLAGS&X'803F'; ! NO DISC TRANSFER %IF P_P2=4 %THEN %START; ! WAS ABORTED %IF MONLEVEL&4#0 %THEN PERFORM_ABORTN=PERFORM_ABORTN+1 ST_FLAGS<-ST_FLAGS!8; ! PUT BACK WRITTEN MARKER %FINISH %IF 1<=p_p2<=3 %START; ! TRansfer has failed tdisc=0; tdisc_dest=com_sync1dest<<16+x'10014' string(addr(tdisc_p1))="BADFSYSPAGE ".strint(amt_da>>24)." ".strint(amt_da&x'FFFFFF'+epx) pon(tdisc) st_users=st_users+1 amt_users=amt_users+1; ! frig counts keep page in store %FINISH AMT_OUTS=AMT_OUTS-1 %IF ST_FLAGS&X'A0'#0 %OR ST_USERS#0 %THEN ->MUST WAIT %IF ST_FLAGS&X'A'#0 %THEN ->PAGEOUT REP: ! RETURN THE EPAGE ST_FLAGS<-ST_FLAGS&X'8005' %IF ST_FLAGS&1=0 %START; ! NOT RECAPTURABLE AMTDDDDX<-AMTDDDDX!STXMASK %FINISH %ELSE %START ST_LINK=DDX %FINISH P_DEST=X'60001' P_P2=STOREX PAGEFREES=PAGEFREES-1 %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH RETURN EPAGE(P) %IF MONLEVEL&12=12 %THEN %START 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 %THEN %START P_DEST=X'00080003' P_P2=AMTX %IF MULTIOCP=YES %THEN PON(P) %ELSE %START %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH ACTIVE MEM(P) %IF MONLEVEL&12=12 %THEN %START 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{&X'0000FFFF'} ST_LINK=I %END %END !---------------------------------------------------------------------- %INTEGER %FN 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 %THEN %RESULT=-1 STOREX=FSTASL ST==STORE(STOREX) Monitor("page List State?") %IF Storex=0 %OR St_Users=32767 FSTASL=STORE(FSTASL)_FLINK STORE(FSTASL)_BLINK=0 ST_USERS=1 %IF ST_FLAGS&1#0 %THEN %START; ! RECAPTURABLE FLAG %IF MONLEVEL&4#0 %AND ST_FLAGS&4#0 %THEN PERFORM_BADPREF=PERFORM_BADPREF+1 I=ST_LINK{&X'0000FFFF'} ! %IF AMTDD(I)#STOREX %THEN OPMESS("stop recap??") AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %FINISH RA=STOREX*PAGESIZE %IF ZEROED=0 %THEN %START; ! CLEAR TO ZERO %IF XA=YES %THEN %START *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %FINISH %ELSE %IF XA=AMDAHL %START *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %FINISH %ELSE %START *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 I=RTV(-1) %FINISH FREEEPAGES=FREEEPAGES-1 %IF FREEEPAGES=0 %THEN INHIBIT(5) %IF XA=YES %THEN %START *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 %FINISH %ELSE %START *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 %IF MULTIOCP=YES %THEN %START *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT: %FINISH %IF FREEEPAGES=0 %THEN %START; ! SHOULD ONLY OCCUR IN MULTIOCPS %IF MULTIOCP=YES %THEN STORESEMA=-1 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' %IF MULTIOCP=YES %THEN STORESEMA=-1 PON(P) %END %INTEGER %FN NEW EPAGE !*********************************************************************** !* HANDS OUT A NEW EPAGE TO EXTEND A VITAL RESIDENT TABLE * !*********************************************************************** %INTEGER I %IF MULTIOCP=YES %THEN %START { 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_7, *DROP_1 %FINISH %IF FREE EPAGES>0 %THEN %START I=QUICK EPAGE(0,X'18'); ! ZEROED KEY=1+READ PROTECTION %IF MULTI OCP=YES %THEN STORESEMA=-1 %IF I<0 %THEN ->USE SPARE STORE(I)_USERS=X'7FFF' unalloc eps=unalloc eps-1 %RESULT=I*PAGESIZE %else %if MULTIOCP=YES %then STORESEMA=-1 %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 * !*********************************************************************** %ROUTINE %SPEC STOP RECAPTURE %RECORD (STOREF) %NAME ST %INTEGER I,STOREX,STAD,ACT,RA ACT=P_DEST&1 %IF MULTIOCP=YES %AND ACT=0 %THEN %START *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) 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 %THEN %START OPMESS("PAGE ".STRINT(STOREX)." ABANDONED") STOP RECAPTURE ->RETURN %FINISH %IF SPSTOREX=0 %START STOP RECAPTURE %IF XA=YES %THEN %START *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %FINISH %ELSE %IF XA=AMDAHL %START *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %FINISH %ELSE %START *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 I=RTV(-1) SPSTOREX=STOREX unalloc eps=unalloc eps-1 %FINISH %ELSE %START %IF ST_FLAGS&1#0 %START; ! RECAPTURABLE TO BACK ST_FLINK=0 ST_BLINK=BSTASL STORE(BSTASL)_FLINK=STOREX BSTASL=STOREX %FINISH %ELSE %START; ! 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 %IF XA=YES %THEN %START *L_1,RA; *LA_2,120 {X'78'} *SSKE_2,1 %FINISH %ELSE %IF XA=AMDAHL %START *L_1,RA; *LA_2,120 {X'78'} *SSK_2,1 %FINISH %ELSE %START *L_1,RA; *LA_2,120 {X'78'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %FINISH %FINISH RETURN: %IF MULTIOCP=YES %AND ACT=0 %THEN STORESEMA=-1 %RETURN %ROUTINE STOP RECAPTURE; ! SUBROUTINE TO BREAK LINK %IF ST_FLAGS&1#0 %THEN %START; ! RECAPTURABLE I=ST_LINK{&X'0000FFFF'} ! %IF AMTDD(I)#STOREX %THEN OPMESS("stop recap??") AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %FINISH %END %END !----------------------------------------------------------------------- %ROUTINE ACTIVE MEM(%RECORD (PARMF) %NAME P) !*********************************************************************** !* CONTROLS THE ALLOCATION OF ACTIVE MEMORY * !* ACTIVITY 0 INITIALISE * !* ACTIVITY 1 GET AMT FOR SPECIFIED DISC ADDRESSS * !* ACTIVITY 2 RETURN AMT FOR DITTO * !* ACTIVITY 3 COMPLETE RETURN OF AMT AFTER TRANSFER COMPLETED * !* ACTIVITY 4 ORGANISE TIMEOUT OF ACTIVE MEM * !* ACTIVITY 5 CHECK IF DISC ADDRESS IS STILL ACTIVE * !*********************************************************************** %ROUTINE %SPEC COLLECT DD GARBAGE %ROUTINE %SPEC APPENDAMTA(%INTEGER NEWSPACE,REALAD) %ROUTINE %SPEC APPENDAMTDD(%INTEGER NEWSPACE,REALAD) %ROUTINE %SPEC DDASLALLOC(%INTEGER FROM,TO) %ROUTINE %SPEC DEALLOCAMT %ROUTINE %SPEC DEALLOCDD(%INTEGER DDX,LEN) %INTEGER HASH,DDX,GARB,AMTX,SRCE,ID,DA,LEN,MASK,REALAD,FREEMAX,I,J,K,CN %INTEGER DACT,LIM,DDP %RECORD (PROCF) %NAME PROC %RECORD (PARMF) Q %OWN %SHORT %INTEGER %ARRAY AMTHASH(0:511)=0(512) %RECORD (AMTF) %NAME AMT %IF XA=YES %THEN %START %OWN %INTEGER %ARRAY %NAME AMTAPT,AMTDDPT %FINISH %ELSE %START %OWN %SHORT %INTEGER %ARRAY %NAME AMTAPT,AMTDDPT %FINISH %OWN %INTEGER AMTASIZE,AMTASL,AMTANEXT=0 %OWN %INTEGER AMTDDSIZE,AMTDDNEXT=0 %OWN %INTEGER %ARRAY DDASL(1:MAXBLOCK)=0(MAXBLOCK) %SWITCH ACT(0:6) %IF MONLEVEL&2#0 %AND KMON&1<<8#0 %THEN PKMONREC("ACTIVEMEM:",P) SRCE=P_SRCE ID=P_P1 %IF MULTIOCP=YES %THEN %START *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT: %FINISH DACT=P_DEST&X'F' ->ACT(DACT) ACT(0): ! INITIALISE %IF MULTIOCP=YES %THEN STORESEMA=-1 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'10'!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=DDP+LEN,1,DDP+AMT_LEN-1 ! RETURN IF STILL IN USE %IF AMTDD(I)&STXMASK#STXMASK %THEN AMTX=0 %AND ->RETURN %REPEAT DEALLOCDD(DDP+LEN,AMT_LEN-LEN) AMT_LEN=LEN %FINISH %IF AMT_USERS=0 %AND AMT_OUTS>0 %START %IF mask>>31#0 %THEN amtx=-4 %AND ->return ! Cant make new copy till old outs completed ! Local controller will try again later %CYCLE I=DDP,1,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 %THEN %START; ! NO AMT CELLS FREE ! TRY TO APPEND EPAGE TO AMTA AMTX=-1 %IF AMTANEXT>=MAXAMTAK//4 %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 %THEN %START DDX=DDASL(LEN) DDASL(LEN)=AMTDD(DDX){&X'0000FFFF'} ->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){&X'0000FFFF'} 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 %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 %INTEGER %ARRAY CLEARS(0:MAXBLOCK) AMTX=P_P2 AMT==AMTA(AMTX) DDP=AMT_DDP{&X'0000FFFF'} ! %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=DDP,1,DDP+AMT_LEN-1; ! CHECK "NEW" EPAGE BIT ! "NEW" SECTIONS NEVER SHARED %IF AMTDD(I)&NEWEPBIT#0 %THEN %START CLEARS(CN)=AMTX<<16!(I-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) PON(Q); ! PON to limit call depth & so %REPEAT; ! avoid possible LC stack o'flow %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=0 %AND AMT_OUTS=0 %AND AMT_DA#X'FF000000' %START %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN; ! AWAIT TRANSFERS %FINISH DEALLOCDD(AMT_DDP{&X'0000FFFF'},AMT_LEN) DEALLOCAMT %IF MULTIOCP=YES %THEN STORESEMA=-1 %RETURN ACT(4): ! ENTERED EVERY 10 SECS %IF MULTIOCP=YES %THEN STORESEMA=-1 ! 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#"" %THEN %START %IF PROC_STATUS&AMTLOST=0 %AND K1 %THEN HALT OTHER OCP %CYCLE I=1,1,MAXBLOCK %WHILE DDASL(I)#0 %CYCLE J=DDASL(I) DDASL(I)=AMTDD(J){&X'0000FFFF'} AMTDD(J)=0 %REPEAT %REPEAT I=AMTDDSIZE+1 ALLOC: %WHILE I>1 %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 %IF MULTIOCP=YES %AND COM_NOCPS>1 %THEN RESTART OTHER OCP %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. * !* SETTING UP THE FIRST PAGE MUST BE DONE WITHOUT USING THE * !* MAPPED PAGETABLE ARRAY UNTIL THE ZERO ENTRY IS IN PLACE * !*********************************************************************** %INTEGER FIRSTNEW,I,J,PTE,LIM %IF XA=YES %THEN PTE=REALAD %ELSE PTE=REALAD>>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 *PTLB_0(0) %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 %FINISH %ELSE 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 I=RTV(-1) %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 *PTLB_0(0) %IF XA=NO %THEN LIM=(MAXAMTDDK-4)//4 %ELSE LIM=((MAXAMTDDK-4)//64)*16+15 %FOR J=1,1,LIM %CYCLE AMTDDPT(J)=-1 %REPEAT %FINISH %ELSE AMTDDPT(AMTDDNEXT)<-PTE AMTDDNEXT=AMTDDNEXT+1 FIRSTNEW=AMTDDSIZE+1 AMTDDSIZE=AMTDDSIZE+NEWSPACE//DDFLEN FREEMAX=0 DDASLALLOC(FIRSTNEW,AMTDDSIZE) I=RTV(-1) %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 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 %SHORT %INTEGER %NAME 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 and must be held before calling * !*********************************************************************** %INTEGER I,J,f,b %RECORD (storef) %NAME st %CYCLE I=DDX,1,DDX+LEN-1 J=AMTDD(I)&STXMASK AMTDD(I)=0 %IF J#STXMASK %THEN %START st==store(j) f=st_flink; b=st_blink store(f)_blink=b store(b)_flink=f st_FLAGS=0 st_blink=0; st_flink=fstasl store(fstasl)_blink=j fstasl=j %FINISH %REPEAT AMTDD(DDX)<-DDASL(LEN) DDASL(LEN)=DDX %END %END !----------------------------------------------------------------------- %ROUTINE CONFIG CONTROL(%record(parmf) %name P) !*********************************************************************** !* Configures major units off or on * !* P_DACT&1=0 for off, =1 for on * !* P_DACT>>1 is unit type (0 for CPU) * !* P_P1 = unit ID (ie port number for CPU) * !* * !* Currently only CPUs can be put On (EMAS only has dyadic ) * !*********************************************************************** %integer I,ID,Myport,Hisport,prefix ad,prefix VA,place %string(9)onoff %if MULTI OCP=YES %then %Start %if MONLEVEL&2#0 %and KMON&1<<17#0 %then PKMONREC("CONFIG:",P) Hisport=P_P1 Myport=getmyport %for place =1,1,4 %cycle %if Hisport=Com_ocp port(place) %then ->ok %repeat Opmess("OCP not found") %return OK: %if HIsport=myport %then OPmess("OCP already on") %and %return Prefix ad=com_ocp prefix(place) prefix va=RTV(prefix ad) %for i=0,4,4092 %cycle integer( prefix va+i)=integer(i); ! Copy page 0 %repeat integer(prefix va+700)=stackbase+(place-1)*4*4096 i=RTV(-1) i=IPL OCP(place) OPmess ("ocp".strint(hisport)." IPLd RC=".htos(i,3)) %if p_dact>>1=0 %start; ! update oper info %if p_dact&1#0 %start; ! only configure IPs on currently onoff="s" %for i=1,1,com_nocps %cycle onoff=onoff." ".strint(com_ocpport(i)) %repeat p_dest=x'320006'; ! display text with pon p_p1=x'040F0000'; ! lest race with oper init string(addr(p_p1)+3)=onoff pon(p) { == display text(0,4,15,onoff) } %finish %finish %finish %END %IF MONLEVEL&X'3C'#0 %THEN %START %EXTERNAL %LONG %INTEGER %SPEC SEMATIME %ROUTINE TIMEOUT !*********************************************************************** !* Print out the session timing measurements * !*********************************************************************** %CONST %STRING (15) %ARRAY SERVROUT(0:LOCSN0+3)="Idle time", "Nowork time","","Schedule", "Pageturn","Get epage","Return epage","File semaphore","Active mem", "","Elapsedint","Update time","Dponputonq","", "Activemem(Poll)","Schedule(Oper)","","", "Tag testing",""(13), "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 %LONG %REAL PERIOD,TOTAL,IDLETIME,PROCTIME,SERVTIME,RSEMATIME,RCOUNT %STRING (15) S %STRING (31) %FN %SPEC STRPRINT(%LONG %REAL 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 "."% of % of (Secs) (Msecs) Total "."Non-idle Supvsr ") TOTAL=0 %CYCLE I=0,1,LOCSN0+3 S=SERVROUT(I) RCOUNT=PERFORM_SERVN(I) %IF S#"" %AND RCOUNT>0 %THEN %START PRINT STRING(" ".S.STRSP(16-LENGTH(S)).STRPRINT(RCOUNT,9,0)) SERVTIME=COM_ITINT*PERFORM_SERVIT(I) PRINT STRING(STRPRINT(SERVTIME/1000000,6,3).STRPRINT((SERVTIME/1000)/RCOUNT,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(" Pageins= ".STRPRINT(PERFORM_PTURNN,10,0)." Recaptures= ".STRPRINT(PERFORM_RECAPN,10,0)." Shared pages= ".STRPRINT(PERFORM_PSHAREN,10,0)." New pages= ".STRPRINT(PERFORM_NEWPAGEN,10,0)." Prefetches= ".STRPRINT(PERFORM_PREFETCHN,10,0)." Unusd prftchs=".STRPRINT(PERFORM_BADPREF,10,0)) printstring(" Writeouts= ".STRPRINT(PERFORM_PAGEOUTN,10,0)." Pages zeroed= ".STRPRINT(PERFORM_PAGEZN,10,0)." Pages snoozed=".STRPRINT(PERFORM_SNOOZN,10,0)." Pages aborted=".STRPRINT(PERFORM_ABORTN,10,0)) PRINTSTRING(" Snoozes complete =".STRPRINT(PERFORM_SNOOZOK,10,0)." Snoozes timedout =".STRPRINT(PERFORM_SNOOZTO,10,0)." Snoozes abandoned =".STRPRINT(PERFORM_SNOOZAB,10,0)." Forced deactivates =".STRPRINT(PERFORM_FDEACT,10,0)." Pg Tables exhausted=".STRPRINT(perform_NOPTABS,10,0)." ") %FINISH %IF MONLEVEL&32#0 %THEN %START 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 %THEN %START 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(%LONG %REAL 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 * !*********************************************************************** %LONG %REAL 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 %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 * !*********************************************************************** %INTEGER I,J %IF MONLEVEL&4#0 %THEN %START %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 PERFORM_PREFETCHN=0 PERFORM_BADPREF=0 perform_fdeact=0 perform_NOPTABS=0 SEMATIME=0 PERFORM_CLOCK=CLOCK %FINISH %IF MONLEVEL&32#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 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 ! !----------------------------------------------------------------------- ! %ROUTINE LOCAL CONTROL !*********************************************************************** !* The Local Controller * !* THe local variables are unique for each Local Controller but * !* Owns and Global variables are common to all Local Controllers * !* Use mind before altering the codeing * !*********************************************************************** ! CLAIMED BLOCK TABLES %RECORD (CBTF) %NAME CBT ! CONSOLE IO & ACCOUNTS RECORDS ! ACTIVE SEGMENT TABLES %CONST %INTEGER MAXAS=CBTLEN//10-1; ! 48 entries %INTEGER %ARRAY AS(0:7,0:MAXAS); ! It seems that CBT maust be at least 10 times as entries ! otherwise the dynamic CBT allocation can foul up due to ! fragmentation losses %SHORT %INTEGER %ARRAY ASEG(0:MAXAS) %INTEGER %ARRAY ASPTVAD(0:MAXAS) %LONG %INTEGER %ARRAY OLDASWIPS(0:MAXRESIDENCES) %CONST %INTEGER TOPBIT=X'80000000' %CONST %LONG %INTEGER Longm1=-1 %CONST %LONG %INTEGER Ltopbit=X'8000000000000000' %CONST %LONG %INTEGER Initasfree=longm1>>(63-Maxas)<<(63-Maxas) !----------------------------------------------------------------------- ! LOCAL SEGMENT INFORMATION %BYTE %INTEGER %ARRAY TST(0:LSTLEN-1); ! TERTIARY SEGMENT TABLE POINT TO AS %CONST %INTEGER SMALL SEQUENTIAL=8; !USED TO DECIDE TO RECAP OR NOT %INTEGER %FN %SPEC DXR(%LONG %LONG %REAL %NAME T, %LONG %LONG %REAL B) %ROUTINE %SPEC BASM(%INTEGER EISTN) %INTEGER %FN %SPEC CHECK RES(%INTEGER WRITE,LEN,AD) %INTEGER %FN %SPEC CHECKDA(%INTEGER DA) %ROUTINE %SPEC PAGEOUT(%INTEGER VSSEG,VSEPAGE, %RECORD (CBTF) %NAME CBT) %ROUTINE %SPEC ASOUT(%INTEGER ASP) %ROUTINE %SPEC CHACCESS(%INTEGER ASP) %ROUTINE %SPEC STROBE(%INTEGER SFLAGS) %ROUTINE %SPEC WORKSET(%INTEGER RECAP) %ROUTINE %SPEC CLEAR ACCESSED BITS %ROUTINE %SPEC DEACTIVATE(%LONG %INTEGER MASK) %ROUTINE %SPEC FREE AS %ROUTINE %SPEC RETURN PTS %INTEGER %FN %SPEC FIND PROCESS %ROUTINE %SPEC WAIT(%INTEGER DACT,N) !----------------------------------------------------------------------- %INTEGER %NAME SEMAHELD; ! DIRECTOR HOLDING SEMA WORD %INTEGER MARK1,CBTP,EPLIM,EPN,UEPN,RTLIM,RTN,PROCESS,ME,LSN3,PTAD,VSPARM,PEPARM,VSSEG,VSEPAGE,EPX,I,J,K,NEWCONTEXT, STOREX,DEST,SRCE,SUSP,SNOOZES,DA,LASTDA,SEQVSIS,NONSEQVSIS,LCERRS,XSTROBE,SEGLEN,PTEPS,ASDESTROY,PTP,ASP,OUTN,PTE, HIGHSEG,LOCKST,LOCKSTX,LTAD,TSTPTR,NEXTPTP,PTPVAD,PTVAD,CABI,MARK2 %LONG %INTEGER PSW,ASB,ASFREE,ASWAP,ASWIP,ASSHR {%bitarray (0:MAXAS)} %RECORD (PARMF) P; ! FOR POFFING PARAMETERS %RECORD (PROCF) %NAME PROC %RECORD (PARMF) %NAME ALLOUTP; ! MAPPED ONTO DIROUTP OR ! SIGOUTP AS STACKS SWOP %RECORD (SERVF) %NAME SERV0,SERV,SERV3 %RECORD (PARMF) POUT %RECORD (CONTEXTF) %NAME CONTEXT %RECORD (STOREF) %NAME ST %IF XA=YES %THEN %START %CONST %INTEGER INVALID SEG=X'20' %INTEGER %ARRAY %NAME PT %ELSE %SHORT %INTEGER %ARRAY %NAME PT %CONST %INTEGER INVALID SEG=1 %FINISH %IF MONLEVEL&4#0 %THEN %START %INTEGER MONVAD,MONPTAD,MONLIM %LONG %INTEGER TIMER1,TIMER2 %ROUTINE %SPEC GARNER(%INTEGER EVENT,PARAM) %LONG %INTEGER %NAME LPIT %FINISH %STRING (15) INTMESS %SWITCH ACTIVITY(0:16),ASYN0(1:3),AMTXSW(-4:0) %CONST %INTEGER LOCKSTVAD=LCSTKSEG<120 SECS ! TO ALLOW TIME TO AUTOLOAD DFC ! !----------------------------------------------------------------------- ! PROCESS CREATE ENTRY ONLY PROCESS=LCTABLES_PROCNO PROC==PROCA(PROCESS) ME=(PROCESS+LOCSN0)<<16 LSN3=PROCESS+LOCSN3 SERV0==SERVA(PROCESS+LOCSN0) SERV3==SERVA(LSN3) SUPPOFF(SERV0,P); ! OBTAIN STARTUP RECORD ALLOUTP==DIROUTP %IF MONLEVEL&4#0 %START MONVAD=0 %IF PROC_STATUS&4=0 %THEN LPIT==PERFORM_SERVIT(LOCSN0+2) %ELSE LPIT==PERFORM_SERVIT(LOCSN0+3) %FINISH !----------------------------------------------------------------------- ! INITIALISE CLAIMED BLOCK TABLES %CYCLE I=0,1,LSTLEN-1 SST(I)<-X'FFFF'; ! ALL SEGMENTS UNCONNECTED TST(I)=X'7F'; ! ALL SEGMENTS INACTIVE %REPEAT ASFREE=initasfree; ! ALL FREE ASWAP=0 ASSHR=0 ASWIP=0 PEPARM=-1 SUSP=0 ASDESTROY=0 MARK1=M'MRK1'; MARK2=M'MRK2' LCTABLES_SPARE1=M'CNTX' LCTABLES_CONTEXTS(LCONTN-1)_last vsparm=M'OUTP' LCTABLES_IOSTAT_SPARE=M'CBT-' HIGHSEG=M'HIGH' !----------------------------------------------------------------------- ! CONNECT DIRECTOR FILES ! CODE AS SEG66 USING TOP 2 CBTS ! GLA AS SEG67 USING CBT0 ! STACK AS SEG68 USING CBT1 %IF XA=NO %THEN %START J=DCODESEGS SST(DCODESEG+I)=CBTLEN-J+I %FOR I=0,1,J-1 %FINISH %ELSE J=DCODESEGS>>1 %AND SST(DCODESEG)=CBTLEN-J CBTA(CBTLEN-J)_DA=P_P2 CBTA(CBTLEN-J)_LNGTH=MAXBLOCK-1 CBTA(CBTLEN-J)_TAGS=SMULTIPLE CON!READONLY; ! SYSTEM SHARING OF DIRECTOR %FOR I=1,1,J-1 %CYCLE CBTA(CBTLEN-J+I)_DA=P_P2+MAXBLOCK*I CBTA(CBTLEN-J+I)_LNGTH=MAXBLOCK-1 CBTA(CBTLEN-J+I)_TAGS=CONTINUATN BLK!SMULTIPLE CON!READONLY %REPEAT SST(DGLASEG)=0; SST(DSTKSEG)=1 CBTA(0)_DA=P_P3 CBTA(0)_LNGTH=DGLAEPAGES-1 CBTA(0)_TAGS=NEW BLK; ! GLA IS 'NEWCOPY' CBTA(1)_DA=P_P4 CBTA(1)_LNGTH=MAXBLOCK-1 CBTA(1)_TAGS=NEW BLK; ! STACK IS 'NEWCOPY' %IF XA=YES %THEN %START LST(DCODESEG)=7!INVALID SEG; ! 512K INVALID LST(DGLASEG)=INVALID SEG; ! 64K AND INVALID LST(DSTKSEG)=INVALID SEG!1; ! 128K & INVALID %FINISH %ELSE %IF XA=AMDAHL %START LST(DCODESEG)=7<<28!INVALID SEG LST(DGLASEG)=0<<28!INVALID SEG LST(DSTKSEG)=1<<28!INVALID SEG %FINISH %ELSE %START LST(DCODESEG+I)=15<<28!INVALID SEG %FOR I=0,1,J-1 LST(DGLASEG)=(DGLAEPAGES-1)<<28!INVALID SEG LST(DSTKSEG)=15<<28!INVALID SEG %FINISH !----------------------------------------------------------------------- %IF PROCESS=1 %AND COM_USERS=1 %THEN %START; ! SET UP PAGE0 ENTRIES ONCE ONLY ! BUT WRITE TO BOTH PAGE0 PAGES ! FOR MULTI-PROCESSOR INSTALLATIONS ! SET PROG ERROR PSW ENTRY PSW=PSW0; ! UPPER BITS OF PRIV PSW *BASR_2,0; *USING_2 *LA_1, *O_1,PSW+4 *ST_1,PSW+4 *DROP_2 LONGINTEGER(X'208')=PAGE0_PENEWPSW; ! COPY AWAY G-C PE PSW PAGE0_PENEWPSW=PSW %IF MULTIOCP=YES %THEN %START; %FINISH ! SET INTERVAL TIMER IST ENTRY PSW=PSW0 *BASR_2,0; *USING_2 *LA_1, *O_1,PSW+4 *ST_1,PSW+4 *DROP_2 LONGINTEGER(X'210')=PSW; ! EXTERNALS ARE GLOBAL ! G-C USES THIS PSW TO REROUTE %IF MULTIOCP=YES %THEN %START; %FINISH ! SET UP SVC PSW ENTRY PSW=PSW0 *BASR_2,0; *USING_2 *LA_1, *O_1,PSW+4 *ST_1,PSW+4 *DROP_2 PAGE0_SVCNEWPSW=PSW ! ! If more than 1 ocp bring in all the others ! %if Multi OCP=YES %and COM_Nocps>1 %Start P_DEST=x'110001'; ! Config Control mode=ON %for I=2,1,COM_Nocps %cycle P_P1=COM_OCP POrt(i) PON(P) %repeat %finish %FINISH !----------------------------------------------------------------------- ! SET UP DIRECTOR CONTEXT CONTEXT==LCTABLES_CONTEXTS(1) PSW=UPSW0!!LONGONE<<48; ! USER KEY AND FLAGS FOR PSW ! PRIV PSW=PSW!(DCODESEG< *ST_1,K *DROP_2 PSW=PSW0!K LONGINTEGER(I)=PSW LCTABLES_CURCONTEXT=0 %IF MONLEVEL&4#0 %THEN %START *STPT_PSW LCIT=LCIT+(CMAXCPUTIMER-PSW)>>12 %FINISH *LPSW_544(0) !----------------------------------------------------------------------- ENTERI: ! NORMAL CALLS REACTIVATE TO HERE SUPPOFF(SERV0,P); ! OBTAIN PARAMETER RECORD %IF MONLEVEL&2#0 %AND KMON&1#0 %THEN PKMONREC("LOCALC:",P) %IF serv0_P<<2#0 %THEN monitor("multiple l-c params?") ->ACTIVITY(P_DEST&X'FFFF') !----------------------------------------------------------------------- ITIMERI: ! INTERVAL TIMER INTERRUPTS ENTER HERE ! ! STORE CONTEXT AND RESET TO LOCAL CONTROLLER AS M-C INDEPENDENTLY AS POSS ! HOWEVER THE ASSEMBLER ASSUMES LCSTKSEG,LSTLEN & THE LAYOUT OF CONTEXTF ! *STM_0,15,2304(0); ! X900 THE L-C DUMP AREA *LA_1,64; ! THE LC STACK SEG NO %IF SSHIFT=16 %START *SLL_1,16 %ELSE *SLL_1,20 %FINISH *LM_4,14,2152(1); ! 4*LSTLEN+80+8 FOR PSW +16(GRS0-3) CONTEXT==LCTABLES_CONTEXTS(LCTABLES_CURCONTEXT) *L_1,CONTEXT; ! POINTER *MVC_8(64,1),2304(0); ! COPY IN GRS *STD_0,72(1); *STD_2,80(1) *STD_4,88(1); *STD_6,96(1) *STCTL_0,1,104(1); *stctl_14,14,160(1);! CONTROL REGS *STPT_168(1); ! CPU TIMER CONTEXT_PSW=PAGE0_EXT OLD PSW; ! PROOF AGAINST XA CHANGES I=ADDR(LCTABLES_CONTEXTS(0)) *l_1,i; *lctl_0,1,104(1); *lctl_14,14,160(1) %IF MONLEVEL&4#0 %START *L_1,I; *SPT_168(1); ! TO TIME LOCAL CONTROLLER %FINISH ! ! 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 CONTEXT_CPUTIMER=TIMESLICE<<9; ! EIGHTH OF TIME SLICE %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE>>3 ACNT_LTIME=ACNT_LTIME+(TIMESLICE>>13) ACNT_LLIMIT=ACNT_LLIMIT-(TIMESLICE>>13) ->ACT %FINISH %IF ACNT_LLIMIT<0 %THEN %START ACNT_LLIMIT=X'1000' {4 SECS} context_pecode=128 context_ilc=0 PEPARM=17 ->PE %FINISH RTN=RTN+1 %IF RTN=1 %THEN %START PROC_RUNQ=CATTAB(PROC_CATEGORY)_RQTS2 %IF MONLEVEL&1#0 %THEN 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 %AND MONVAD>0 %THEN GARNER(7,2<<24!PROC_CATEGORY<<16!EPN) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH SCHEDULE(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 PERFORM_SERVIT(3)=PERFORM_SERVIT(3)+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PERFORM_SERVN(3)=PERFORM_SERVN(3)+1 %FINISH %IF POUT_P1=0 %OR SEQVSIS+NONSEQVSIS>256 %THEN %START WORKSET(0) POUT_DEST=X'30004'; ! OUT OF TIME or rushing up asequential file ! rescheduling will be delayed if system busy ! or pageouts are large 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(0) %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(0) %FINISH %FINISH CONTEXT_CPUTIMER=TIMESLICE<<12 %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE ACNT_LTIME=ACNT_LTIME+TIMESLICE>>10; ! ACNT IN MILLESECS ACNT_LLIMIT=ACNT_LLIMIT-(TIMESLICE>>10) %IF KERNELQ#0 %OR (XA#YES %and com_schannelq#0) %OR RUNQ1#0 %OR (PREEMPTED!RUNQ2#0 %AND PROC_RUNQ=2) %START POUT_DEST=ME!2 ->ONBRUNQA %FINISH ->ACTIVATE; ! START NEXT TSLICE AT ONCE !----------------------------------------------------------------------- !----------------------------------------------------------------------- SVCI: ! SVC ENTER HERE ! ! STORE CONTEXT AND RESET TO LOCAL CONTROLLER AS M-C INDEPENDENTLY AS POSS ! HOWEVER THE ASSEMBLER ASSUMES LCSTKSEG,LSTLEN & THE LAYOUT OF CONTEXTF ! *STM_0,15,2304(0); ! X900 THE L-C DUMP AREA *LA_1,64; ! THE LC STACK SEG NO %IF SSHIFT=16 %START *SLL_1,16 %ELSE *SLL_1,20 %FINISH *LM_4,14,2152(1); ! 4*LSTLEN+80+8 FOR PSW +16(GRS0-3) CONTEXT==LCTABLES_CONTEXTS(LCTABLES_CURCONTEXT) *L_1,CONTEXT; ! POINTER *MVC_8(64,1),2304(0); ! COPY IN GRS *STD_0,72(1); *STD_2,80(1) *STD_4,88(1); *STD_6,96(1) *STCTL_0,1,104(1); *stctl_14,14,160(1);! CONTROL REGS *STPT_168(1); ! CPU TIMER CONTEXT_PSW=PAGE0_SVC OLD PSW; ! PROOF AGAINST XA CHANGES CONTEXT_ILC=PAGE0_SVC ILC>>1&3 CONTEXT_PECODE=x'ffff8000'!PAGE0_SVC CODE I=ADDR(LCTABLES_CONTEXTS(0)) *l_1,i; *lctl_0,1,104(1); *lctl_14,14,160(1) %IF MONLEVEL&4#0 %START *L_1,I; *SPT_168(1); ! TO TIME LOCAL CONTROLLER %FINISH ->ILLEGAL OUT; ! SVCS NOT USED PROGERRI: ! PROGRAM ERROR INTERRUPTS ENTER HERE ! ! STORE CONTEXT AND RESET TO LOCAL CONTROLLER AS M-C INDEPENDENTLY AS POSS ! HOWEVER THE ASSEMBLER ASSUMES LCSTKSEG,LSTLEN & THE LAYOUT OF CONTEXTF ! *STM_0,15,2304(0); ! X900 THE L-C DUMP AREA ! CHECK FOR ERROR IN SUPERVISOR ! BY TESTING KEY IN OLD PSW ! MUST DO THIS WITHOUT REFERENCING ! LOCAL CONTROLLER CONTEXT WHICH MAY NOT EXIST *BASR_1,0; *USING_1 ! *TM_143(0),X'40'; ! MONITOR CALL ON PER ! *BC_1,; ! CANNOT COME FROM SUPV ! BUT CAN COME FROM KEY0 DIRECTOR *TM_41(0),X'F0'; ! key 0? *BC_7, *TM_40(0),3; ! interruptible? *BC_1, *BC_15, NOTKZ: *TM_41(0),X'E0' *BC_7, ISPVSR: *L_1,2308(0) *LPSW_520(0); ! PSW FOR ERRORS IN SUPERVISOR *DROP_1 INUSER: *LA_1,64; ! THE LC STACK SEG NO %IF SSHIFT=16 %START *SLL_1,16 %ELSE *SLL_1,20 %FINISH *LM_4,14,2152(1); ! 4*LSTLEN+80+8 FOR PSW +16(GRS0-3) CONTEXT==LCTABLES_CONTEXTS(LCTABLES_CURCONTEXT) *L_1,CONTEXT; ! POINTER *MVC_8(64,1),2304(0); ! COPY IN GRS *STD_0,72(1); *STD_2,80(1) *STD_4,88(1); *STD_6,96(1) *STCTL_0,1,104(1); *stctl_14,14,160(1);! CONTROL REGS *STPT_168(1); ! CPU TIMER CONTEXT_PSW=PAGE0_PE OLD PSW; ! PROOF AGAINST XA CHANGES I=ADDR(LCTABLES_CONTEXTS(0)) *l_1,i; *lctl_0,1,104(1); *lctl_14,14,160(1) %IF MONLEVEL&4#0 %START *L_1,I; *SPT_168(1); ! TO TIME LOCAL CONTROLLER %FINISH PEPARM=PAGE0_PE CODE&127 CONTEXT_PECODE=PEPARM CONTEXT_ILC=PAGE0_PE ILC>>1&3 %IF 16<=PEPARM<=17 %THEN ->VSERRI %IF PEPARM>=X'40' %THEN ->OUTI; ! MONITOR CALL %IF XA#YES %and PEPARM=1 %START; ! CHECK AND EMULATE non-XA Intsrns DXR,BASSM &BSM I=PAGE0_PE ILC>>1&3 J=CONTEXT_PSW1-PAGE0_PE ILC&6 K=SHORTINTEGER(J)<<16>>16 %IF I=1 %AND 11<=K>>8<=12 %THEN BASM(K) %AND ->ACT %IF I=2 %AND K=X'B222' {IPM} %START J=BYTEINTEGER(J+3)>>4; ! The reg CONTEXT_GR(J)=CONTEXT_GR(J)&X'C0FFFFFF'!(CONTEXT_PSW0>>8&X'3F')<<24 ->ACT %FINISH %IF I=2 %AND K=X'B22D' {DXR} %START J=SHORTINTEGER(J+2)&255 K=ADDR(CONTEXT_FR(0)) %IF J=X'04' %THEN I=DXR(LONGLONGREAL(K),LONGLONGREAL(K+16)) %ELSE %IF J=X'40' %THEN %C I=DXR(LONGLONGREAL(K+16),LONGLONGREAL(K)) %ELSE I=6 ! specification error %IF I=0 %THEN ->ACT; ! DXR HAS BEEN EMULATED PEPARM=I %FINISH %FINISH PEPARM=PEPARM<<8!PETLATE(PEPARM) I=LCTABLES_CURCONTEXT LCTABLES_CURCONTEXT=0 %IF I=0 %START; ! I IS OLD STACK NO OPMESS("Local cntrlr fails".STRHEX(PEPARM)) DUMPTABLE(1,LCSTKSEG<3 %THEN ->RETURN %FINISH ! HARDWARE DETECTED ERRORS ARE ! 2900 MEANING (IBM MEANING IF DIFFERENT) ! 0 = FLOATING OVERFLOW ! 1 = FLOATING UNDERFLOW ! 2 = FIXED OVERFLOW ! 3 = DECIMAL OVERFLOW ! 4 = DIVIDE ERROR (ALL VARIIANTS) ! 5 = BOUND CHECK (NOT USED) ! 6 = SIZE ERROR (NOT USED) ! 7 = B OVERFLOW (NOT USED) ! 8 = STACK ERROR (ADDRESSING #VSI) ! 9 = PRIVILEGE (INCLUDES PROTECTION) ! 10 = DESCRIPTOR (SPECIFICATION) ! 11 = STRING (SEGTABLE FORMAT) ! 12 = INSTRUCTION (OPERATION) ! 13 = ACCUMULATOR (DATA) ! 14 = EMULATION (MULTIPLE ASN VARIOUS) ! 15 = NOT USED ( NOT USED) 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 ! 22 = LOCAL CONTROLLER FAILS SIGOUTP_P1=PEPARM SIGOUTP_P2=PROC_STACK SIGOUTP_TYPE=2 SIGOUTP_SSN=PROC_STACK SIGOUTP_SSNAD=ADDR(LC TABLES_CONTEXTS(PROC_STACK)) SIGOUTP_SUSP=0 Susp=0 NEWCONTEXT=2; ! SIGNAL CONTEXT %IF PROC_STACK=NEWCONTEXT %THEN %START PRINT STRING("PROGRAM ERROR ON SIGNAL STACK CLASS=".STRINT(PEPARM&255)." PE CODE=".STRINT(PEPARM>>8&255)." ") ->TERMINATE %FINISH ->SIGACT 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 CONTEXT SEGTABLE ADDRESSES K=PROC_LSTAD; ! SEG TABLE REAL ADDRESS %CYCLE I=1,1,LCONTN-1 J=LCTABLES_CONTEXTS(I)_CONTROLR(1) J=J&(\cr1mask)!K&cr1mask; ! OK ON XA &NORMAL LCTABLES_CONTEXTS(I)_CONTROLR(1)=J %REPEAT SEMAHELD=0 PROC_STATUS=PROC_STATUS&(\(HADTONFLY!HADPONFLY!X'11')) ! RESET FOR NEW RESIDENCE XSTROBE=0 SEQVSIS=0; ! count sequential pageouts(can be huge) %IF SNOOZING=YES %THEN SNOOZES=0 %AND NONSEQVSIS=-1000 PTEPS=0 PTP=0 NEXTPTP=LSTACKLEN+1; ! UPPER PAGES OF LCSTACK FOR PAGETABLES LASTDA=0 EPN=0; UEPN=0 PROC_EPN=0 RETIME: ! START NEW TIMESLICE CONTEXT==LCTABLES_CONTEXTS(PROC_STACK); ! CORRECT USER CONTEXT psw=context_cputimer %IF proc_stack=2 %THEN psw=psw-one second %IF psw>0 %START %IF MONLEVEL&4#0 %THEN LPIT=LPIT-psw>>12 ACNT_LTIME=ACNT_LTIME-(psw>>12)>>10 ACNT_LLIMIT=ACNT_LLIMIT+(psw>>12)>>10 %FINISH CONTEXT_CPUTIMER=TIMESLICE<<12; ! TIMESLICE IN MICROSECS %IF proc_Stack=2 %THEN context_cputimer=one second+timeslice<<12 %IF MONLEVEL&4#0 %THEN LPIT=LPIT+TIMESLICE ACNT_LTIME=ACNT_LTIME+TIMESLICE>>10; ! ACOUNTING DONE IN MILLESECS ACNT_LLIMIT=ACNT_LLIMIT-(TIMESLICE>>10) RTN=0 ! SEMAPHORE FOR TESTING SERV? ->ASYNCH %UNLESS SERV3_P<<2=0 %OR PROC_STACK=2 %IF SUSP#0 %THEN ->DIRPONREPLY ACT: ! ACTIVATE INTO USER PROCESS %IF KERNELQ#0 %THEN ->ONFRUNQ; ! DO ANY KERNEL SERVICES CONTEXT==LCTABLES_CONTEXTS(PROC_STACK) %IF XA=YES %THEN %START %IF CONTEXT_PSW0&X'08000000'#0 %THEN %START OPMESS(PROC_USER." has wrong 31 bit mode set") DUMPTABLE(99,ADDR(CONTEXT),192) CONTEXT_PSW0=CONTEXT_PSW0&X'F7FFFFFF' CONTEXT_PSW1=CONTEXT_PSW1!X'80000000' %FINISH !KY REMOVED THIS CLAUSE 15/6/88 ! %IF CONTEXT_CONTROLR(1)&X'FF000000'#0 %THEN %START ! OPMESS(PROC_USER." has invalid CR(1)") ! DUMPTABLE(99,ADDR(CONTEXT),192) ! CONTEXT_CONTROLR(1)=(CONTEXT_CONTROLR(1)&cr1mask)!(CONTEXT_CONTROLR(1)>>24) ! %FINISH %FINISH ! %IF CONTEXT_PSW0&x'f00000'=0 %AND CONTEXT_PSW1<<1>>(SSHIFT+1)>DCODESEG %THENSTART ! OPMESS(PROC_USER." HAS GOT KEY0 SET!") ! DUMP TABLE(99,ADDR(CONTEXT),96) ! %FINISH ! ! COUNT ACTIVATIONS TO PROCESS ! %IF MONLEVEL&4#0 %THEN %START %IF PROC_STATUS&4=0 %THEN FLPN=FLPN+1 %ELSE BLPN=BLPN+1 *STPT_PSW LCIT=LCIT+(CMAXCPUTIMER-PSW)>>12 %FINISH LCTABLES_CURCONTEXT=PROC_STACK CONTEXT_SUSP=0; ! not suspended (obviously) *L_1,CONTEXT; ! ADDR SAVE ARE TO GR1 *LD_0,72(1); *LD_2,80(1); ! LOAD UP FLOATING REGS *LD_4,88(1) *LD_6,96(1) *LCTL_0,1,104(1); *lctl_14,14,160(1) *SPT_168(1) *MVC_2048(8,0),0(1); ! USER PSW TO PAGE 0 *LM_0,15,8(1) *LPSW_2048(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=2 %THEN ->ACT %IF SST(DSIGSTKSEG)<0 %THEN ->ACT; ! SIGNAL STACK NOT CREATED(STARTUP) ! OR HAS BEEN DESTROYED(CLOSEDOWN) !----------------------------------------------------------------------- ASYNCH: ! ASYNCHRONOUS MESSAGE POFFABLE SUPPOFF(SERV3,P) %IF MONLEVEL&2#0 %AND KMON&1#0 %THEN PKMONREC("LOCALC(asynch):",P) I=P_DEST&X'FFFF' %IF I=0 %THEN ->ASYN0(P_P1) %IF I=X'FFFF' %THEN OPMESS("PROCESS ".STRINT(PROCESS)." TERMINATED") %AND NEWCONTEXT=PROC_STACK %AND ->TERMINATE %IF I=X'FFFE' %THEN %START MONITOR("L-C DACT FFFE") *LPSW_512(0); ! CRASH WITH SPECIAL PSW %FINISH %UNLESS I=1 %THEN ->SIGINT INTMESS<-P_INTMESS %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=PROC_STACK SIGOUTP_SSNAD=ADDR(LC TABLES_CONTEXTS(PROC_STACK)) SIGOUTP_SUSP=SUSP; ! PRESERVE SUSPEND STATUS SUSP=0 NEWCONTEXT=2; ! SIGNAL CONTEXT SIGACT: ! SWOP IT & IC ALLOUTP==SIGOUTP LCTABLES_CONTEXTS(NEWCONTEXT)_CPUTIMER=LCTABLES_CONTEXTS(PROC_STACK)_CPUTIMER+onesec PROC_STACK=NEWCONTEXT CONTEXT==LCTABLES_CONTEXTS(NEWCONTEXT) %IF CONTEXT_GR(11)>>SSHIFT#DSIGSTKSEG %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!!Initasfree); ! IE ALL USED ACTIVATE BLKS PROC_STATUS=PROC_STATUS!24; ! SET AMT GOING & AMT GONE BITS ->RESUSP ASYN0(3): ! DUMMY AWAKEN FOR RECONFIGTN %IF SUSP#0 %THEN SRCE=SUSP %AND ->SUSPWS %IF LOCKST=0 %THEN ->DEAD; ! DEPART IF NO LOCKED DOWN AREA ->ACT; ! RESUME TO FREE LOCKED DOWN AREA !----------------------------------------------------------------------- ACTIVITY(3): ! CONTINUE AFTER SUSP ON FLY %IF SNOOZING=YES %THEN %START EPLIM=P_P1 RTLIM=P_P2 NONSEQVSIS=0 SEQVSIS=0; ! count sequential pageouts(can be huge) %IF susp>0 %AND serva(susp)_p<<2=0 %THEN ->retime ! dont charge pturns etc for asyn awake since ! it is probably an update o-p and ! and will immediately resusp which does ! does not cause ptrurns if apgedout CLEAR ACCESSED BITS %IF MONLEVEL&4#0 %THEN PERFORM_SNOOZN=PERFORM_SNOOZN+EPN PROC_STATUS=PROC_STATUS&(\(HADPONFLY!HADTONFLY)) ! RESET FOR NEW RESIDENCE ->RETIME %FINISH !---------------------------------------------------------------------- VSERRI: ! VIRTUAL STORE INTS ENTER HERE VSPARM=INTEGER(144) context_lastvsparm=vsparm VSSEG=VSPARM>>SSHIFT %IF 0>(32-SSHIFT+12) %IF VSSEGLSTLEN-1 %THEN PEPARM=9 %AND ->PE ! PUBLIC VSI %IF MONLEVEL&4#0 %AND MONVAD>0 %THEN GARNER(0,VSPARM) %IF PEPARM=16 %THEN VSPARM=1 %AND ->SEGTRAP %IF LST(VSSEG)&INVALID SEG#0 %THEN %START OPMESS("Missing Seg TRAP ".strhex(vsparm)) opmess("proc ".strint(process)." ".strhex(lst(vsseg))) ->SEGTRAP %FINISH ->PAGETRAP !----------------------------------------------------------------------- VSE: ! VS ERRORS SIGOUTP_P1=VSPARM SIGOUTP_P2=PROC_STACK SIGOUTP_TYPE=1 SIGOUTP_SSN=PROC_STACK SIGOUTP_SSNAD=ADDR(LC TABLES_CONTEXTS(PROC_STACK)) SIGOUTP_SUSP=0 NEWCONTEXT=2; ! SIGNAL CONTEXT %IF PROC_STACK=NEWCONTEXT %THEN %START PRINT STRING("VS ERROR ON SIGNAL STACK PARM=".STRHEX(VSPARM)." ") ->TERMINATE %FINISH ->SIGACT !----------------------------------------------------------------------- SEGTRAP: ! SEGMENT NOT AVAILABLE %IF SST(VSSEG)<0 %THEN ->VSE; ! NO CONNECTION ! ! HAVE TO DO THE PAGETABLE CALCULATIONS WITH THE SEGMENT LENGTH FROM THE ! SEGMENT TABLE ROUNDED APPROPIATLEY. THIS SATISFIES THE ROUNDING CONSIDERATIONS ! FOR PAGE TABLE ALIGNMENT AND ENABLES ALL EXCEES PAGES TO BE INVALID. HOWEVER ! THIS IS NOT ACCURATE ENOUGH FOR SHORT SEGEMNTS AND A FURTHER CHECK IS MADE ! IN PTRAP SECTION. ! ! FIRST PROTECT DIRECTOR BY CHECKING THE LAS 16 PAGES MORE CAREFULLY ! %IF XA=YES %THEN I=(CONTEXT_CONTROLR(1)&127+1)*16-1 %ELSE I=(CONTEXT_CONTROLR(1)>>24+1)*16-1 {GUESS!} %IF VSSEG>I %THEN ->VSE %IF XA=YES %THEN SEGLEN=(LST(VSSEG)&15+1)*16 %ELSE %IF XA=AMDAHL %THEN %C SEGLEN=(LST(VSSEG)>>28+1)*16 {GUESS} %ELSE SEGLEN=LST(VSSEG)>>28+1 %IF VSEPAGE>=SEGLEN %THEN VSPARM=VSPARM!3 %AND ->VSE %IF VSSEG=DSTKSEG %THEN SEGLEN=SEGEPSIZE; ! ensure pt always big enough %IF SEGLEN<=PTEPS %THEN ->OLDPTP %IF EPN>=EPLIM %THEN ->NOPAGES; ! Need a page for pagetables %if NEXTPTP=LCSPTSIZE-1 %then ->nopagetables %IF MULTIOCP=YES %THEN %START *BASR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT: %FINISH %IF FREE EPAGES>0 %START STOREX=QUICK EPAGE(0,X'10'); ! ZERO AND KEY OF 1 %IF MULTI OCP=YES %THEN STORESEMA=-1 ->ACT9 %FINISH POUT_SRCE=ME!9 POUT_P2=0; ! CLEAR TO ZERO POUT_P3=X'10'; ! KEY OF ONE %IF MULTIOCP=YES %THEN STORESEMA=-1 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=STOREX*PAGESIZE PTPVAD=LCSTKSEG<>8 NEXTPTP=NEXTPTP+1 *L_0,PTPVAD; *LR_2,0 *LA_1,4095; *LA_1,1(1) *LA_3,255; *SLL_3,24 *MVCL_0,2; ! FILL NEW PAGE WITH FFS ! ST_USERS=1 EPN=EPN+1 UEPN=UEPN+1 PROC_EPN=EPN PTEPS=4096//PTE SIZE OLDPTP: ! ROOM IN OLD PAGETABLE PAGE %IF XA=YES %START LST(VSSEG)=LST(VSSEG)&X'1F'!PTAD %ELSE LST(VSSEG)=LST(VSSEG)&X'F0000000'!PTAD %FINISH %IF XA=NO %THEN SEGLEN=(SEGLEN+3)&(-4) PTEPS=PTEPS-SEGLEN PTVAD=PTPVAD+PTAD&X'FF8' PTAD=PTAD+(SEGLEN*PTE SIZE); ! 8 BYTE BOUNDARY ! %IF TSTPTR=127 %THEN %START; ! SEGMENT NOT ACTIVE %IF ASFREE=0 %THEN FREE AS; ! NO FREE SLOTS ASP=0 ASP=ASP+1 %WHILE ASFREE<0 TSTPTR=ASP TST(VSSEG)=ASP ASEG(ASP)=VSSEG AS(I,ASP)=0 %FOR I=0,1,7 ASB=LTOPBIT>>ASP ASWIP=ASWIP!ASB; ! INSERT BIT %IF CBTA(SST(VSSEG))_TAGS&SMULTIPLE CON#0 %THEN ASSHR=ASSHR!ASB ASFREE=ASFREE&(\ASB); ! REMOVE BIT %FINISH ASPTVAD(TSTPTR)=PTVAD ! RUN ON INTO A PAGETRAP !----------------------------------------------------------------------- PAGETRAP: ! PAGE NOT AVAILABLE %IF EPN>=EPLIM %THEN ->NOPAGES %IF XA=YES %THEN SEGLEN=LST(VSSEG)&15 %ELSE %IF XA=AMDAHL %THEN SEGLEN=LST(VSSEG)>>28 %ELSE SEGLEN=0 %IF VSEPAGE>16*SEGLEN+15 %THEN VSPARM=3 %AND ->VSE CBTP=SST(VSSEG)+VSEPAGE>>5; ! assumes 32 epage sections for all bar last EPX=VSEPAGE&31 CBT==CBTA(CBTP) %IF EPX>CBT_LNGTH %THEN VSPARM=3 %AND ->VSE %IF CBT_TAGS&ACTIVE=0 %THEN %START; ! BLOCK NOT ACTIVE POUT_DEST=X'80001'; ! GET AMTX POUT_SRCE=0 POUT_P1=PROCESS POUT_P2=CBT_DA POUT_P3=(CBT_TAGS&NEW BLK)<<24!CBT_LNGTH ! NEWBIT<<31 ! LENGTH ! %IF CBT_TAGS&NEW BLK#0 %AND CBT_TAGS&READONLY#0 %THENSTART ! OPMESS(PROC_USER."CONNECT MODE?? CALL PDS") ! OPMESS("DA=".STRHEX(CBT_DA)) ! %FINISH %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 AMCALLN=AMCALLN+1 %FINISH %IF POUT_P2<=0 %THEN ->AMTXSW(POUT_P2) CBT_AMTX=POUT_P2 CBT_TAGS=CBT_TAGS&(\NEW BLK)!ACTIVE; ! NO LONGER NEW BUT ACTIVE %FINISH %ELSE %IF TSTPTR=127 %OR ASPTVAD(TSTPTR)=-1 %THEN MONITOR("ASPTVAD invalid??") %IF CBT_AMTX=0 %THEN VSPARM=255 %AND ->VSE; ! Director LEFT ACTIVE SET ! %IF AMTA(CBT_AMTX)_DA#CBT_DA %OR AMTA(CBT_AMTX)_LEN#CBT_LNGTH+1 %THEN %C OPMESS("AMT error call PDS") POUT_DEST=X'40001'; ! PAGETURN/PAGE-IN POUT_SRCE=ME!X'8000000A'; ! REPLY TO ACTIVITY 10 POUT_P1=CBT_AMTX<<16!EPX POUT_P3=X'F0'; ! STORE KEY ! ! The following line is commented out protem as it needs Director changes ! (e.g. in DMOVETOFILE) ! It is replaced by the line following it. %IF XA#YES %AND CBT_TAGS&READONLY#0 %THEN POUT_P3=X'E0' ! %IF CBT_TAGS&READONLY#0 %THEN POUT_P3=X'E0' ! USE KEY E FOR READ PROTECTION ON 370 %IF MONLEVEL&2#0 %THEN POUT_P4=VSPARM; ! NOT USED.FOR KMON ONLY %IF CBT_TAGS&ADVISORY SEQ#0 %THEN PAGEOUT(VSSEG,VSEPAGE-2,CBT) %AND pout_dest=x'40009' %ELSE %START ! I=VSEPAGE>>5 ! J=VSEPAGE&31 ! K=AS(I,TSTPTR) ! %IF I=0 %THEN TIMER1=LENGTHENI(K)&x'0FFFFFFFF' %ELSE %C ! TIMER1=LONGINTEGER(ADDR(AS(I-1,TSTPTR))) ! %IF K<>(32-J)&3=3 %THEN %C ! PAGEOUT(VSSEG,VSEPAGE-2,CBT) %AND pout_dest=x'40009' %ELSE (%C) NONSEQVSIS=NONSEQVSIS+1 %FINISH %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH PAGETURN(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 PTIT=PTIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF POUT_DEST#0 %THEN PTE=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 ! p_p3 is transfer flag 0=ok ! VSSEG,VSEPAGE&TSTPTR INTACT !! %IF p_p3#0 %THEN ->ptranfail EPH: PROC_STATUS=PROC_STATUS&X'FFFFFFFD' PTE=P_P2 ACNT_PTURNS=ACNT_PTURNS+1 ACT10: ! ENTERS HERE IF PAGE NOT TRANFRD ASP=TSTPTR I=VSEPAGE>>5 AS(I,ASP)=AS(I,ASP)!TOPBIT>>(VSEPAGE&31) ASB=LTOPBIT>>ASP ASWAP=ASWAP!ASB ASWIP=ASWIP&(\ASB) EPN=EPN+1 %IF CBT_TAGS&SMULTIPLE CON=0 %THEN UEPN=UEPN+1 PROC_EPN=EPN I=ASPTVAD(ASP); ! VIRTUAL ADDRESS OF PAGETABLE ! FILL PAGE TABLE ENTRY VIA VIRTUAL ADDRESS %IF XA=YES %THEN %START ! ! The following line is commented out protem as it needs Director changes ! (e.g. in DMOVETOFILE) %IF CBT_TAGS&READONLY#0 %THEN PTE=PTE!X'200'; ! SET PAGE PROTECT BIT INTEGER(I+4*VSEPAGE)=PTE %ELSE SHORTINTEGER(I+2*VSEPAGE)<-PTE>>8 %FINISH %IF seqvsis>eplim %AND pagefrees>COM_sepgs>>5 %THEN wait(7,1) %AND ->return ACTIVITY(7): ! Re-enter after pause for seqvsis ->ACTIVATE !-------------------------------------------- ACTIVITY(11): ! PAGE READ FAILURE( old method of reply to dact+1) ptranfail: ! new method of inspecting flags %IF P_P3<0 %THEN ->DEAD POUT_DEST=LSN3<<16 POUT_P1=1 POUT_P2=VSSEG<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 ? AMTXSW(-4): ! clears still in progress WAIT(2,1); ! TRY AGAIN IN 1 SEC ->RETURN AMTXSW(-1): ! NO AMT CELLS AVAILABLE AMTXSW(-2): ! NOT ENOUGH GARBAGE DEACTIVATE(Asfree!!Initasfree) ->ACTIVATE AMTXSW(-3): ! CHANGE BLOCK SIZE WHEN STILL IN USE PEPARM=19 ->PE !----------------------------------------------------------------------- ONFRUNQ: ! PUT ON FRONT OF RUNQ POUT_DEST=ME!2 ONFRUNQA: PROC_STATUS=PROC_STATUS!2; ! SET PRIORITY BIT ONBRUNQA: ! TO THE BACK OF RUNQ PON(POUT) ->RETURN !----------------------------------------------------------------------- NOpagetables: %if monlevel&4#0 %then perform_noptabs=perform_noptabs+1 NOPAGES: ! NO EPAGES FOR PAGEFLT %IF MONLEVEL&4#0 %AND MONVAD>0 %THEN GARNER(7,3<<24!PROC_CATEGORY<<16!EPN) %IF NEXTPTP>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PERFORM_SERVN(3)=PERFORM_SERVN(3)+1 %FINISH %IF POUT_P1#0 %THEN %START EPLIM=POUT_P1 RTLIM=POUT_P2 RTN=0 STROBE(0) %IF POUT_P3#0; ! NEWCAT_STROBEI#0 ->ACTIVATE %FINISH %FINISH %IF XSTROBE<0 %THEN %START; ! HAD A CHANGE CONTEXT SINCE LAST STROBE STROBE(1) %IF EPNACTIVATE; ! GOT SOME BACK ! %FINISH %FINISH WORKSET(1) J=Pagefrees; ! no of writeouts started (+any already going) POUT_DEST=X'30003'; ! OUT OF EPAGES POUT_SRCE=ME!1 POUT_P1=PROCESS POUT_P2=RTN; ! TIMESLICES USED SO FAR Pout_P3=j %if J>2 %or MPlevel=1 %then pon(pout) %else %c DPON(POUT,j>>8+mplevel>>2); ! one sec for each 256 pages +1 sec for each 4 delayed users ->RETURN !----------------------------------------------------------------------- OUTI: J=CONTEXT_PSW>>SSHIFT&(LSTLEN-1); ! SEG NO %IF XA#NO %START ->ILLEGAL OUT %UNLESS J=DCODESEG %ELSE ->ILLEGAL OUT %UNLESS DCODESEG<=J<=DCODESEG+DCODESEGS-1 %FINISH OUTN=PAGE0_MONCODE %IF OUTN=99 %START; ! director wants system crash PRINTSTRING("DIRECT requests system crash ") ->ISPVSR %FINISH %IF 0<=OUTN<=MAXDIROUT %THEN %START %IF PROC_STACK=2 %AND 1<ILLEGAL OUT ! ALLOWS OUT 0,1,3,6,8,10,12,13,14,15 ! 16,19,20,24{part},27,28 FROM SIGNAL STACK ->DIROUT(OUTN) %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=ADDR(LCTABLES_CONTEXTS(PROC_STACK)) PRINTSTRING(PROC_USER." FAILING CONTEXT") DUMP TABLE(0,J,CONTEXTL) %IF PROC_STACK=2 %START J=ADDR(LCTABLES_CONTEXTS(1)) PRINTSTRING(PROC_USER." NORMAL CONTEXT") DUMPTABLE(0,J,CONTEXTL) %FINISH ! CREATE STOPPING MSGE TO DIRECT ALLOUTP_P1=PROCESS ALLOUTP_P2=PROC_INCAR STRING(ADDR(ALLOUTP_P3))=PROC_USER ALLOUTP_P5=LCTABLES_CONTEXTS(PROC_STACK)_PSW1; ! failing pc to "reason" ALLOUTP_P6=LCTABLES_ACNT_PTURNS; ! fill in pageturns field ASDESTROY=2; ! PRESERVE EVERYTHING BUT DONT ZERO UNUSED DOUT0: ! NORMAL STOPS JOIN HERE DEACTIVATE(Asfree!!Initasfree) ASDESTROY=0 %IF SEMAHELD#0 %THEN %START OPMESS("PROC".STRINT(PROCESS)." DIES WITH SEMA") POUT_DEST=X'70002' POUT_SRCE=ME POUT_P1=SEMAHELD PON(POUT); ! force the sema free %FINISH 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_SRCE=ME POUT_P1=PROCESS POUT_DEST=X'00370014'; ! Tell comms controll process going %IF PROC_STATUS&4=0 %THEN pon(POUT); ! Omit for Batcj processes POUT_DEST=X'30008'; ! SCHEDULE/DESTROY PON(POUT) ->RETURN !----------------------------------------------------------------------- DIROUT(0): ! DIRECTOR STOPS PROCESS(NORMAL) ASDESTROY=3; ->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) %if POUT_P4>>24=8; ! Adaptor type = oper ! The above lines date from the time when prompts were conditional output ! Facility now omly required when the terminal is "OPER" 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 SST(VSSEG)>=0 %AND (vssbtmseg<=VSSEG<=15 %OR LCSTKSEGFREACT DA=CBTA(J)_DA J=ACNT_PTURNS %IF TSTPTR#127 %THEN ASOUT(TSTPTR) J=ACNT_PTURNS-J; ! NO OF TRANSFERS STARTED BY DCONNECT ASDESTROY=0 %IF J=0 %OR PROCESS<=3 %THEN ->REACT POUT_DEST=ME!16 ->ONBRUNQA; ! WILL REENTER AT ACTIVITY(16) ! ! 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 DCLEARS+PAGEFREES>COM_sepgs>>5 %AND LASTDA#0 %AND CHECKDA(LASTDA)>0 %THEN WAIT(16,1) %AND ->RETURN LASTDA=DA ->REACT !----------------------------------------------------------------------- DIROUT(4): ! reactivate for director ->REACT !----------------------------------------------------------------------- DIROUT(5): ! PON FOR DIRECTOR SRCE=PROCESS+LOCSN1 DIRPONS: ! OTHER PONS JOIN HERE DEST=ALLOUTP_DEST>>16 %IF DEST=X'FFFF' %THEN %START; ! RELAY MESSAGE %IF FIND PROCESS=0 %THEN ->ACTIVATE; ! NOT LOGGED ON %FINISH %ELSE %START J=DEST; %IF DEST=63 %THEN J=ALLOUTP_P6>>16 %UNLESS 0<=JFREACT %IF J>LOCSN1 %START J=(J-LOCSN0)&(MAXPROCS-1) %IF PROCA(J)_USER="" %THEN ->FREACT %FINISH %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 %IF LOCKST#0 %THEN ->ONBRUNQA; ! FOR TAPES ETC ->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 %IF PROC_STACK=2 %THEN PRINT STRING(" SUSPENDED IN SIGNAL STATE") %AND NEWCONTEXT=2 %AND ->TERMINATE ! TRY TO STAY IN STORE IF CORE ! IS PLENTIFUL %IF SNOOZING=YES %THEN %START ->DEPART %IF PROC_STATUS&AMTLOST#0 %IF NONSEQVSIS>1 %OR XSTROBE<0 %THEN STROBE(1) I=UEPN*COM_USERS ->DEPART %UNLESS I>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PERFORM_SERVN(3)=PERFORM_SERVN(3)+1 %FINISH %IF POUT_P1=0 %THEN %START; ! SUSPED ON FLY %IF MONLEVEL&4#0 %AND MONVAD>0 %THEN GARNER(5,EPN) SUSP=SRCE LCTABLES_CONTEXTS(PROC_STACK)_SUSP=SUSP ->RETURN %FINISH %FINISH ACTIVITY(8): DEPART: ! suspended but must now go %IF MONLEVEL&4#0 %AND MONVAD>0 %THEN GARNER(7,1<<24!PROC_CATEGORY<<16!EPN) 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 LCTABLES_CONTEXTS(PROC_STACK)_SUSP=SUSP ->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 J=DEST; %IF DEST=63 %THEN J=ALLOUTP_P6>>16 %UNLESS 0<=JFREACT %IF J>LOCSN1 %START J=(J-LOCSN0)&(MAXPROCS-1) %IF PROCA(J)_USER="" %THEN ->FREACT %FINISH %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) ->ACTIVATE; ! PDS THINKS THIS WILL BE BETTER ! THAN THE ORIGINAL LINE ->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) %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) J=PROC_RUNQ; PROC_RUNQ=1 %IF MULTIOCP=YES %THEN %START *BASR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,SCHEDSEMA *BC_8, *DROP_1 SEMALOOP(SCHEDSEMA) SSEMAGOT1: %FINISH MPLEVEL=MPLEVEL-1; ! DECREASE MPLEVEL&CHECK DEADLOCKS %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 ->RETURN; ! WAIT IN STORE FOR REPLY !----------------------------------------------------------------------- ACTIVITY(13): ! REPLY TO PON & WAIT IN STORE %IF MULTIOCP=YES %THEN %START *BASR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,SCHEDSEMA *BC_8, *DROP_1 SEMALOOP(SCHEDSEMA) SSEMAGOT2: %FINISH MPLEVEL=MPLEVEL+1 PROC_RUNQ=J %IF MULTIOCP=YES %THEN SCHEDSEMA=-1 ALLOUTP=P ALLOUTP_DEST=SRCE %IF PROCESS>=FIRST UPROC %START CONTEXT==LCTABLES_CONTEXTS(PROC_STACK) CONTEXT_CPUTIMER=CONTEXT_CPUTIMER-OUT18CHARGE<<12 %FINISH ->ACT !----------------------------------------------------------------------- DIROUT(12): ! MAKE DIRECTOR PRIV I=(LSTLEN-1)>>4 %IF XA=YES %START CONTEXT_CONTROLR(1)=CONTEXT_CONTROLR(1)>>6<<6!I %ELSE CONTEXT_CONTROLR(1)=CONTEXT_CONTROLR(1)<<8>>8!(I<<24) %FINISH CONTEXT_PSW=CONTEXT_PSW&(\(LONGONE<<48)) ->ACTIVATE !----------------------------------------------------------------------- DIROUT(13): ! REMOVE DIRECTOR PRIV I=(LSTLEN-16-1)>>4 %IF XA=YES %START CONTEXT_CONTROLR(1)=CONTEXT_CONTROLR(1)>>6<<6!I %ELSE CONTEXT_CONTROLR(1)=CONTEXT_CONTROLR(1)<<8>>8!(I<<24) %FINISH CONTEXT_PSW=CONTEXT_PSW!(LONGONE<<48) ->ACTIVATE !----------------------------------------------------------------------- DIROUT(14): ! SWOP STACK DIROUT(19): ! SWOP STACK FROM SIGNAL STACK I=ALLOUTP_P1; ! I=NEW CONTEXT NO, K=SUSP STATE K=ALLOUTP_P2 %UNLESS 1<=IFREACT %IF i=2 %THEN ->freact; ! Do not allow swopping to Sig Stk %UNLESS 0#I#PROC_STACK %THEN ->FREACT %IF LCTABLES_CONTEXTS(I)_PSW0&x'07000000'#x'07000000' %THEN ->FREACT ! must be paged mode and interruptable ! MOVE IT TO NEW STACK LCTABLES_CONTEXTS(I)_CPUTIMER=LCTABLES_CONTEXTS(PROC_STACK)_CPUTIMER j=lctables_contexts(i)_controlr(1) %IF j&cr1mask#proc_lstad %START opmess("LC stack migrated") lctables_contexts(i)_controlr(1)=j&(\cr1mask)!(proc_lstad&cr1mask) %FINISH ! ! if swopping away from the signal stack remove the one second allowance made ! at sigact to avoid timer interupts in the signal state ! %IF proc_Stack=2 %THEN lctables_contexts(i)_cputimer=lctables_contexts(i)_cputimer-onesec PROC_STACK=I SUSP=K; ! GO BACK TO CORRECT SUSPEND STATUS ALLOUTP==LCTABLES_OUTPS(PROC_STACK) ->RESUSP !----------------------------------------------------------------------- DIROUT(15): ! SYSTEM CALL ERROR ! (AFTER STACK SWITCH) PEPARM=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 CABI=0 RECHECK: K=INTEGER(ADDR(ALLOUTP)+4*CABI) %IF K=0 %THEN ->REACT K=CHECKDA(K) %IF K#0 %THEN %START %IF K<0 %AND J>0 %THEN %START OPMESS("? BLK ACTIVTY ".STRHEX(INTEGER(ADDR(ALLOUTP)+4*CABI))) OPMESS("USER=".PROC_USER) ->FREACT %FINISH ! ! 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 CABI=CABI+1 ->RECHECK %IF CABI<=7; ! UP TO 8 BLOCKS IN 1 REQUEST ->REACT !----------------------------------------------------------------------- ACTIVITY(14): ! REPLY FROM DESTROY CHECK J=J+1 ->RECHECK !----------------------------------------------------------------------- DIROUT(18): ! CHECK & FORWARD I-O REQUEST ! P5=WRIT<<31!LEN ! P6=ADDRESS %IF CHECK RES(ALLOUTP_P5>>31,ALLOUTP_P5&X'FFFFFF',ALLOUTP_P6)#0 %THEN ->FREACT ! NOT RESIDENT CONTEXT==LCTABLES_CONTEXTS(PROC_STACK); ! CURRENT CONTEXT ALLOUTP_P6=CONTEXT_CONTROLR(1) ->PONWAIT !------------------------------------------------------------------- !----------------------------------------------------------------------- DIROUT(20): ! PROCMON ENABLE %IF MONLEVEL&4#0 %START; ! ENABLE INPROCESS MONITORING MONVAD=ALLOUTP_P1 ->REACT %IF MONVAD<=0 MONVAD=0 %AND ->FREACT %UNLESS CHECKRES(0,4096,MONVAD)=0 ->FREACT %IF LOCKST=0 MONLIM=MONVAD+INTEGER(MONVAD+8) MONPTAD=INTEGER(LOCKSTVAD+(MONVAD>>SSHIFT)*4) %IF XA=YES %START MONPTAD=MONPTAD&X'7FFFFF80' %ELSE MONPTAD=MONPTAD&X'00FFFFF8' %FINISH J=LOCKSTVAD+MONPTAD&X'FF8'; ! PAGE&SEG TABLE IN SAME PAGE %IF XA=YES %START %FOR I=0,1,(integer(monvad+8)-1)>>12 %CYCLE ->FREACT %IF INTEGER(J+4*I)&X'400'#0 %REPEAT %ELSE %FOR I=0,1,(integer(monvad+8)-1)>>12 %CYCLE ->FREACT %IF SHORTINTEGER(J+2*I)&X'8'#0 %REPEAT %FINISH ->REACT %FINISH DIROUT(21): ! DISABLE PROCMON DIROUT(22): ! PROCMON ON DIROUT(23): ! PROCMON OFF ->FREACT DIROUT(24): ! SPECIAL FOR REQUEST OUTPUT SRCE=PROCESS+LOCSN2 %IF ALLOUTP_DEST=X'370007' %START ALLOUTP_SRCE=X'80000000'!SRCE<<16 %IF MONLEVEL&12=12 %START *STPT_TIMER1 %FINISH COMMS CONTROL(ALLOUTP) %IF MONLEVEL&12=12 %START *STPT_TIMER2 PERFORM_SERVIT(55)=PERFORM_SERVIT(55)+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PERFORM_SERVN(55)=PERFORM_SERVN(55)+1 %FINISH ->ACTIVATE %FINISH ->ILLEGAL OUT %IF PROC_STACK=2 ->DIRPONS 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 CHECK RES(0,ALLOUTP_P5,ALLOUTP_P6)#0 %THEN ->FREACT ! NEEDED FOR PAGE OUT TOO %IF LOCKST=0 %THEN %START; ! NO SEG TABLE AROUND ->FREACT %UNLESS ALLOUTP_P1>0 %IF MULTIOCP=YES %THEN %START *BASR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA) SSEMAGOT3: %FINISH %IF FREE EPAGES>0 %THEN %START STOREX=QUICK EPAGE(0,X'10') %IF MULTIOCP=YES %THEN STORESEMA=-1 ->ACTF %FINISH POUT_SRCE=ME!X'F' POUT_P2=0; ! CLEAR TO ZERO %IF MULTIOCP=YES %THEN STORESEMA=-1 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=LOCKSTX*PAGESIZE %IF XA=YES %THEN LCTABLES_LCPTABLE(LCSPTSIZE-1)=LOCKST %ELSE LCTABLES_LCHPTABLE(LCSPTSIZE-1)<-LOCKST>>8 INTEGER(LOCKSTVAD+4*I)=-1 %FOR I=0,1,1023 J=4*LSTLEN; ! USE REST OF EPAGE AS PAGETABLES INTEGER(LOCKSTVAD+4)=J; ! HEAD OF PT LIST(F BIT NOT SET!) %WHILE J<=2048 %CYCLE INTEGER(LOCKSTVAD+J)=J+1024 J=J+1024 %REPEAT %FINISH VSSEG=ALLOUTP_P6>>SSHIFT %IF ALLOUTP_P1>0 %START; ! LOCK AREA %IF INTEGER(LOCKSTVAD+4*VSSEG)#-1 %THEN ->FREACT; ! SEG LOCKED ALREADY %IF INTEGER(LOCKSTVAD+4)=-1 %THEN ->FREACT; ! ALL PAGETABLES USED LTAD=LOCKSTVAD+INTEGER(LOCKSTVAD+4); ! VIRT AD OF PAGETABLE INTEGER(LOCKSTVAD+4)=INTEGER(LTAD) LOCKST=LOCKST+(1<<28); ! KEEP COUNT IN TOP 4 BITS %IF XA=YES %START INTEGER(LOCKSTVAD+4*VSSEG)=LST(VSSEG)&X'3F'!(LTAD-LOCKSTVAD+LOCKST) %ELSE INTEGER(LOCKSTVAD+4*VSSEG)=LST(VSSEG)&X'F0000007'!(LTAD-LOCKSTVAD+LOCKST) %FINISH %FINISH %ELSE %START; ! UNLOCK AREA %IF INTEGER(LOCKSTVAD+4*VSSEG)=-1 %THEN ->FREACT LTAD=(INTEGER(LOCKSTVAD+4*VSSEG)&X'FF0'+LOCKSTVAD) ! VIRT ADDR OF PTABLE INTEGER(LTAD)=INTEGER(LOCKSTVAD+4) INTEGER(LOCKSTVAD+4)=LTAD-LOCKSTVAD INTEGER(LOCKSTVAD+4*VSSEG)=-1 %FINISH PT==ARRAY(ASPTVAD(TST(VSSEG)),PTF) J=ALLOUTP_P6-VSSEG<>12,1,(J+ALLOUTP_P5-1)>>12 %IF ALLOUTP_P1>0 %THEN K=PT(VSEPAGE) %ELSE K=-1 %IF XA=YES %THEN %START INTEGER(LTAD+4*VSEPAGE)=K %ELSE SHORTINTEGER(LTAD+2*VSEPAGE)=K %FINISH 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&12=12 %THEN %START *STPT_TIMER1 %FINISH PAGETURN(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 PTIT=PTIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF POUT_DEST=0 %AND ALLOUTP_P1>0 %THEN MONITOR("LOCK GOES WRONG?") %REPEAT %IF ALLOUTP_P1<=0 %START; ! UNLOCK REMOVE LC PT ENTRY %IF XA=YES %THEN LCTABLES_LCPTABLE(LCSPTSIZE-1)=-1 %ELSE LCTABLES_LCHPTABLE(LCSPTSIZE-1)=-1 LOCKST=LOCKST-1<<28 %IF LOCKST>>28=0 %START POUT_DEST=X'60000' POUT_P2=LOCKSTX P_SRCE=ME!15 %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH RETURN EPAGE(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 RETIT=RETIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 RETCALLN=RETCALLN+1 %FINISH LOCKST=0 %FINISH %FINISH ALLOUTP_P6=LOCKST ->REACT !----------------------------------------------------------------------- DIROUT(26): ! CHANGE CONTEXT CLEAR ACCESSED BITS %IF MONLEVEL&4#0 %AND MONVAD>0 %THEN GARNER(6,EPN) XSTROBE=XSTROBE!X'80000000'; ! NOTE CHANGED CONTEXT ->ACTIVATE DIROUT(27): ! CHANGE ACCESS OF CONNECTED SEGMENT ! ALLOUTP_P1=seg (new access taken from cbt) VSSEG=ALLOUTP_P1 ->FREACT %UNLESS vssbtmseg<=VSSEG<=15 %OR LCSTKSEGFREACT %IF j<0; ! not connected TSTPTR=TST(VSSEG) CHACCESS(TSTPTR) %UNLESS TSTPTR=127; ! Not active change will be made ! on reactivation ->REACT !----------------------------------------------------------------------- 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 !----------------------------------------------------------------------- %INTEGER %FN 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 (PARMF) POUT POUT_DEST=X'80005' POUT_P1=DA %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 AMCALLN=AMCALLN+1 %FINISH %RESULT=POUT_DEST %END %INTEGER %FN 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 STORE TABLE * !* RESULT=0 AREA LOCKED DOWN * !* RESULT#0 SOME OF THE AREA IS NOT RESIDENT * !*********************************************************************** %INTEGER I,J,STX %CYCLE I=AD>>12,1,(AD+LEN-1)>>12; ! THROUGH THE PAGES *BASR_4,0 *USING_4 *L_1,I *SLL_1,12 *LRA_2,0(1) *BC_7, *ST_2,J *DROP_4 %IF WRIT#0 %START STX=J>>12 STORE(STX)_FLAGS<-STORE(STX)_FLAGS!8 %FINISH %REPEAT %RESULT=0 FAIL: %RESULT=1 %END !----------------------------------------------------------------------- %ROUTINE PAGEOUT(%INTEGER VSSEG,VSEPAGE, %RECORD (CBTF) %NAME CBT) !*********************************************************************** !* PAGES OUT A PAGE AS A RESULT OF WORKING ON A SEQUENTIAL FILE * !* NOTE PAGE<0 IS VALID INDICATING PREVIOUS SEGMENT(MUST CHECK!) * !*********************************************************************** %RECORD (PARMF) P %INTEGER I,ASP,ASI,MARK,PTAD,J %IF VSEPAGE<0 %THEN %START; ! PREVIOUS SEGMENT %IF CBT_TAGS&CONTINUATN BLK=0 %THEN %RETURN VSSEG=VSSEG-1 VSEPAGE=VSEPAGE+SEGEPSIZE %FINISH ASP=TST(VSSEG) PTAD=LST(VSSEG) ASI=VSEPAGE>>5 %IF ASP#127 %AND AS(ASI,ASP)&(TOPBIT>>(VSEPAGE&31))#0 %START ! PAGE IN STORE ! ! THIS SEQUENCE WHICH OCCURS SEVERAL TIMES WITH MINOR VARIATIONS SETS MARK TO THE ! READ&CHANGED MARKERS FOR THE PAGE DEFINED BY VSSEG&VSEPAGE. IT ENABLES THE ! MARKS TO BE RESET AND -OR THE THE PAGE TABLE ENTRY REMOVED. PTAD IS ! THE LST ENTRY FOR VSSEG ! I=VSSEG<0 %THEN GARNER(3+MARK>>3,VSSEG<>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF MARK&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 %IF CBT_TAGS&SMULTIPLE CON=0 %THEN UEPN=UEPN-1 EPN=EPN-1 PROC_EPN=EPN SEQVSIS=SEQVSIS+1 AS(ASI,ASP)=AS(ASI,ASP)!!(TOPBIT>>(VSEPAGE&31)) %IF MONLEVEL&16#0 %START I=PROC_CATEGORY SEQOUT(I)=SEQOUT(I)+1 %FINISH %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 * !*********************************************************************** %RECORD (CBTF) %NAME CBT %longinteger asb %INTEGER MARK,VSSEG,VSEPAGE,SH,CBTP,POFL,I,PTAD,MASK,ASI,SEGLEN VSSEG=ASEG(ASP) %IF ASDESTROY&1#0 %AND LSTLEN-16<=VSSEG>28 %ELSE SEGLEN=0 %FOR ASI=0,1,SEGLEN>>1 %CYCLE MASK=AS(ASI,ASP) AS(ASI,ASP)=0 CBTP=SST(VSSEG)+ASI CBT==CBTA(CBTP) VSEPAGE=32*ASI-1 %WHILE MASK#0 %CYCLE SH=0 SH=SH+1 %AND MASK=MASK<<1 %WHILE MASK>0 MASK=MASK<<1 VSEPAGE=VSEPAGE+SH+1 ! ! THIS SEQUENCE WHICH OCCURS SEVERAL TIMES WITH MINOR VARIATIONS SETS MARK TO THE ! READ&CHANGED MARKERS FOR THE PAGE DEFINED BY VSSEG&VSEPAGE. IT ENABLES THE ! MARKS TO BE RESET AND -OR THE THE PAGE TABLE ENTRY REMOVED. PTAD IS ! THE LST ENTRY FOR VSSEG ! I=VSSEG<0 %THEN GARNER(1+POFL>>3,VSSEG<>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 EPN=EPN-1 %IF CBT_TAGS&SMULTIPLE CON=0 %THEN UEPN=UEPN-1 %REPEAT %IF CBT_TAGS&ACTIVE#0 %THEN %START POUT_DEST=X'80002'; ! RETURN AMTX POUT_SRCE=0 POUT_P1=PROCESS POUT_P2=CBT_AMTX POUT_P3=ASDESTROY&2; ! CLEAR NEW BUT UNUSED %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH ACTIVE MEM(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 AMCALLN=AMCALLN+1 %FINISH CBT_AMTX=0; ! NEW BITS CBT_TAGS=CBT_TAGS&(\(ACTIVE)) ACNT_PTURNS=ACNT_PTURNS+POUT_P6; ! CHARGE FOR ANY CLEARS %FINISH %REPEAT; ! FOR NEXT 32 ACTIVE PAGES PROC_EPN=EPN LST(VSSEG)=LST(VSSEG)!INVALID SEG; ! NOW MARKED AS INVALID ASEG(ASP)=0; ! FOR DUMP CRACKING ! NOT OTHERWISE NEEDED ASPTVAD(ASP)=-1 TST(VSSEG)=127 ASB=LTOPBIT>>ASP ASWAP=ASWAP&(\ASB) ASWIP=ASWIP&(\ASB) ASSHR=ASSHR&(\ASB) ASFREE=ASFREE!ASB *PTLB_0(0); ! UTILISE THE BLUNDERBUSS %END !----------------------------------------------------------------------- %ROUTINE STROBE(%INTEGER SFLAGS) !*********************************************************************** !* WHIP THROUGH ALL THE ACTIVE PAGES IN EACH ACTIVE SEGMENT * !* ANY PAGES NOT REFERENCED ARE PAGED OUT. THE REFERENCE BITS ARE * !* CLEARED IN CASE THIS PAGE IS NOT USED FURTHER. * !* A CRITICAL ROUTINE FOR PERFORMANCE HENCE HAND CODING * !* 2**0 OF SFLAGS SET FOR NOT CLEARING PT USE BITS * !* 2**1 OF SFLAGS NOT USED * !*********************************************************************** %RECORD (CBTF) %NAME CBT %LONG %INTEGER asmask,asb %INTEGER MARK,POFL,ASP,VSSEG,VSEPAGE,CBTP,EPMASK,PTAD,I,J,ASI,SEGLEN %IF MONLEVEL&16#0 %THEN %START %INTEGER CAT %FINISH 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 ASMASK=ASMASK<<1 %AND ASP=ASP+1 %WHILE ASMASK>0 ASMASK=ASMASK<<1 ASP=ASP+1 VSSEG=ASEG(ASP) PTAD=LST(VSSEG) %IF XA=YES %THEN SEGLEN=PTAD&15 %ELSE %IF XA=AMDAHL %THEN SEGLEN=PTAD>>28 %ELSE SEGLEN=0 %IF CBTA(SST(VSSEG))_TAGS&ADVISORY SEQ#0 %THEN %CONTINUE %FOR ASI=0,1,SEGLEN>>1 %CYCLE CBTP=SST(VSSEG)+ASI CBT==CBTA(CBTP) EPMASK=AS(ASI,ASP) VSEPAGE=32*ASI-1 %WHILE EPMASK#0 %CYCLE; ! FOR EACH ACTIVE PAGE EPMASK=EPMASK<<1 %AND VSEPAGE=VSEPAGE+1 %WHILE EPMASK>0 EPMASK=EPMASK<<1 VSEPAGE=VSEPAGE+1 ! ! THIS SEQUENCE WHICH OCCURS SEVERAL TIMES WITH MINOR VARIATIONS SETS MARK TO THE ! READ&CHANGED MARKERS FOR THE PAGE DEFINED BY VSSEG&VSEPAGE. IT ENABLES THE ! MARKS TO BE RESET AND -OR THE THE PAGE TABLE ENTRY REMOVED. PTAD IS ! THE LST ENTRY FOR VSSEG ! I=VSSEG< *RRBE_0,2; ! STORE KEY RESET L1: %FINISH %ELSE %IF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK *TM_SFLAGS+3,1; *BC_1, *RRB_0(2) L3: %ELSE *ISK_0,2; *ST_0,MARK; ! KEY ON 1ST 2 K *LA_15,2048(2); *ISK_0,15; ! 2ND SET OF MARKERS *O_0,MARK; *ST_0,MARK *TM_SFLAGS+3,1; *BC_1, *RRB_0(2); *RRB_0(15); ! MARKERS RESET L2: %FINISH *DROP_3 POFL=(MARK&2)<<2!1; ! WRIT&RECAPTURE %IF MARK&4=0 %START; !NOT REFERENCED ! STROBE OUT NON USED AS(ASI,ASP)=AS(ASI,ASP)&(\(TOPBIT>>(VSEPAGE&31))) %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 %AND MONVAD>0 %THEN GARNER(3+POFL>>3,VSSEG<>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 %IF XA=YES %START; ! XA BUT NOT AMDAHL V7 *L_1,I; ! STILL FULL VIRTUAL ADDRESS *L_2,PTAD; *IPTE_2,1; ! P-T ENTRY INVALIDATED&TLB purged %ELSE J=ASPTVAD(ASP)+(PTE SIZE*VSEPAGE) SHORTINTEGER(J)=SHORTINTEGER(J)!8 %FINISH EPN=EPN-1 %IF CBT_TAGS&SMULTIPLE CON=0 %THEN UEPN=UEPN-1 %FINISH %REPEAT %REPEAT J=AS(0,ASP) J=J!AS(ASI,ASP) %FOR ASI=1,1,SEGLEN>>1 %IF J=0 %THEN %START ASB=LTOPBIT>>ASP ASWAP=ASWAP&(\ASB) ASWIP=ASWIP!ASB %FINISH %REPEAT %IF EPN0 ASP=ASP+1 ASMASK=ASMASK<<1 VSSEG=ASEG(ASP) PTAD=LST(VSSEG) %IF XA=YES %THEN SEGLEN=PTAD&15 %ELSE %IF XA=AMDAHL %THEN SEGLEN=PTAD>>28 %ELSE SEGLEN=0 %FOR ASI=0,1,SEGLEN>>1 %CYCLE CBTP=SST(VSSEG)+ASI CBT==CBTA(CBTP) EPMASK=AS(ASI,ASP) AS(ASI,ASP)=0 VSEPAGE=32*ASI-1 %WHILE EPMASK#0 %CYCLE EPMASK=EPMASK<<1 %AND VSEPAGE=VSEPAGE+1 %WHILE EPMASK>0 EPMASK=EPMASK<<1 VSEPAGE=VSEPAGE+1 ! ! THIS SEQUENCE WHICH OCCURS SEVERAL TIMES WITH MINOR VARIATIONS SETS MARK TO THE ! READ&CHANGED MARKERS FOR THE PAGE DEFINED BY VSSEG&VSEPAGE. IT ENABLES THE ! MARKS TO BE RESET AND -OR THE THE PAGE TABLE ENTRY REMOVED. PTAD IS ! THE LST ENTRY FOR VSSEG ! I=VSSEG<0 %THEN GARNER(1+POFL>>3,VSSEG<>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PTCALLN=PTCALLN+1 %FINISH %IF POFL&8#0 %THEN ACNT_PTURNS=ACNT_PTURNS+1 %IF MARK&(1<<29)=0 %THEN %START EPN=EPN-1 %IF CBT_TAGS&SMULTIPLE CON=0 %THEN UEPN=UEPN-1 %FINISH %REPEAT %REPEAT %REPEAT PROC_EPN=EPN ASWAP=0 ! ! SHUFFLE DOWN LIST OF OLD ASWIPS AND REMOVE ANY SEGMENTS NOT USED OVER ! "RESIDENCES" RESIDENCES PERIODS FROM ACTIVE LIST ! asmask=ASWIP&(\ASSHR); ! ONLY PRIVATE SEGMENTS %CYCLE I=MAXRESIDENCES-1,-1,0 asmask=asmask&OLD ASWIPS(I) %IF I>4<<20>>8 %FINISH %IF context_cputimer<0 %THEN w1=0 %ELSE W1=CONTEXT_CPUTIMER>>12 W1=FLAG<<28!((ACNT_LTIME<<10-W1)&X'FFFFFFF') PVAD0=RTV(RAD0) AD=INTEGER(PVAD0); ! FILE RELATIVE OFFSET OF NEXT RECORD %IF AD>12)*4)&X'7FFFFFC0' %ELSE RAD1=SHORTINTEGER(J+(ad>>12)*2)>>4<<20>>8 %FINISH PVAD1=RTV(RAD1+ad&x'fff') INTEGER(PVAD1)=W1 INTEGER(PVAD1+4)=PARAM *spka_16(0); ! set key of 1 %FINISH J=RTV(-1); ! CLEAR THE RTV ENTRY %END %FINISH %ROUTINE CHACCESS(%INTEGER ASP) !*********************************************************************** !* REVISES ACCESS ON ONE SEGMENT (INDEXED BY ASP) * !* MAY INVOLVE CHANGING KEYS ON STORE PAGES * !* IF KEYS CHANGED USED AND REFERENCED BITS MUST BE PRESERVED * !*********************************************************************** %RECORD (CBTF) %NAME CBT %INTEGER PTVAD,VSSEG,VSEPAGE,SH,CBTP,KEY,BIT,I,PTAD,MASK,ASI,SEGLEN VSSEG=ASEG(ASP) PTAD=LST(VSSEG) PTVAD=ASPTVAD(ASP); ! virtual address of page table %IF XA=YES %THEN SEGLEN=PTAD&15 %ELSE %IF XA=AMDAHL %THEN SEGLEN=PTAD>>28 %ELSE SEGLEN=0 %FOR ASI=0,1,SEGLEN>>1 %CYCLE MASK=AS(ASI,ASP) CBTP=SST(VSSEG)+ASI CBT==CBTA(CBTP) KEY=X'F0' BIT=(CBT_TAGS&READ ONLY)<<3; ! xa protect bit KEY=KEY!!(BIT>>5); ! key to E for read only pages VSEPAGE=32*ASI-1 %WHILE MASK#0 %CYCLE SH=0 SH=SH+1 %AND MASK=MASK<<1 %WHILE MASK>0 MASK=MASK<<1 VSEPAGE=VSEPAGE+SH+1 ! ! The XA code below has been altered; the original remains as a comment. ! This is pending changes in Director to handle protected pages XA-style. ! I=VSSEG<0 ASP=ASP+1 ASMASK=ASMASK<<1 VSSEG=ASEG(ASP) PTAD=LST(VSSEG) %IF XA=YES %THEN SEGLEN=PTAD&15 %ELSE %IF XA=AMDAHL %THEN SEGLEN=PTAD>>28 %ELSE SEGLEN=0 %FOR ASI=0,1,SEGLEN>>1 %CYCLE VSEPAGE=32*ASI-1 EPMASK=AS(ASI,ASP) %WHILE EPMASK#0 %CYCLE; ! FOR EACH ACTIVE PAGE VSEPAGE=VSEPAGE+1 %AND EPMASK=EPMASK<<1 %WHILE EPMASK>0 VSEPAGE=VSEPAGE+1 EPMASK=EPMASK<<1 ! ! THIS SEQUENCE WHICH OCCURS SEVERAL TIMES WITH MINOR VARIATIONS SETS MARK TO THE ! READ&CHANGED MARKERS FOR THE PAGE DEFINED BY VSSEG&VSEPAGE. IT ENABLES THE ! MARKS TO BE RESET AND/OR THE THE PAGE TABLE ENTRY REMOVED. PTAD IS ! THE LST ENTRY FOR VSSEG ! I=VSSEG<>12 j=j-((j//maxas)*maxas) asb=Ltopbit>>j %IF monlevel&4#0 %THEN perform_fdeact=perform_fdeact+1 %FINISH %ELSE %START asb=ASWIP %CYCLE J=0,1,MAX RESIDENCES K=asb&OLD ASWIPS(J); ! BITS IN K FOR SEGMENTS THAT ! HAVE BEEN INACTIVE J RESIDENCIES %IF K=0 %THEN %EXIT; ! LEAVING OLDEST IN I asb=K %REPEAT %FINISH DEACTIVATE(asb) %END !----------------------------------------------------------------------- %ROUTINE RETURN PTS !*********************************************************************** !* RETURN ALL THE EPAGES USED FOR PAGE TABLES. THE LIST HEADED BY * !* "PTP" AND LINKED VIA THE STORE TABLE * !*********************************************************************** %INTEGER I %FOR I=LSTACKLEN+1,1,NEXTPTP-1 %CYCLE %IF XA=YES %THEN LCTABLES_LCPTABLE(I)=-1 %ELSE LCTABLES_LCHPTABLE(I)=-1 %REPEAT ASPTVAD(I)=-1 %FOR I=0,1,MAXAS POUT_DEST=X'60000'; ! DACT=0 DO YOUR OWN SEMAING %WHILE PTP#0 %CYCLE POUT_P2=PTP STORE(PTP)_USERS=0 PTP=STORE(PTP)_LINK %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER1 %FINISH RETURN EPAGE(POUT) %IF MONLEVEL&12=12 %THEN %START *STPT_TIMER2 RETIT=RETIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 RETCALLN=RETCALLN+1 %FINISH %REPEAT %END !----------------------------------------------------------------------- %INTEGER %FN FIND PROCESS !*********************************************************************** !* BY SEARCHING THE PROCESS LIST. USED FOR RELAY SERVICES * !*********************************************************************** %STRING (6) USER %INTEGER I,J,K,DACT,INCAR %RECORD (CONTEXTF) %NAME CONTEXT CONTEXT==LCTABLES_CONTEXTS(PROC_STACK) USER=STRING(ADDR(CONTEXT_GR(0))); ! IN OLD GR0&1 J=CONTEXT_GR(2) INCAR=CONTEXT_GR(1)&255; ! LAST BYTE = INCARNATION %IF 1<=J<=3 %THEN %START K=LOCSN0+J*MAXPROCS DACT=ALLOUTP_DEST&X'FFFF' %UNLESS J=3 %AND (DACT=0 %OR DACT=X'FFFF') %THEN %START %CYCLE I=1,1,MAXPROCS-1 %IF USER=PROCA(I)_USER %AND PROCA(I)_INCAR=INCAR %THEN ALLOUTP_DEST=(I+K)<<16!DACT %AND %RESULT=I %REPEAT %FINISH %FINISH ALLOUTP_DEST=0 %RESULT=0 %END !----------------------------------------------------------------------- %ROUTINE WAIT(%INTEGER DACT,N) POUT_DEST=X'A0002' POUT_SRCE=0 POUT_P1=ME!DACT POUT_P2=N PON(POUT) %END %if XA#YES %then %start %ROUTINE BASM(%INTEGER EINSTN) !*********************************************************************** !* EMULATES BSM(0B) AND BASSM(0C) XA INSTRUCTIONS ON AMDAHL * !*********************************************************************** %INTEGER OP,R1,R2,DESTAD,DESTMODE,CURRMODE,X OP=EINSTN>>8 R1=EINSTN>>4&15 R2=EINSTN&15 DESTAD=CONTEXT_GR(R2) DESTMODE=DESTAD>>31 CURRMODE=(CONTEXT_PSW0<<4)&X'80000000' ! %IF R1#0 %START; ! R1 TO SAVE MODE AND-OR ADDRESS %IF OP=X'0B' %THEN X=CONTEXT_GR(R1) %ELSE X=CONTEXT_PSW1 CONTEXT_GR(R1)=(X&X'7FFFFFFF')!CURRMODE %FINISH %IF R2#0 %START; ! NEW MODE AND ADDRESS TO BE SET CONTEXT_PSW0=CONTEXT_PSW0&X'F7FFFFFF'!(DESTMODE<<27) %IF DESTMODE=0 %THEN X=X'FFFFFF' %ELSE X=X'7FFFFFFF' CONTEXT_PSW1=DESTAD&X %FINISH %END %INTEGER %FN DXR(%LONG %LONG %REAL %NAME TOP, %LONG %LONG %REAL BOTTOM) %INTEGER %NAME PSW2 %INTEGER OLD,NEW %LONG %REAL X %LONG %LONG %REAL APPROX,CORRN *BASR_1,0; *USING_1 *LA_2,; *ST_2,NEW *DROP_1 PSW2==INTEGER(ADDR(PAGE0_PE NEW PSW)+4) OLD=PSW2; PSW2=NEW X=BOTTOM APPROX=1.0/X CORRN=2.0-APPROX*BOTTOM APPROX=APPROX*CORRN CORRN=2.0-APPROX*BOTTOM APPROX=APPROX*CORRN CORRN=2.0-APPROX*BOTTOM APPROX=APPROX*CORRN TOP=TOP*APPROX PSW2=OLD %RESULT=0 FAIL: PSW2=OLD %RESULT=PAGE0_PE CODE&127 %END %finish !----------------------------------------------------------------------- %END !----------------------------------------------------------------------- !----------------------------------------------------------------------- %END !*********************************************************************** !* THESE THREE ROUTINES ARE NOW IN DIRECTOR (text kept for ref only)* !*********************************************************************** %if xa=2900 %Start %EXTERNAL %INTEGER %FN REQUEST INPUT(%INTEGER OUTPUT POSN,TRIGGER POSN) %UNLESS IOSTAT_OUTBUFLEN>0 %AND 0<=OUTPUT POSN0 %AND %C 0<=TRIGGER POSN0 %AND 0<=OUTPUT POSN