! %include "ercc07:ibmsup_page0" ! ! These const integers define sizes and layout of important tables ! they have to be here to be global to all routines including I/O ones ! %constlonginteger DISAWAIT=PSW0!X'2000000000000' %constlonginteger ALLOW INTS=x'0306000000000000' %constlonginteger ONE SECOND=x'00000000F4240000' ! %ownlonginteger PSW,WPSW,L ! %include "ercc07:ibmsup_lcform2s" ! %externalintegerfnspec REQUEST INPUT(%integer OUTPUT POSN,TRIGGER POSN) %externalintegerfnspec REQUEST OUTPUT(%integer OUTPUT POSN,TRIGGER POSN) %externalintegerfnspec CHANGE CONTEXT %externalroutine SUP01 !----------------------------------------------------------------------- %ownstring (3) SUPID="01A" !--------------------- ! EMAS/370 vsn 1A ! %conststring (3) CHOPID="01A"; ! EARLIEST COMPATABLE CHOPSUPE !----------------------------------------------------------------------- %include "ercc08:comf370" %include "ercc08:page0f" %constinteger EPAGESHIFT=12; ! 4*1024==1<<12 !----------------------------------------------------------------------- ! MISC. ROUTINE SPECS %externalstringfnspec HTOS(%integer N,PL) %externalstring (15) %fnspec STRINT(%integer N) %externalstring (8) %fnspec STRHEX(%integer N) %externalstring (63) %fnspec STRSP(%integer N) %externalroutinespec PKMONREC(%string (20) TEXT, %record (PARMF) %name P) %externalroutinespec MONITOR(%string (63) S) %externalroutinespec MOVE(%integer LEN,FROM,TO) %externalroutinespec NDIAG %alias "S#NDIAG"(%integer PC,LNB,FAULT,XTRA) %externalroutinespec OPMESS(%string (63) S) %externalroutinespec DISPLAY TEXT(%integer SCREEN,LINE,CHAR, %string (41) S) %externalroutinespec UPDATE TIME %externalroutinespec DPONPUTONQ(%record (PARMF) %name P) %externalroutinespec DUMP TABLE(%integer TABNO,ADR,LEN) %if MONLEVEL&4#0 %start %longintegername IDLEIT,NOWORKIT,LCIT,FLPIT,BLPIT,PTIT,PDISCIT,RETIT,AMIT %integername IDLEN,NOWORKN,LCN,FLPN,BLPN,PTCALLN,PDISCCALLN,RETCALLN, AMCALLN %finish %shortintegername FSTASL,BSTASL %integer I,J,K,FREEEPAGES,SHAREDEPS,UNALLOCEPS,OVERALLOC,MAXP4PAGES,P4PAGES, SXPAGES,NPQ,OLDLNB,IDLE,DONT SCHED,MPLEVEL,PAGEFREES,DCLEARS,GETEPN, PREEMPTED,MAX OVERALLOC,SNOOZTIME %longinteger L %string (3) STRPROC !----------------------------------------------------------------------- ! CONFIGURATION DECLARATIONS !----------------------------------------------------------------------- %constintegerarrayname SEG TAB=SEGTABVA %if XA=YES %thenstart %integerarrayformat PTF(0:63) %finishelsestart %shortintegerarrayformat PTF(0:63); ! page table format %finish %record (CONTEXTF) LC ICONTEXT; ! initial Local controller context !----------------------------------------------------------------------- ! STORE TABLE ETC. DECLARATIONS %recordformat STOREF(%shortinteger FLAGS,USERS,LINK,BLINK,FLINK) %constrecord (STOREF) %arrayname STORE=STORE0AD; ! one record per page %constinteger OVERALLOC PERCENT=25 %constinteger STOREFSIZE=10; ! size of element of store array %externalinteger STORE SEMA=-1 %integer SPSTOREX; ! for keeping emergency spare page !----------------------------------------------------------------------- ! ACTIVE MEMORY TABLE DECLARATIONS %constinteger MIN RESIDENCES=3,MAXRESIDENCES=15; ! FOR AMT TIMEOUTS %owninteger RESIDENCES=MAXRESIDENCES; ! ADJUSTED DOWN AS DRUM FILLS %if XA=NO %thenstart %constinteger MAXAMTAK=32 %constinteger MAXAMTDDK=64 %else %constinteger MAXAMTAK=MAXPROCS//2 %constinteger MAXAMTDDK=MAXPROCS %finish %recordformat AMTF(%integer DA, %shortinteger DDP,USERS,LINK, %byteinteger LEN,OUTS) ! DA : DISC ADDRESS ! DDP : AMTDD POINTER ! LINK : COLLISION LINK ! USERS : NO OF USERS OF THIS BLOCK ! LEN : BLOCK LENGTH IN EPAGES ! OUTS : NO OF PAGE-OUTS OF ! PAGES IN THIS BLOCK IN PROGRESS %constinteger AMTFLEN=12 %constrecord (AMTF) %arrayname AMTA=AMTASEG<>2) %integerarrayname PROC PICT; ! SPACE FOR PROCESS PICTURE PROC PICT==ARRAY(COM_PROC PICT AD,PROC PICTF) PROC PICT(0)=OPERSPACE; ! FIRST WORD=LENGTH OF REM !----------------------------------------------------------------------- ! LOCAL CONTROLLER DECS ETC. %routinespec LOCAL CONTROL %routinespec GLOBAL CONTROL %ownintegerarrayformat LSTF(0:LSTLEN-1) %owninteger TIMESLICE=X'4000'; ! 16384 MICROSECS %owninteger OUT18CHARGE=X'800'; ! CHARGE FOR OUT 18 =8 MILLESECS %owninteger OUT18INS; ! CHARGE *INS RATE %if XA=AMDAHL %start %constbyteinteger API=x'0C' %finishelsestart %constbyteinteger API=X'04' %finish %ownbyteinteger ALLOW PERI INTS=API; ! changed in schedule - act 0 %ownbyteinteger MASKPX=API; ! mask peri & external ints ! COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE ! %if COM_TSLICE>0 %then TIMESLICE=COM_TSLICE//COM_ITINT OUT18CHARGE=TIMESLICE>>3; ! ONE EIGHTH OF TSLICE OUT18INS=OUT18CHARGE*COM_INSPERSEC*COM_ITINT//1000 ! ! Set up kernel context ! *mvi_640(0),0; ! flag byte.... ! ... 0 = executing in kernel ! ff = executing in LC or user *stm_4,14,656(0); ! general registers *stctl_0,11,704(0); ! control registers INTEGER(704)=INTEGER(704)!X'800'; ! enable clock comparator I=INTEGER(704) *lctl_0,0,I ! ! set up initial Local Controller context ! used by create process in Schedule ! PSW=PSW0 *basr_1,0; *using_1 *la_2,; *drop_1 *st_2,PSW+4 LC ICONTEXT_PSW=PSW I=ADDR(LC ICONTEXT) *l_1,I *mvc_24(44,1),656(0); ! GRs *mvc_104(48,1),704(0); ! CRs LC ICONTEXT_GR(11)=ADDR(LC TABLES_END) LC ICONTEXT_CPU TIMER=MAX CPU TIMER ! FSTASL==STORE(0)_FLINK BSTASL==STORE(0)_BLINK SPSTOREX=0 GETEPN=0 PREEMPTED=0; ! NO PROCESS PRE-EMPTED DONT SCHED=0 FREE EPAGES=STORE(0)_LINK; ! LEFT HERE BY CHOPSUPE !----------------------------------------------------------------------- %cycle I=0,1,MAXPROCS PROCA(I)=0 %repeat I=PPINIT(NEW EPAGE) OVERALLOC=OVERALLOC PERCENT*FREE EPAGES//100; ! 25% OVERALLOCATION MAX OVERALLOC=OVERALLOC SHAREDEPS=0 UNALLOCEPS=FREEEPAGES+OVERALLOC P4PAGES=0 SXPAGES=0 MAXP4PAGES=P4PERCENT*COM_SEPGS//100 NPQ=0 IDLE=0 %if SNOOZING=YES %then SNOOZTIME=20 %begin %record (PARMF) P !----------------------------------------------------------------------- ! INITIALISE DEVIO & DISC ROUTINES P_DEST=X'300002' P_P1=COM_SLDEVTABAD P_P2=ADDR(PROC PICT(0)); ! SPACE FOR OPER PICTURE PON(P) P_DEST=X'370000' P_P1=PAGESIZE//1024 P_P2=COMMS EPAGES; ! COMMSALLOC P_P3=ADDR(PARM(0)) PON(P) P_DEST=X'200000' PON(P) ! INITIALISE SCHEDULE & ACTIVEMEM INHIBIT(3); ! HOLD PON FOR DISC LABEL READS P_DEST=X'30000' PON(P); ! PONNED TO ALLOW DISC LABEL READING ! ! CLEAR TIMING ARRAY ETC. ! %if MONLEVEL&4#0 %then CLEAR TIME P_DEST=X'A0001' P_SRCE=0 P_P1=X'B0000' P_P2=2 PON(P); ! KICK UPDATE TIME P_P1=X'360000' PON(P); ! KICK PRINTER P_P1=X'E0004' P_P2=10 PON(P); ! ACTIVE MEM P_P1=X'70004' PON(P); ! SEMAPHORE EVERY 10 SECS P_P1=X'00100000' P_P2=600 PON(P); ! KICK OVERALLOC CNTRL EVERY 10 MIN %end ! ! Enter Global controller ! GLOBAL CONTROL; ! does not return ! !----------------------------------------------------------------------- ! LCCALL: LOCAL CONTROL; ! initial call(does not return!) ! *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *slr_0,0; *bctr_0,0; *st_0,2048(0) *la_0,2989 {BAD}; *st_0,2228(0) *lpsw_2224(0); ! it just might tho! ! !--------------------------------------------------------------------- ! %routine GLOBAL CONTROL %routinespec UNQUEUE(%integername QUEUE,UNQUED SERVICE) %integer I,J,K,SELN,SESTK,KSERVICE,LSERVICE,TSERVICE %longinteger L %if MONLEVEL&4#0 %start %longinteger IT,KIT %integer IT CORRN %constinteger IINC=20; ! ins. not counted in idle %finish %integername CURPROC %switch SERVROUT(0:LOCSN0); ! KERNEL SERVICES %record (PROCF) %name PROC; ! STATUS BITS SIGNIFY AS FOLLOWS %record (SERVF) %name KSERV,LSERV,LSERVQ %integername RUNQ %record (PARMF) P ! ! !------------------------------------------------------------------------------ ! *stm_4,14,656(0); ! reset context LONGINTEGER(2224)=DISAWAIT WPSW=PSW0!ALLOW INTS ->GO; ! branch around interrupt handler ! !----------------------------------------------------------------------- ! INTERRUPT ENTRY POINTS MCINT: ! machine check *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),48(0); ! failing PSW *la_0,204 {CC}; *icm_0,4,232(0) {reason}; *st_0,2228(0) *lpsw_2224(0) !----------------------------------------------------------------------- EXINT: ! external *stm_0,1,2048(0) *basr_1,0; *using_1 *cli_640(0),0; *bc_8,; ! from kernel - context ok *cli_134(0),16; *bc_7,; ! not CPU timer... *cli_135(0),5; *bc_7,; ! ...so context switch neccessary *l_1,2052(0) *lpsw_528(0); ! -> Local Controller *drop_1 EXLC: *mvi_640(0),0; ! kernel flag *stm_2,15,2056(0); ! switch context *lm_4,14,656(0) I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_0(8,1),24(0); ! PSW *mvc_8(64,1),2048(0); ! GRs *std_0,72(1); *std_2,80(1); ! FPRs *std_4,88(1); *std_6,96(1) *stctl_0,1,104(1); ! CRs 0,1 *stpt_168(1); ! CPU timer EXK: %if MONLEVEL&4#0 %and IDLE#0 %start *stpt_KIT %if MPLEVEL+NPQ>12 %else %c IDLEIT=IDLEIT+(MAX CPU TIMER-KIT)>>12 IDLE=0 %finish *spt_MAXCPUTIMER %if PAGE0_EXT CODE=x'1004' %start; ! clock comparator *stck_l; L=L+ONE SECOND; *sckc_l; ! reset for 1 sec tick P_DEST=X'A0000' ELAPSED INT(P) %if MONLEVEL&4#0 %then TSERVICE=10 %and ->KTIMES ->KSERVE %finishelseif PAGE0_EXT CODE=x'1005' %start; ! cpu timer OPMESS("CPU timer int?") %if MONLEVEL&4#0 %then TSERVICE=1 %and ->KTIMES ->KSERVE %finish OPMESS("External int?: ".HTOS(PAGE0_EXT CODE,4)) %if MONLEVEL&4#0 %then TSERVICE=1 %and ->KTIMES ->KSERVE !----------------------------------------------------------------------- IOINT: ! peripheral *stm_0,1,2048(0) *basr_1,0; *using_1 *cli_640(0),0; *bc_8,; ! from kernel - context ok *drop_1 *mvi_640(0),0 *stm_2,15,2056(0); ! switch context *lm_4,14,656(0) I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_0(8,1),56(0); ! PSW *mvc_8(64,1),2048(0); ! GRs *std_0,72(1); *std_2,80(1); ! FPRs *std_4,88(1); *std_6,96(1) *stctl_0,1,104(1); ! CRs 0,1 *stpt_168(1); ! CPU timer IOK: %if MONLEVEL&4#0 %and IDLE#0 %start *stpt_KIT %if MPLEVEL+NPQ>12 %else %c IDLEIT=IDLEIT+(MAX CPU TIMER-KIT)>>12 IDLE=0 %finish *spt_MAXCPUTIMER P_DEST=3 P_P1=PAGE0_IO ADDR P_P2=PAGE0_CSW1 P_P3=PAGE0_CSW2 I=BYTEINTEGER(COM_STEER INT+P_P1) P_P4=I; ! dev slot %if I<128 %start DISC(P) %if MONLEVEL&4#0 %then TSERVICE=34 %finishelseif I#255 %start DEVIO(P) %if MONLEVEL&4#0 %then TSERVICE=58 %finishelseif PAGE0_IO ADDR&255=0=PAGE0_CSW %start; ! CAI (channel available int.) P_P4=-1 %if COM_CHANNELT&(1<<(PAGE0_IO ADDR>>8))=0 %start DISC(P) %if MONLEVEL&4#0 %then TSERVICE=34 %finishelsestart DEVIO(P) %if MONLEVEL&4#0 %then TSERVICE=58 %finish %finishelsestart PKMONREC("Kernel - I/O int? :",P) %if MONLEVEL&4#0 %then TSERVICE=1 %finish %if MONLEVEL&4#0 %then ->KTIMES %else ->KSERVE ! !----------------------------------------------------------------------- !---------------------------------------- program error PEINT: *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),40(0); ! failing PSW *la_0,206 {CE}; *icm_0,4,143(0) {code}; *st_0,2228(0) *lm_4,14,656(0) *la_11,4088(11) NDIAG(-2,0,SHORTINTEGER(142),0) *lpsw_2224(0) ! !---------------------------------------- svc SVCINT: *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *mvc_2048(8,0),32(0); ! failing PSW *la_0,10 {0A}; *icm_0,4,139(0) {code}; *st_0,2228(0) *lpsw_2224(0) ! !---------------------------------------------------------------------------- SWERR: ! software detected error *stm_0,15,2056(0) *std_0,2120(0); *std_2,2128(0); *std_4,2136(0); *std_6,2144(0) *stctl_0,15,2152(0) *stpt_2216(0) *slr_0,0; *bctr_0,0; *st_0,2048(0) *la_0,3358 {D1E}; *st_0,2228(0) *lpsw_2224(0) ! !---------------------------------------------------------------------------- ! GO: ! set up interrupt PSWs ! *la_1,; *st_1,I PAGE0_EXT NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_SVC NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_PE NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_MC NEW PSW=PSW0!I *la_1,; *st_1,I PAGE0_IO NEW PSW=PSW0!I ! *la_1,; *st_1,I; ! s/w error PSW LONGINTEGER(512)=PSW0!I ! *basr_1,0; *using_1; ! Local Controller exit PSW *la_2,; *st_2,I; *drop_1 LONGINTEGER(544)=PSW0!I ! *spt_MAXCPUTIMER *stck_L; L=L+ONE SECOND; *sckc_L; ! 1 second clock tick ! CURPROC==COM_CURPROC CURPROC=0 KSERVICE=0 KSERV==SERVA(0) LSERV==KSERV; ! Initialise pointers. Here after ! address field only update ! in assembler sequences %if MONLEVEL&4#0 %start IT CORRN=1+1024*IINC//(COM_INSPERSEC*COM_ITINT) %finish !----------------------------------------------------------------------- ! SERVICE LOOPS KSERVE: ! KERNEL SERVICES *spt_MAXCPUTIMER ! *ssm_ALLOWPERIINTS *ssm_MASKPX; ! mask peri & external %if MULTI OCP=YES %start *basr_2,0; *using_2 *slr_1,1; *lr_0,1; *bctr_0,0 *l_3,MAINQSEMA *cs_0,1,0(3); *bc_8,; *drop_2 SEMALOOP(MAINQSEMA) MQS1: %finish KSKIP: %if KSERVICE!KERNELQ=0 %thenstart %if CURPROC#0 %thenstart ! PROC MAPPED AT LAST LSERVE %if RUNQ1#0 %and PREEMPTED=0 %and PROC_RUNQ=2 %start PREEMPTED=CURPROC RUNQ==RUNQ1 ->LSERVE; ! PREMPTED LOWPRIO FOR HIGHPRIO %finish KACT: ! activate direct kernel->user %if MULTI OCP=YES %then MAINQSEMA=-1 %if MONLEVEL&4#0 %start %if PROC_STATUS&4#0 %then BLPN=BLPN+1 %else FLPN=FLPN+1 %finish I=PROC_LSTAD %if XA=YES %then I=I!X'14' %else I=I!14<<24 *lctl_1,1,I; ! segment table length/origin I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *mvc_2048(8,0),0(1); ! PSW to page 0 *ld_0,72(1); *ld_2,80(1); ! FPRs *ld_4,88(1); *ld_6,96(1) *lctl_0,1,104(1); ! CRs 0,1 *spt_168(1); ! CPU timer *lm_0,15,8(1); ! GRs *mvi_640(0),255; ! kernel flag *lpsw_2048(0); ! to Local Controller or user %finish %if RUNQ1#0 %then RUNQ==RUNQ1 %and ->LSERVE %if PREEMPTED#0 %start; ! RESUME PREMPTED PROCESS CURPROC=PREEMPTED LSERVICE=CURPROC+LOCSN0 LSERV==SERVA(LSERVICE) PREEMPTED=0 PROC==PROCA(CURPROC) ->KACT %finish %if RUNQ2#0 %then RUNQ==RUNQ2 %and ->LSERVE ! ! No process needs CPU. Enter and time the idle loop ! For multi processors other CPU can generate work ! %if MULTI OCP=YES %then MAINQSEMA=-1 %if MONLEVEL&4#0 %thenstart %if MPLEVEL+NPQKSKIP %if KSERVICE>LOCSN1 %start; ! SUSPEND REPLY I=(KSERVICE-LOCSN0)&(MAXPROCS-1)+LOCSN1 SERVA(I)_P=SERVA(I)_P!X'80000000' I=I+(LOCSN2-LOCSN1) SERVA(I)_P=SERVA(I)_P!X'80000000' I=I+(LOCSN3-LOCSN2) SERVA(I)_P=SERVA(I)_P!X'80000000' P_DEST=X'30007'; ! RESCHEDULE LOCAL CONTROLLER P_SRCE=0 P_P1=I-LOCSN3 SCHEDULE(P) TSERVICE=3 ->KTIMES %finish %if MULTI OCP=YES %then MAINQSEMA=-1 SUPPOFF(KSERV,P) ->SERVROUT(KSERVICE) !----------------------------------------------------------------------- ! SERVICE ROUTINE CALLS SERVROUT(1): SNOOZTIME=P_P1; ->KEXIT SERVROUT(2): DEADLOCK; ->KEXIT SERVROUT(3): SERVROUT(15): SCHEDULE(P); ->KEXIT SERVROUT(4): PAGETURN(P); ->KEXIT SERVROUT(5): GET EPAGE(P); ->KEXIT SERVROUT(6): RETURN EPAGE(P); ->KEXIT SERVROUT(7): SEMAPHORE(P); ->KEXIT SERVROUT(8): SERVROUT(14): ACTIVE MEM(P); ->KEXIT SERVROUT(9): ! ONLY FOR MONITORING %if MONLEVEL&X'3C'#0 %then TIMEOUT; ->KEXIT SERVROUT(10): ELAPSEDINT(P); ->KEXIT SERVROUT(11): UPDATE TIME; ->KEXIT SERVROUT(12): DPONPUTONQ(P); ->KEXIT SERVROUT(16): OVERALLOC CONTROL; ->KEXIT SERVROUT(32): DISC(P) ->KEXIT SERVROUT(33): PDISC(P); ->KEXIT SERVROUT(36): SERVROUT(37): BMOVE(P); ->KEXIT SERVROUT(48): DEVIO(P); ->KEXIT SERVROUT(49): TAPE(P); ->KEXIT SERVROUT(50): OPER(P); ->KEXIT SERVROUT(51): LP ADAPTOR(P); ->KEXIT SERVROUT(52): %if CRFITTED=YES %then CR ADAPTOR(P) %and ->KEXIT %else ->INVALID SERVROUT(53): %if CPFITTED=YES %then CP ADAPTOR(P) %and ->KEXIT %else ->INVALID SERVROUT(54): PRINTER(P); ->KEXIT SERVROUT(55): COMMS CONTROL(P); ->KEXIT SERVROUT(56): %if MONLEVEL&256#0 %then COMBINE(P) %and ->KEXIT %else ->INVALID SERVROUT(57): MK1FEADAPTOR(P); ->KEXIT SERVROUT(61): BMREP(P); ->KEXIT SERVROUT(62): COMREP(P); ->KEXIT SERVROUT(63): ! DELAYED RELAY I=P_DEST&X'FFFF'; ! THE DELAY P_DEST=P_P6 DPON(P,I) ->KEXIT SERVROUT(*): ->INVALID !----------------------------------------------------------------------- KEXIT: %if MONLEVEL&4#0 %then TSERVICE=KSERVICE KTIMES: ! RECORD SERVICE ROUTINE TIMES %if MONLEVEL&4#0 %thenstart *stpt_L IT=(MAX CPU TIMER-L)>>12+IT CORRN PERFORM_SERVIT(TSERVICE)=IT+PERFORM_SERVIT(TSERVICE) PERFORM_SERVN(TSERVICE)=PERFORM_SERVN(TSERVICE)+1 %finish ->KSERVE !----------------------------------------------------------------------- LINVALID: ! LOCAL CNTRL NOT RESIDENT CURPROC=0 SUPPOFF(LSERV,P) LSERV_P=LSERV_P&X'BFFFFFFF'; ! remove executing bit %if MULTI OCP=YES %then MAINQSEMA=-1; ! & drop thru for msg INVALID: ! invalid service called PKMONREC("INVALID POFF:",P) ->KSERVE !----------------------------------------------------------------------- LSERVE: ! Local Controller services UNQUEUE(RUNQ,LSERVICE) LSERV==SERVA(LSERVICE) ! ! L-C is only inhibitied before process start and after stopping ! so the logically necessary test for inhibition can be omitted ! unless codeing elsewhere is changed. code left as comment as ! a reminder ! ! I=LSERV_P&X'BFFFFFFF'; ! without "executing" bit ! %if I<=0 %then LSERV_P=I %and ->KSKIP;! INHIBITED CURPROC=LSERVICE-LOCSN0 PROC==PROCA(CURPROC) %if PROC_ACTIVE#255 %then ->LINVALID %if MULTI OCP=YES %then MAINQSEMA=-1 ! ! To activate to Local Controller set the segment table from the ! LSTAD word in the process list then load the context from LC TABLES ! %if MONLEVEL&4#0 %thenstart LCN=LCN+1 %finish I=PROC_LSTAD %if XA=YES %then I=I!X'14' %else I=I!14<<24 *lctl_1,1,I; ! segment table length/origin *ptlb_0; ! just in case I=ADDR(LC TABLES_CONTEXTS(LC TABLES_CUR CONTEXT)) *l_1,I *lctl_0,1,104(1); ! CRs 0,1 *spt_168(1); ! CPU timer *lm_4,14,24(1); ! GRs *mvi_640(0),255; ! kernel flag *lpsw_0(1); ! to Local Controller ! !----------------------------------------------------------------------- LCEXIT: ! Local Controller returns to here ! ! Local Controller has saved any context ! *lm_4,14,656(0); ! Kernel GRs *spt_MAXCPUTIMER *mvi_640(0),0; ! kernel flag ! CURPROC=0 %if MULTI OCP=YES %start *basr_2,0; *using_2 *slr_1,1; *lr_0,1; *bctr_0,0 *l_3,MAINQSEMA *cs_0,1,0(3); *bc_8,; *drop_2 SEMALOOP(MAINQSEMA) MQS2: %finish LSERV_P=LSERV_P&X'BFFFFFFF'; ! remove "executing" bit ! ! If the process is not suspended there will be more parameters for it ! and it must be requeued. Note that the process may have changed ! its runq by transitions made on the fly! ! %if LSERV_P>0 %thenstart %if PROC_RUNQ=1 %then RUNQ==RUNQ1 %else RUNQ==RUNQ2 %if RUNQ=0 %then LSERV_L=LSERVICE %elsestart LSERVQ==SERVA(RUNQ) LSERV_L=LSERVQ_L LSERVQ_L=LSERVICE %finish RUNQ=LSERVICE %unless PROC_STATUS&3#0 %and RUNQ#0 %else *lctl_1,1,708(0); ! l-c may page out revert to kernal pst %finish %if MULTI OCP=YES %then MAINQSEMA=-1 ->KSERVE !----------------------------------------------------------------------- %routine UNQUEUE(%integername QUEUE,UNQUED SERVICE) !*********************************************************************** !* UNQUEUES A SERVICE FROM MAIN OR RUN QUEUES AND MARKS IT * !* AS BEING EXECUTED * !*********************************************************************** %integer SERVICE; ! LOCAL COPY OF UNQUED SERVICE %record (SERVF) %name SERVQ; ! MAPPED ON TO SERVICE AT BACK OF Q %record (SERVF) %name SERV; ! FOR UNQUED SERVICE SERVQ==SERVA(QUEUE); ! BACK OF Q. L POINTS TO FRNT SERVICE=SERVQ_L; ! SERVICE TO UNQUEUE SERV==SERVA(SERVICE) SERV_P=SERV_P!X'40000000'; ! MARK AS UNDER EXECUTION %if SERVICE=QUEUE %then QUEUE=0 %else SERVQ_L=SERV_L SERV_L=0 UNQUED SERVICE=SERVICE %end %end; ! OF GLOBAL CONTROLLER %routine SCHEDULE(%record (PARMF) %name P) !*********************************************************************** !* ACTIVITY 0 : INITIALISE * !* ACTIVITY 1 : CREATE FOREGROUND PROCESS * !* ACTIVITY 2 : REPLY FROM CREATE PROCESS * !* ACTIVITY 3 : OUT OF EPAGES FROM LOCAL CONTROLLER * !* ACTIVITY 4 : OUT OF TIME SLICES FROM LOCAL CONTROLLER * !* ACTIVITY 5 : SUSPEND PROCESS * !* ACTIVITY 6 : TRY AND LOAD FURTHER PROCESS * !* ACTIVITY 7 : UNSUSPEND PROCESS * !* ACTIVITY 8 : DESTROY PROCESS * !* ACTIVITY 9 : REPLY FROM PAGE-IN OF LOCAL CONTROLLER STACK * !* ACTIVITY 10: MORE EPAGES ON THE FLY ? * !* ACTIVITY 11: MORE TIME ON THE FLY ? * !* ACTIVITY 12: SNOOZING HAS TIMED OUT * !* ACTIVITY 13: RESCHEDULE ALL RESIDENT TO FREE SMAC * !* ACTIVITY 14: DEADLOCK RECOVERY * !* ACTIVITY 15: UPDATE OPER DIPLAY * !* ACTIVITY 16: CREATE BACKGROUND JOB * !* ACTIVITY 17: START OR RESTART DIRECT * !* ACTIVITY 18: SUSPEND ON FLY? * !*********************************************************************** %routinespec PARE EPAGES %routinespec ONPQ %constinteger PRATMAX=255,PRIQS=5 %constbyteintegerarray PRAT(0:PRATMAX)= %c 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,4,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2, 1,1,2,1,3,1,1,2,1,1,2,1,1,5,1,2,1,1,2,1,1,1,2,1,1,3,1,1,2,1,1,2 %owninteger PRATP=0,SCHTICKS=0 !----------------------------------------------------------------------- ! PRIORITY QUEUE ARRAY ETC. %ownbyteintegerarray PQ(1:MAXPROCS)=0(MAXPROCS) %ownbyteintegerarray PQH(1:PRIQS)=0(PRIQS); ! NUMBER OF PRIORITIES=PRIQS %ownbyteintegerarray PQN(1:PRIQS)=0(PRIQS) %if MONLEVEL&1#0 %thenstart %owninteger SUSPN=0 %conststring (2) %array STRPN(1:PRIQS)="P1","P2","P3","P4","P5" %finish %conststring (16) %array STARTMESS(0:3)=" PROCESS CREATED", " : SYSTEM FULL"," : NO AMT"," : PROCESS RUNNG" %integer SRCE,ACT,PROCESS,PTY,LSTAD,LLSTVAD,LSTACKDA,DCODEDA,DSTACKDA,DGLADA, XEPS,OLDCATSLOT,NEWCATSLOT,INCAR,LCDDP,I,J,K,L,LCSTX %integer LIM %string (15) USER %string (2) PSTATE %record (CATTABF) %name OLDCAT,NEWCAT %record (LCFORM) %name LLCTABLES %record (PROCF) %name PROC %switch ACTIVITY(0:20) %if MONLEVEL&2#0 %and KMON&1<<3#0 %then PKMONREC("SCHEDULE:",P) ACT=P_DEST&X'FFFF' PROCESS=P_P1 %if 0; *drop_2 SEMALOOP(SCHEDSEMA,0) SSG: %finish ->ACTIVITY(ACT&255) !----------------------------------------------------------------------- ACTIVITY(0): ! INITIALISE %if STRING(ADDR(COM_SUPVSN))COM_MAXPROCS %then OPMESS("Bad Confign") %andreturn STRING(ADDR(COM_SUPVSN))=SUPID COM_USERS=0 MPLEVEL=0 PAGEFREES=0 DCLEARS=0 %cycle I=1,1,MAXPROCS-1 PROCA(I)=0 PINH(I,X'F'); ! INHIBIT LOCSN0&1&2&3 %repeat ! ! INITIALISE LEFT-HAND OPER SCREEN ! DISPLAY TEXT(0,0,0," EMAS 370 Sup".SUPID) DISPLAY TEXT(0,0,22,STRING(ADDR(COM_DATE0)+3)) %cycle I=1,1,MAXPROCS-1 STRPROC=STRINT(I) UPDISP(I,3-LENGTH(STRPROC),STRPROC) %repeat %if MONLEVEL&1#0 %thenstart DISPLAY TEXT(0,2,0,"RQ1 RQ2 P1 P2 P3 P4 P5 Total STF Outs") DISPLAY TEXT(0,3,0," 0 0 0 0 0 0 0 0 100 0") %finish P_DEST=X'80000' ACTIVE MEM(P) %if SNOOZING=YES %or MONLEVEL&1#0 %start P_DEST=X'A0001'; ! REGULAR CLOCK TICK P_SRCE=0 P_P1=X'F000F'; ! ON SCHED ALT SERVICE NO P_P2=5; ! AT 5 SEC INTERVALS PON(P); ! FOR VIDEO & BOOTING %finish ALLOW PERI INTS=ALLOW PERI INTS!3; ! permits ints between kernel ! services now initialisation ! is completed ! ! START "DIRECT" PROCESS TAKING CARE ITS INCARNATION IS 0 ! AND THAT ALL ITS TEMP SPACE IS IN X40 EPAGES(1 SEGMENT) ! ACTIVITY(17): ! FOR DIRECTOR RESTARTS P_DEST=X'30001' P_SRCE=0; ! NO REPLY WANTED P_P1=M'DIR'!6<<24 P_P2=M'ECT'<<8; ! ENSURE INCAR=0 P_P3=COM_SUPLVN<<24!X'700'; ! LSTACKDA(NEEDS 3 EPAGES ONLY) P_P4=0; ! USE DEFAULT DIRVSN P_P5=P_P3+LSTACKLEN; ! DSTACKDA(1SEG IN CBT BUT USES LESS) P_P6=P_P3+(X'40'-8); ! DGLADA (ALLOW LAST 8 PAGES) PON(P) %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(16): ! CREATE BATCH JOB ACTIVITY(1): ! CREATE FORGROUND PROCESS ! P_P1/P2 : STRING(USER NAME) ! P_P3 : L-C STACK DISC ADDRESS ! P_P4 : DIRCODE DISC ADDRESS ! (<=0 FOR DEFAULT) ! P_P5 : DIR STACK DISC ADDRESS ! P_P6 : DIR GLA DISC ADDRESS SRCE=P_SRCE USER=P_USER INCAR=P_INCAR %if COM_USERS>=MAXPROCS-1 %then P_P1=1 %and ->STARTREP ! SYSTEM FULL PROCESS=0 %if USER="DIRECT" %then PROCESS=1 %if USER="SPOOLR" %then PROCESS=3 %if USER="VOLUMS" %then PROCESS=2 %if USER="MAILER" %then PROCESS=4 %if USER="FTRANS" %then PROCESS=5 %if PROCESS>0 %start PROC==PROCA(PROCESS) %if PROC_USER#"" %then P_P1=3 %and ->STARTREP %finishelsestart %cycle PROCESS=FIRST UPROC,1,MAXPROCS-1 PROC==PROCA(PROCESS) %if PROC_USER="" %thenexit %repeat %finish LSTACKDA=P_P3 %if P_P4<=0 %then DCODEDA=COM_DCODEDA %else DCODEDA=P_P4 DSTACKDA=P_P5 DGLADA=P_P6 P_DEST=X'80001'; ! GET AMTX FOR LOCAL CNTRLRL STACK P_SRCE=0 P_P1=0 P_P2=LSTACKDA P_P3=X'FFFF0000'!(LSTACKLEN-1); ! "NEW" EPAGES ACTIVE MEM(P) %if P_P2<=0 %then P_P1=2 %and ->STARTREP; ! NO AMT PROC_LAMTX=P_P2 COM_USERS=COM_USERS+1 PROC_USER=USER PROC_STATUS=ACT>>2; ! SET 2**2 BIT FOR BATCH PROC_ACTW0=(LSTLEN-1)<<18 PROC_INCAR=INCAR PROC_ACTIVE=0; ! SUSPENDED PROC_CATEGORY=0 %if MONLEVEL&1#0 %then SUSPN=SUSPN+1 %if MULTIOCP=YES %then SCHEDSEMA=-1 %if ACT=16 %start %for I=1,1,6 %cycle J=BYTEINTEGER(ADDR(USER)+I) %if 'A'<=J<='Z' %then J=J!32 BYTEINTEGER(ADDR(USER)+I)=J %repeat %finish UPDISP(PROCESS,4,USER) CLEAR PARMS(PROCESS+LOCSN0) CLEAR PARMS(PROCESS+LOCSN1) %unless PROCESSSTOUT !----------------------------------------------------------------------- ACTIVITY(3): ! OUT OF EPAGES NEWCATSLOT=OLDCAT_MOREP NEWCAT==CATTAB(NEWCATSLOT) PROC_CATEGORY=NEWCATSLOT ->STOUT !----------------------------------------------------------------------- ACTIVITY(10): ! MORE EPAGES ON THE FLY ? P_P1=0 NEWCATSLOT=OLDCAT_MOREP NEWCAT==CATTAB(NEWCATSLOT) XEPS=NEWCAT_EPLIM-OLDCAT_EPLIM %if XEPS<=0 %then ->WAYOUT %if OLDCAT_PRIORITY<=3 %and PROC_STATUS&HADPONFLY=0 %and %c XEPSGIVE PAGES ->WAYOUT %if XEPS>SHAREDEPS+UNALLOCEPS I=1; J=0; K=OLDCAT_PRIORITY; ! CHECK FOR HIGHER PRIORITY WK %if K=5 %then K=4; ! QUEUES 4 & 5 EQIVALENT %while IWAYOUT; ! NO: MORE URGENT WORK GIVE PAGES: ! WITHOUT BOUNCING PROC_STATUS=PROC_STATUS!HADPONFLY; ! SO HE WONT DO IT AGAIN UNALLOCEPS=UNALLOCEPS-XEPS PROC_CATEGORY=NEWCATSLOT P_P1=NEWCAT_EPLIM PROC_EPA=NEWCAT_EPLIM CONT: P_P2=NEWCAT_RTLIM P_P3=NEWCAT_STROBEI; ! SO L-C CAN DECIDE TO STROBE %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES-OLDCAT_EPLIM %if NEWCAT_PRIORITY>=4 %then P4PAGES=P4PAGES+NEWCAT_EPLIM %if NEWCAT_PRIORITY=4=OLDCAT_PRIORITY %and PROC_P4TOP4<255 %and %c PROCESS>=FIRST UPROC %then PROC_P4TOP4=PROC_P4TOP4+1 %if MONLEVEL&32#0 %then %c FLYCAT(NEWCATSLOT,OLDCATSLOT)<-FLYCAT(NEWCATSLOT,OLDCATSLOT)+1 WAYOUT: %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(4): ! OUT OF TIME NEWCATSLOT=OLDCAT_MORET PARE EPAGES ->STOUT !----------------------------------------------------------------------- ACTIVITY(11): ! MORE TIME ON THE FLY? ! BE KIND TO VOLUMS&SPOOLR P_P1=0 %if OLDCAT_PRIORITY>=4 %and P4PAGES>=MAXP4PAGES %and %c SXPAGES>(SHAREDEPS+UNALLOCEPS) %and PROCESS>=FIRST UPROC %then %c ->WAYOUT NEWCATSLOT=OLDCAT_MORET NEWCAT==CATTAB(NEWCATSLOT) %if PROC_STATUS&HADTONFLY=0 %and PQN(1)+PQN(2)=0 %then ->GIVE TIME I=1; J=0; K=NEWCAT_PRIORITY %if K=4 %then K=5; ! QUEUES 4 & 5 EQUIVALENT HERE %while I<=K %cycle J=J+PQN(I) I=I+1 %repeat %if J#0 %and PROCESS>=FIRST UPROC %then ->WAYOUT ! CANNOT ALLOW VOLS&SPOOLR MORE ! TIME IF SYSTEM IS CONFGRD ! SO ONLY 1 P4 CAN BE IN STORE %if PROCESS0 %and P4PAGES<=OLDCAT_EPLIM %then %c ->WAYOUT GIVE TIME: ! WITHOUT REQUEING PROC_STATUS=PROC_STATUS!HADTONFLY PARE EPAGES; ! AND MAP NEWCAT UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-NEWCAT_EPLIM P_P1=NEWCAT_EPLIM PROC_EPA=NEWCAT_EPLIM ->CONT !----------------------------------------------------------------------- ACTIVITY(18): ! SUSPEND ON FLY(IE WITHOUT ! PAGING WOKSET OUT)? %if SNOOZING=YES %thenstart !%if SHAREDEPS+UNALLOCEPS1 %c !%then ->WAYOUT; ! NO ! I=(PQN(1)+PQN(2))*MAXEPAGES>>1; ! PAGES NEEDED TO CLERAR QS ! ! THE NEXT CONDITION IS CRUCIAL FOR SATISFACTORY SNOOZING ! CAN NOT AFFORD IN GENERAL TO ALLOW ANYONE TO SNOOZE WHEN THERE ARE ! NOT ENOUGH FREE PAGES TO CLEAR QUEUEING INTEGERACTIVE PROCESSES ! HOWEVER IN LARGE STORE NO DRUM CONFIGURATIONS QUEUEING MAY BE ! DUE TO LARGE NUMBER OF PAGE FREES BUILDING UP. IN THESE CIRCUMSTANCES ! IT IS BETTER TO LET THIS CHAP SNOOZE TILL THING QUIETEN DOWN. ! THE BIGGER THE STORE THE TRUEUER THIS IS SO DO NOT SCALE PAGE FREES ! FOR BIGGER CORE SIZES ! %if I>FREE EPAGES+PAGE FREES %and PAGE FREES>2 %then %c ->WAYOUT NEWCATSLOT=OLDCAT_SUSP %if MONLEVEL&1#0 %thenstart SUSPN=SUSPN+1 UPDISP(PROCESS,11,"Z ") %finish I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS)) PUNINH(PROCESS,I) PROC_ACTIVE=0 PROC_STATUS=PROC_STATUS!SNOOZED PARE EPAGES PROC_EPA=NEWCAT_EPLIM UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM-PROC_EPN %if MONLEVEL&32#0 %then %c FLYCAT(NEWCATSLOT,OLDCATSLOT)<-FLYCAT(NEWCATSLOT,OLDCATSLOT)+1 MPLEVEL=MPLEVEL-1 %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES-OLDCAT_EPLIM ! PEDANTIC ! P_DEST=X'A0002'; P_SRCE=X'30012'; ! KICK ELAPSED INT P_P1=X'3000C'!PROCESS<<8 P_P2=SNOOZTIME; P_P3=PROCESS PON(P) P_P1=0; ! YES MAY SUSPEND ON FLY %finish %if NPQ#0 %then P_DEST=X'30006' %and PON(P) ->WAYOUT !---------------------------------------------------------------------- ACTIVITY(5): ! SUSPEND %if MONLEVEL&1#0 %then SUSPN=SUSPN+1 I=8!(1<<((P_SRCE-LOCSN0)//MAXPROCS)) PUNINH(PROCESS,I) PSTATE="S " %if PROC_STATUS&AMT LOST=0 %and (PROCESSSTOUT !----------------------------------------------------------------------- ACTIVITY(7): ! UNSUSPEND %if PROC_ACTIVE=255 %then ->WAYOUT; ! RACE CONDITION WITH BOOTONFLY %if MONLEVEL&1#0 %then SUSPN=SUSPN-1 %if SNOOZING=YES %and PROC_STATUS&SNOOZED#0 %start; ! PROCESS IN STORE PROC_STATUS=PROC_STATUS!!SNOOZED MPLEVEL=MPLEVEL+1 PROC_RUNQ=OLDCAT_RQTS1 %if MONLEVEL&4#0 %then PERFORM_SNOOZOK=PERFORM_SNOOZOK+1 %if MONLEVEL&1#0 %then UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) P_DEST=(PROCESS+LOCSN0)<<16!3 P_SRCE=X'30000' P_P1=OLDCAT_EPLIM P_P2=OLDCAT_RTLIM UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES+OLDCAT_EPLIM PROC_ACTIVE=255 PON(P) %if MONLEVEL&4#0 %then PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP ->WAYOUT %finish PROC_ACTIVE=255 %if OLDCAT_PRIORITY<4 %and PROC_STATUS&(STATEX+4)=STATEX %then %c SXPAGES=SXPAGES-PROC_EPN ONPQ ->LOAD !----------------------------------------------------------------------- ACTIVITY(8): ! DESTROY PROCESS MPLEVEL=MPLEVEL-1 DESTROY: UPDISP(PROCESS,4," ") COM_USERS=COM_USERS-1 PINH(PROCESS,X'F'); ! ALL PROCESS SERVICES %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES-OLDCAT_EPLIM P_DEST=X'40002'; ! PAGE-TURN OUT P_SRCE=X'30008' P_P2=0; ! REGARD AS NOT WRITTEN TO %cycle I=0,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I PON(P) %repeat P_DEST=X'80002'; ! RETURN AMTX FOR L-CNTRLR STACK P_P1=0; ! ID NOT USED P_P2=PROC_LAMTX P_P3=1; ! DESTROY FLAG PON(P) PROC=0 ->DEALL !----------------------------------------------------------------------- STOUT: ! PAGE-OUT LOCAL CONTROLLER STACK %if NEWCAT_PRIORITY=4=OLDCAT_PRIORITY %and PROC_P4TOP4<255 %and %c PROCESS>=FIRST UPROC %then PROC_P4TOP4=PROC_P4TOP4+1 %if MONLEVEL&32#0 %then %c CATREC(NEWCATSLOT,OLDCATSLOT)<-CATREC(NEWCATSLOT,OLDCATSLOT)+1 ACTIVITY(14): ! DEADLOCK RECOVERY MPLEVEL=MPLEVEL-1 P_DEST=X'40002'; ! PAGETURN/PAGE-OUT P_SRCE=X'3008A' %if PROC_STATUS&STATEX#0 %then I=LSTACKLENP %elsestart 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'D'; ! MAKE END "NEW" PON(P); ! NO REPLIES %repeat %if OLDCAT_PRIORITY>=4 %then P4PAGES=P4PAGES-OLDCAT_EPLIM PROC_RUNQ=0 %unless ACT=5 %then ONPQ; ! UNLESS SUSPENEDED DEALL: ! DEALLOCATE PROCESSES EPAGES UNALLOCEPS=UNALLOCEPS+OLDCAT_EPLIM+LSTACKLEN PROC_EPA=0 !----------------------------------------------------------------------- ACTIVITY(6): ! MORE LOADS LOAD: ! LOAD FURTHER PROCESS(ES) ! ! TRY TO LOAD AS MANY WAITING ! PROCESSES AS POSSIBLE EXCEPT THAT ONLY "MAXP4PAGES" OF BIG JOBS ARE ! LOADED EXCEPT WHEN THERE ARE NO INTERACTIVE JOBS ASLEEP IN QUEUES 1-3 ! THIS COUNT IS MAINTAINED IN 'NP4L' ! %if NPQ=0 %or DONT SCHED#0 %then ->WAYOUT AGN: %cycle PTY=PRAT(PRATP) %exitif PQH(PTY)#0 PRATP=(PRATP+1)&PRATMAX %repeat %if PTY>=3 %and PAGEFREES>=40 %start; ! TOO MANY WRITEOUT PRATP=(PRATP+1)&PRATMAX; ! PASS OVER BIG JOB %if MULTIOCP=YES %then SCHEDSEMA=-1 P_DEST=X'A0002' P_P1=X'30006'; P_P2=1 PON(P); ! WAIT 1 SEC %return %finish PROCESS=PQ(PQH(PTY)) PROC==PROCA(PROCESS) OLDCATSLOT=PROC_CATEGORY OLDCAT==CATTAB(OLDCATSLOT) ! ! THE IDEA OF THE NEXT FEW LINES IS TO RESTRICT P4 JOBS TO 1 OR TO ! P4PAGES OF STORE EXCEPT WHEN THERE ARE SO FEW FOREGROUND USERS ! ASLLEEP THAT THEY WILL NOT BE INCONVENINECED. ! %if PTY>=4 %thenstart %if P4PAGES>0 %and P4PAGES+OLDCAT_EPLIM>MAXP4PAGES %and %c SXPAGES>(SHAREDEPS+UNALLOCEPS) %start %if NPQ>PQN(4)+PQN(5) %then PRATP=(PRATP-31)&PRATMAX %and ->AGN ->WAYOUT %finish %finish I=OLDCAT_EPLIM+LSTACKLEN %if I>SHAREDEPS+UNALLOCEPS %and MPLEVEL>0 %thenstart; ! NOT ENOUGH ROOM ->WAYOUT %finish PROC_EPA=OLDCAT_EPLIM UNALLOCEPS=UNALLOCEPS-I PRATP=(PRATP+1)&PRATMAX; ! TO NEXT PRIORITY Q %if PTY>=4 %then P4PAGES=P4PAGES+OLDCAT_EPLIM %if PROCESS=PQH(PTY) %then PQH(PTY)=0 %else PQ(PQH(PTY))=PQ(PROCESS) NPQ=NPQ-1 PQN(PTY)=PQN(PTY)-1 %if MULTIOCP=YES %then SCHEDSEMA=-1 ! PAGE IN LOCAL CONTROLLER STACK P_DEST=X'40001'; ! PAGETURN/PAGE-IN P_SRCE=X'30009' %if PROC_STATUS&STATEX#0 %then I=LSTACKLENP %else I=0 PQ(PROCESS)=LSTACKLEN-I; ! TO COUNT PAGE-TURN REPLIES %cycle I=I,1,LSTACKLEN-1 P_P1=PROC_LAMTX<<16!I P_P2=PROCESS<<8!I P_P3=X'10'; ! SSK 1 PON(P) %repeat %if NPQ#0 %and SHAREDEPS+UNALLOCEPS>=LSTACKLEN %start ! ROOM FOR ANOTHER? P_DEST=X'30006'; ! YES KICK OURSELVES AGAIN P_SRCE=P_DEST; ! SINCE THIS IS NOT COMMON AND PON(P); ! AND THIS SIMPLIFIES DUALS %finish %return !----------------------------------------------------------------------- ACTIVITY(12): ! SNOOZING TIMED OUT FROM ELAPSED INT %if SNOOZING=YES %and PROC_STATUS&SNOOZED#0 %start PROC_STATUS=PROC_STATUS&(\SNOOZED) PROC_ACTIVE=255 UNALLOCEPS=UNALLOCEPS+PROC_EPN-PROC_EPA MPLEVEL=MPLEVEL+1 %if MONLEVEL&4#0 %then PERFORM_SNOOZTO=PERFORM_SNOOZTO+1 %if MONLEVEL&1#0 %then SUSPN=SUSPN-1 P_DEST=(PROCESS+LOCSN0)<<16!8 P_SRCE=X'3000C' PON(P) %finish %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(13): ! RESCHEDULE ALL RESIDENT TO FREE SMAC %cycle I=1,1,MAXPROCS PROC==PROCA(I) %if PROC_USER#"" %and (PROC_ACTIVE=255 %or %c PROC_STATUS&(SNOOZED!STATEX)#0) %start P_DEST=(COM_ASYNCDEST+I)<<16 P_SRCE=X'3000D' P_P1=3; ! DUMMY ACT PON(P) %finish %repeat ->WAYOUT !----------------------------------------------------------------------- ACTIVITY(9): ! L-C STACK PAGE ARRIVED I=P_P1&X'FF'; ! EPAGE NO PROCESS=P_P1>>8&X'FF' PROC==PROCA(PROCESS) PQ(PROCESS)=PQ(PROCESS)-1 %if I=0 %then PROC_LSTAD=P_P2; ! REAL ADDR OF NEW LST %if P_P3#0 %then PROC_STATUS=PROC_STATUS!LCSTFAIL; ! FAIL FLAG ->WAYOUT %unless PQ(PROCESS)=0; ! WAIT UNTIL ALL PAGES HERE OLDCATSLOT=PROC_CATEGORY OLDCAT==CATTAB(OLDCATSLOT) %if PROC_STATUS&LCSTFAIL#0 %start; ! failed to read LC stack - destroy process PRINT STRING("Local Controller stack read fail, process ".STRINT %c (PROCESS)) ->DESTROY %finish LSTAD=PROC_LSTAD LLSTVAD=RTV(LSTAD) MOVE(LCSTKSEG*4,SEGTAB VA,LLSTVAD); ! public segments LLCTABLES==RECORD(LLSTVAD) %if XA=NO %then LIM=15<<28 %else LIM=0 LLCTABLES_SEGTABLE(LCSTKSEG)=LSTAD+(LSTLEN*4)!LIM; ! LC stack seg LLCTABLES_SEGTABLE(3)=LLCTABLES_SEGTABLE(LCSTKSEG) ! fill in page table entries ! by digging in amt and store tables LCDDP=AMTA(PROC_LAMTX)_DDP; ! DD POINTER FOR PAGE O OF LC %if PROC_STATUS&STATEX#0 %thenstart PROC_STATUS=PROC_STATUS!!STATEX %if MONLEVEL&4#0 %then PERFORM_SNOOZN=PERFORM_SNOOZN+LSTACKLENP I=LSTACKLENP %finishelse I=0 %cycle I=I,1,LSTACKLEN-1 LCSTX=AMTDD(LCDDP+I); ! store pointer ! nb page must be incore ! not all cases need to be tested K=LCSTX*PAGESIZE %if PTE SIZE=2 %then LLCTABLES_LCHPTABLE(I)<-K>>8 %else %c LLCTABLES_LCPTABLE(I)=K %repeat PROC_RUNQ=OLDCAT_RQTS1 %if MONLEVEL&1#0 %then UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) MPLEVEL=MPLEVEL+1 %if OLDCATSLOT=0 %thenstart; ! process being created %if XA=YES %then J=x'20' %else J=1 %for I=LCSTKSEG+1,1,255 %cycle; ! invalidate unused segments LLCTABLES_SEGTABLE(I)=J %repeat %for I=LSTACKLEN,1,15 %cycle; ! invalidate unused (as yet) pages %if XA=YES %then LLCTABLES_LCPTABLE(I)=-1 %else %c LLCTABLES_LCHPTABLE(I)=-1 %repeat LLC TABLES_PROCNO=PROCESS LLC TABLES_CONTEXTS(0)=LC ICONTEXT; ! LC initial context UNINHIBIT(PROCESS+LOCSN0); ! let create PON go %finishelsestart P_DEST=(PROCESS+LOCSN0)<<16!1; ! to L-C : start new residence P_SRCE=X'30000' P_P1=OLDCAT_EPLIM P_P2=OLDCAT_RTLIM ! ! If the person has used a lot of p4 time from the terminal penalise ! him by gradually reducing his residence times. If he gets time on ! the fly then he and the system will not be affected ! %if PROCESS>=FIRST UPROC %and OLDCAT_PRIORITY=4 %and %c PROC_P4TOP4>16 %then P_P2=P_P2*(300-PROC_P4TOP4)//300 PON(P) %finish %if XA=YES %then K=PROC_LSTAD!(LSTLEN//16-1) %else %c K=PROC_LSTAD!(LSTLEN//16-1)<<24 LLC TABLES_CONTEXTS(0)_CONTROLR(1)=K I=RTV(-1); ! invalidate entry %if MULTIOCP=YES %then SCHEDSEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(15): ! UPDATE OPER INFO(EVERY 5 SECS) SCHTICKS=SCHTICKS+1 %if SCHTICKS&3=0 %start; ! @EVERY 20 SECS I=1; J=0 %until J=COM_USERS %or I>MAXPROCS %cycle PROC==PROCA(I) %if PROC_USER#"" %thenstart %if I>=FIRST UPROC %and PROC_ACTIVE=3*MINSINACTIVE %and %c PROC_STATUS&X'404'=0 %start ! NOT BATCH OR DAP P_DEST=(I+LOCSN3)<<16+1 P_P1=-1; P_P2=-1 P_P3=X'01570000'; ! SEND INT W PON(P) %finish PROC_ACTIVE=PROC_ACTIVE+1 %unless PROC_ACTIVE>200 J=J+1 %finish I=I+1 %repeat %finish %if MULTIOCP=YES %then SCHEDSEMA=-1 %if MONLEVEL&1#0 %thenstart %begin %integerarray RUNQ(0:2) %if MONLEVEL&256#0 %start %integer SNOOS,PGFLT SNOOS=0; PGFLT=0 %finish %cycle I=0,1,2 RUNQ(I)=0 %repeat J=0; I=1 %until J=COM_USERS %or I>MAXPROCS %cycle PROC==PROCA(I) %if PROC_USER#"" %thenstart J=J+1 %if PROC_ACTIVE=255 %then RUNQ(PROC_RUNQ)=RUNQ(PROC_RUNQ)+1 %if MONLEVEL&256#0 %start %if PROC_STATUS&SNOOZED#0 %then SNOOS=SNOOS+1 %if PROC_STATUS&2#0 %then PGFLT=PGFLT+1 %finish %finish I=I+1 %repeat %cycle I=1,1,2 DISPLAY TEXT(0,3,I*4-3,STRINT(RUNQ(I))." ") %repeat %cycle I=1,1,5 DISPLAY TEXT(0,3,I*3+7,STRINT(PQN(I))." ") %repeat DISPLAY TEXT(0,3,27,STRINT(COM_USERS)." ") I=100*FREE EPAGES//COM_SEPGS DISPLAY TEXT(0,3,31,STRINT(I)."% ") DISPLAY TEXT(0,3,36,STRINT(PAGEFREES)." ") %if MON LEVEL&256#0 %start; ! include harvesting? HARVEST(1,0,20,COM_USERS<<24!RUNQ(1)<<16!RUNQ(2)<<8!PGFLT, PQN(1)<<24!PQN(2)<<16!PQN(3)<<8!PQN(4), PQN(5)<<24!SUSPN<<16!SNOOS<<8,PAGEFREES<<16!UNALLOCEPS, FREEEPAGES<<16) %if TRACE=YES %and TRACE EVENTS&(1<<1)#0 %finish %end %finish %return !----------------------------------------------------------------------- ACTIVITY(19): ! SET BITS IN P_P2 INTO STATUS ! OF PROCESS IN P_P1 PROC_STATUS=PROC_STATUS!P_P2 ->WAYOUT ACTIVITY(20): ! CONVERSE OF 19 PROC_STATUS=PROC_STATUS&(\P_P2) ->WAYOUT %routine PARE EPAGES !*********************************************************************** !* CHAIN BACK DOWN CATEGORY TABLE TO FIND THE BEST FIT * !* AFTER ALLOWING SOME LEEWAY * !*********************************************************************** %constinteger LEEWAY=2 %cycle NEWCAT==CATTAB(NEWCATSLOT) %if NEWCAT_LESSP=0 %or P_P2+LEEWAY>CATTAB(NEWCAT_LESSP)_EPLIM %then %c PROC_CATEGORY=NEWCATSLOT %andreturn NEWCATSLOT=NEWCAT_LESSP %repeat %end !----------------------------------------------------------------------- %routine ONPQ !*********************************************************************** !* PUT PROCESS ONTO APPROPIATE PRIORITY QUEUE AS GIVEN IN THE * !* CATEGORY TABLE. NORMALLY PROCESSES GO TO THE BACK OF QUEUE BUT * !* THEY ARE HOLDING A SEMA THEY GO TO THE FRONT * !*********************************************************************** PTY=CATTAB(PROC_CATEGORY)_PRIORITY %if PQH(PTY)=0 %then PQ(PROCESS)=PROCESS %else %c PQ(PROCESS)=PQ(PQH(PTY)) %and PQ(PQH(PTY))=PROCESS PQH(PTY)=PROCESS %unless (PROCESS=1 %or PROC_STATUS&1#0) %and PQH(PTY)#0 NPQ=NPQ+1; ! COUNT PROCESSES QUEUED PQN(PTY)=PQN(PTY)+1 %if MONLEVEL&1#0 %then UPDISP(PROCESS,11,STRPN(PTY)) %end %end !----------------------------------------------------------------------- %routine PAGETURN(%record (PARMF) %name P) !*********************************************************************** !* FOR ALL ACTS : P_P1=AMTX<<16!EPX * !* ACTIVITY 1 : "PAGE IN" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=RETURNABLE IDENTIFIER * !* : P_P3 THE KEY REQUIRED (NOT SET FOR SHRD PAGES) * !* ACTIVITY 2 : "PAGE OUT" REQUEST FROM LOCAL CONTROLLER * !* : P_P2=FLAGS (BEING THE BOTTOM 4 BITS OF STOREFLAG* !* ACTIVITY 3 : REPLY FROM "EPAGE" WITH EPAGE P_P2=STOREX * !* ACTIVITY 4 : ZERO "NEW" DISC EPAGE * !* ACTIVITY 5 : REPLY FROM DISC/WRITE * !* ACTIVITY 6 : (WAS REPLY) FROM DRUM/READ ON FAILURE ONLY * !* ACTIVITY 7 : (WAS REPLY FROM DRUM/WRITE) * !* ACTIVITY 8 : REPLY FROM ZERO DISC EPAGE * !* * !* STORE FLAGS SIGNIFY AS FOLLOWS : * !* BIT 15: PAGE HAS HAD A SINGLE BIT ERROR * !* BIT 7 : DISC TRANSFER IN PROGRESS(1)/NOT IN PROGRESS(0) * !* BIT 6 : DISC INPUT(0)/OUTPUT(1) * !* BIT 5 : NOT USED * !* BIT 4 : NOT USED * !* BIT 3 : WRITTEN TO MARKER * !* BIT 2 : NOT USED * !* BIT 1 : MAKE NEW IE DONT PAGE OUT & SUPPLY ZEROPAGE ON REREAD * !* BIT 0 : RECAPTURABLE(IF ON FREE LIST ON PAGING OUT) * !*********************************************************************** %routinespec PUSHPIT %constinteger ZEROPAGEAD=4096; ! SEG 0 PAGE 1 BOTH REAL & VIRTUAL %integer AEX,AMTX,EPX,DDX,FLAGS,STOREX,SRCE,CALL,ID,I,B,F,KEY %if MONLEVEL&12=12 %thenstart %longinteger TIMER1,TIMER2 %finish %shortintegername AMTDDDDX %record (AMTF) %name AMT %record (STOREF) %name ST %record (PARMXF) %name PP %record (PARMF) TDISC %switch ACTIVITY(0:8) %if MONLEVEL&2#0 %and KMON&1<<4#0 %then PKMONREC("PAGETURN:",P) AEX=P_P1 AMTX=AEX>>16 EPX=AEX&X'FFFF' AMT==AMTA(AMTX) DDX=AMT_DDP+EPX AMTDDDDX==AMTDD(DDX) %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish STOREX=AMTDDDDX&STXMASK ->ACTIVITY(P_DACT) !----------------------------------------------------------------------- ACTIVITY(1): ! PAGE-IN (ALLOWS PAGETURN TO BE CALLED) %if MONLEVEL&4#0 %then PERFORM_PTURNN=PERFORM_PTURNN+1 AMT_USERS=AMT_USERS+1 CALL=P_SRCE KEY=P_P3 SRCE=CALL&X'7FFFFFFF' ID=P_P2 %if STOREX=STXMASK %then ->FETCH PAGE HERE: ! EPAGE ALLOCATED ST==STORE(STOREX) ->NOTRECAP %unless ST_FLAGS=1 %and ST_USERS=0; ! RECAPTURE ST_FLAGS=0 ST_USERS=1 ST_LINK=0 F=ST_FLINK B=ST_BLINK ST_BLINK=AMTX ST_FLINK=EPX STORE(B)_FLINK=F STORE(F)_BLINK=B FREEEPAGES=FREEEPAGES-1 %if XA=YES %thenstart *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,STOREX *SLL_1,12 *L_2,KEY *SSK_2,1 %finishelsestart *L_1,STOREX; *SLL_1,12 *L_2,KEY; *SSK_2,1 *LA_1,2048(1); *SSK_2,1 %finish %if FREEEPAGES=0 %then INHIBIT(5) %if MONLEVEL&4#0 %then PERFORM_RECAPN=PERFORM_RECAPN+1 ->PAGEIN REPLY NOTRECAP: ! PAGE MUST BE SHARED %if ST_USERS=0 %thenstart; ! PAGE-OUT IN PROGRESS PAGEFREES=PAGEFREES-1 %finishelsestart SHAREDEPS=SHAREDEPS+1 %finish ST_USERS=ST_USERS+1 %if MONLEVEL&4#0 %then PERFORM_PSHAREN=PERFORM_PSHAREN+1 ! PAGE SAVED BY SHARING ! IF PAGE IS COMING IN MUST AWAIT ! ITS ARRIVAL. USE PIT LIST %if ST_FLAGS&X'C0'=X'80' %start PUSHPIT MUST WAIT: ! FOR FREE PAGE OR TRANSFER %if MULTIOCP=YES %then STORESEMA=-1 P_DEST=0; ! IF CALLED MEANS PAGE COMING %return %finish PAGEIN REPLY: ! INTACT COPY IN STORE IF ! RECAPTURED OR PAGING OUT:REPLY ! PAGE IMMEDIATELY AVAILABLE P_P1=ID; ! IDENTIFIER P_P2=STOREX*PAGESIZE P_P3=0; ! SUCCESS %if MONLEVEL&256#0 %start P_P5=ST_USERS P_P6=ST_FLAGS %finish %if MULTIOCP=YES %then STORESEMA=-1 %if CALL>0 %then P_DEST=SRCE %and P_SRCE=X'40001' %and PON(P) %return FETCH PAGE: ! ALLOCATE EPAGE %if AMTDDDDX&NEWEPBIT#0 %then I=0 %else I=1; ! CLEAR IF NEW %if FREE EPAGES>0 %then STOREX=QUICK EPAGE(I,KEY) %and ->ACT3 P_SRCE=X'40003' P_P1=AEX P_P2=I; ! =0 FOR ZEROED P_P3=KEY; ! USER KEY F NO READ PROTECTION P_P5=SRCE P_P6=ID %if LOCSN0>16<=LOCSN1 %then GET EPN=GET EPN+1 %if MULTIOCP=YES %then STORESEMA=-1 %if PAGEFREES<=1 %and GETEPN>=MPLEVEL+1-COM_NOCPS %then %c P_DEST=X'20000' %and PON(P) P_DEST=X'50000' PON(P) P_DEST=0; ! IN CASE PAGETURNED CALLED %return !----------------------------------------------------------------------- ACTIVITY(3): ! REPLY FROM GET EPAGE CALL=1; ! I.E. >0 SRCE=P_P5 ID=P_P6 ! ! THERE ARE TWO COMPLICATIONS WHICH MUST BE DEALT WITH BEFORE GOING ! ON TO SET UP THE TRANSFER. FIRSTLY WE MAY GET PAGE 0 MEANING THE SYSTEM ! HAS DEADLOCKED. PASS THIS BACK TO LOCAL CONTROLLER WITH SPECIAL FLAG ! MEANING "PLEASE DEPART AS FAST AS POSSIBLE". ! THE OTHER POSSIBILTY IS THAT MORE THAN ONE PROCESS HAS ASKED ! FOR THIS PAGE WHILE THE FIRST IS AWAITING STORE. CARE IS REQUIRED TO ! AVOID LOSING A PAGE IN THESE CIRCOMSTANCES ! %if P_P2=0 %thenstart; ! DEADLOCK PAGE ZERO P_DEST=SRCE!1; ! FAILED TO PRODUCE PAGE P_P3=-1; ! PLEASE DEPART ! AMT_USERS=AMT_USERS-1 %if MULTIOCP=YES %then STORESEMA=-1 PON(P) %return %finish %if STOREX#STXMASK %thenstart; ! PAGE HAS ARRIVED BEFORE P_DEST=X'60000'; ! RETURN EPAGE P_SRCE=X'40003' PON(P) ->HERE %finish STOREX=P_P2 ACT3: ! ENTERS HERE IF PAGE AVAILABLE ST==STORE(STOREX) ST_USERS=1 ST_LINK=0 ST_BLINK=AMTX ST_FLINK=EPX %if AMTDDDDX&NEWEPBIT#0 %thenstart; ! NEW EPAGE AMTDDDDX=STOREX; ! NOT "NEW" & NOT DRUM ST_FLAGS=8; ! "WRITTEN" %if MONLEVEL&4#0 %then PERFORM_NEWPAGEN=PERFORM_NEWPAGEN+1 ->PAGEIN REPLY %finish ! PUSHPIT AMTDDDDX=STOREX ST_FLAGS=X'80'; ! DISC->STORE TRANSIT FLAGS=X'80'; ! DISC TRANSFER NEEDED %if MULTIOCP=YES %then STORESEMA=-1 TDISC_DEST=X'210005'; ! DIRECT REPLIES TO LC TDISC_SRCE=X'80040099' TDISC_P1=AEX TDISC_P2=AMT_DA+EPX; ! DISC ADDRESS TDISC_P3=STOREX P_DEST=0 ->TRANSFER NEEDED !----------------------------------------------------------------------- ACTIVITY(6): ! WAS REPLY FROM DRUM READ !----------------------------------------------------------------------- ACTIVITY(2): ! PAGE-OUT ST==STORE(STOREX) AMT_USERS=AMT_USERS-1 ST_FLAGS<-ST_FLAGS!P_P2; ! INSERT WRITTEN ETC. MARKERS ST_USERS=ST_USERS-1 %if ST_USERS>0 %thenstart SHAREDEPS=SHAREDEPS-1 %if MULTIOCP=YES %then STORESEMA=-1 %return %finish PAGEFREES=PAGEFREES+1; ! PAGE ABOUT TO BECOME FREE %if ST_FLAGS&X'A0'#0 %then ->MUST WAIT ! PREVIOUS WRITEOUTS STILL GOING PAGEOUT: ! ACTUALLY PAGE IT OUT FLAGS=0; ! NO TRANSFER SET UP YET ! ! FIRST UPDATE DISC COPY IF PAGE HAS BEEN UPDATED. THEN CONSIDER ! WHETHER TO UPDATE OR GENERATE A DRUM COPY ! %if ST_FLAGS&X'0A'=8 %thenstart; ! \NEW&WRITTEN THEN WRITE TO DISC %if MONLEVEL&4#0 %then PERFORM_PAGEOUTN=PERFORM_PAGEOUTN+1 ST_FLAGS<-ST_FLAGS!X'C0'; ! DISC TRANSFER OUT BITS FLAGS=X'C0'; ! TRANSFER INITIATED AMT_OUTS=AMT_OUTS+1; ! AVOIDS AMT BEING DEALLOCATED TDISC_DEST=X'210006'; ! STORE->DISC TDISC_SRCE=X'80040005' TDISC_P1=AEX TDISC_P2=AMT_DA+EPX; ! DISC ADDR TDISC_P3=STOREX %finish %if FLAGS=0 %thenstart; ! NO TRANSFERS INITIATED %if ST_FLAGS&2#0 %then %c AMTDDDDX<-NEWEPBIT!STXMASK %and ST_FLAGS<-ST_FLAGS&X'8000' ->REP; ! TO RETURN EPAGE %finish ST_FLAGS<-ST_FLAGS&X'80F1' %if MULTIOCP=YES %then STORESEMA=-1 TRANSFER NEEDED: ! TO COMPLETE PAGETURN %if FLAGS&X'80'#0 %thenstart; ! DISC TRANSFER TO START %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish PDISC(TDISC) %if MONLEVEL&12=12 %thenstart PDISCCALLN=PDISCCALLN+1 *STPT_TIMER2 PDISCIT=PDISCIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish %finish %return !----------------------------------------------------------------------- ACTIVITY(4): ! ZERO "NEW" EPAGE ON DEACTIVATION %if MONLEVEL&4#0 %then PERFORM_PAGEZN=PERFORM_PAGEZN+1 %if MULTIOCP=YES %then STORESEMA=-1 FLAGS=X'80'; ! DISC WRITE INITIATED TDISC_DEST=X'210002'; ! WRITEOUT TDISC_SRCE=X'80040008'; ! REPLY TO ACT 8 TDISC_P1=AEX TDISC_P2=AMT_DA+EPX TDISC_P3=ZEROPAGEAD ->TRANSFER NEEDED !---------------------------------------------------------------------- ACTIVITY(5): ! REPLY FROM DISC/WRITE ST==STORE(STOREX) ! ! THERE ARE THREE POSSIBLE COURSES OF ACTION ON DISC FAILURE ! 1) FRIG THE USER COUNT SO IT STAYS IN CORE ! 2) TRY AGAIN (UNHELPFUL SINCE 42*8 TRIES ALREADY MADE) ! 3) DO NOTHING AND RELY ON NEXT READ FAILING ! FOR THE MOMENT FOLLOW COURSE 3 ! ST_FLAGS<-ST_FLAGS&X'803F'; ! NO DISC TRANSFER %if P_P2=4 %thenstart; ! WAS ABORTED %if MONLEVEL&4#0 %then PERFORM_ABORTN=PERFORM_ABORTN+1 ST_FLAGS<-ST_FLAGS!8; ! PUT BACK WRITTEN MARKER %finish AMT_OUTS=AMT_OUTS-1 %if ST_FLAGS&X'A0'#0 %or ST_USERS#0 %then ->MUST WAIT %if ST_FLAGS&X'E'#0 %then ->PAGEOUT REP: ! RETURN THE EPAGE ST_FLAGS<-ST_FLAGS&X'8001' %if ST_FLAGS&1=0 %start; ! NOT RECAPTURABLE AMTDDDDX<-AMTDDDDX!STXMASK %finishelsestart ST_LINK=DDX %finish P_DEST=X'60001' P_P2=STOREX PAGEFREES=PAGEFREES-1 %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish RETURN EPAGE(P) %if MONLEVEL&12=12 %thenstart RETCALLN=RETCALLN+1 *STPT_TIMER2 RETIT=RETIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish RAMTX: ! RETURN AMTX IF UNUSED %if AMT_USERS=0 %and AMT_OUTS=0 %thenstart P_DEST=X'00080003' P_P2=AMTX %if MULTIOCP=YES %then PON(P) %elsestart %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish ACTIVE MEM(P) %if MONLEVEL&12=12 %thenstart AMCALLN=AMCALLN+1 *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 PTIT=PTIT-(TIMER1-TIMER2)>>12 %finish %finish %finish %if MULTIOCP=YES %then STORESEMA=-1 %return !----------------------------------------------------------------------- ACTIVITY(7): ! WAS REPLY FROM DRUM WRITE ->REP !----------------------------------------------------------------------- ACTIVITY(8): ! REPLY FROM ZERO DISCPAGE ! IGNORE FAILURES SEE ACT 5 DCLEARS=DCLEARS-1 AMTDDDDX<-AMTDDDDX&(\NEWEPBIT); ! CLEAR NEW MARKER AMT_OUTS=AMT_OUTS-1 ->RAMTX !---------------------------------------------------------------------- %routine PUSHPIT; ! AWAIT TRANSFER USING THE PIT LIST I=NEWPPCELL PP==PARM(I) PP_DEST=SRCE PP_SRCE=X'40003' PP_P1=ID PP_P2=STOREX*PAGESIZE PP_P3=0; ! SUCCESS FLAG PP_LINK=ST_LINK ST_LINK=I %end %end !---------------------------------------------------------------------- %integerfn QUICK EPAGE(%integer ZEROED,KEY) !*********************************************************************** !* CAN BE CALLED BY ANYONE HOLDING STORESEMA TO GET THE NEXT FREE * !* NEXT FREE EPAGE. GIVES THE STORE INDEX OR -1 * !*********************************************************************** %record (STOREF) %name ST %integer I,STAD,STOREX,RA %if FREE EPAGES=0 %thenresult=-1 STOREX=FSTASL ST==STORE(STOREX) FSTASL=STORE(FSTASL)_FLINK STORE(FSTASL)_BLINK=0 ST_USERS=1 %if ST_FLAGS=1 %thenstart; ! RECAPTURABLE FLAG I=ST_LINK AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %finish RA=STOREX*PAGESIZE %if ZEROED=0 %thenstart; ! CLEAR TO ZERO %if XA=YES %thenstart *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish I=RTV(RA) *l_0,i; *l_1,pagesize *lr_2,0; *slr_3,3; *mvcl_0,2 %finish FREEEPAGES=FREEEPAGES-1 %if FREEEPAGES=0 %then INHIBIT(5) %if XA=YES %thenstart *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,248 {X'F8'}; *N_2,KEY *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish %result=STOREX %end %routine GET EPAGE(%record (PARMF) %name P) !*********************************************************************** !* SERVICE 5.CAN BE PONNED (BUT NOT CALLED!) TO PROVIDE AN EPAGE. * !* REQUESTS HAVE P_P1 AS RETURNABLE IDENTIFIER * !* P_P2 ZERO IF PAGE TO BE SEROED * !* P_P3 BOTTOM 8 BITS HAVE STORE KEY IN SSKE FORMAT * !* REPLIES HAVE STORE INDEX IN P_P2 AND REALADDR IN P_P4 * !*********************************************************************** %integer STOREX,PS %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %if FREEEPAGES=0 %thenstart; ! SHOULD ONLY OCCUR IN MULTIOCPS %if MULTIOCP=YES %start; STORESEMA=-1; %finish PON(P); ! SERVICE NOW INHIBITED %return %finish %if MONLEVEL&2#0 %and KMON&1<<5#0 %then PKMONREC("GET EPAGE:",P) STOREX=QUICK EPAGE(P_P2,P_P3) P_P2=STOREX; ! LEAVE P1 & P3 & P5 & P6 INTACT P_P4=STOREX*PAGESIZE P_DEST=P_SRCE P_SRCE=X'50000' PS=P_DEST %if PS=X'40003' %then PS=P_P5 %if LOCSN0>16<=LOCSN1 %then GETEPN=GETEPN-1 %if MULTIOCP=YES %start; STORESEMA=-1; %finish PON(P) %end %integerfn NEW EPAGE !*********************************************************************** !* HANDS OUT A NEW EPAGE TO EXTEND A VITAL RESIDENT TABLE * !*********************************************************************** %integer I %if MULTIOCP=YES %thenstart { TEST BUT DO NOT WAIT FOR STORE SEMA} {IF NOT AVAILABLE THEN ->USE SPARE} *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 %finish %if FREE EPAGES>0 %thenstart I=QUICK EPAGE(0,X'18'); ! ZEROED KEY=1+READ PROTECTION %if MULTI OCP=YES %start; STORESEMA=-1; %finish %if I<0 %then ->USE SPARE STORE(I)_USERS=X'7FFF' %result=I*PAGESIZE %finish USE SPARE: ! try emergency spare page %if SPSTOREX>0 %start I=SPSTOREX*PAGESIZE SPSTOREX=0 %result=I %finish %result=-1 %end %routine RETURN EPAGE(%record (PARMF) %name P) !*********************************************************************** !* SEVICE NO 6. * !* PUT AN EPAGE BACK ON THE FREE LIST. FLAWED PAGES ARE ABANDONED * !* IF THE PAGE IS MARKED AS 'RECAPTURABLE' IT GOES TO THE BACK OF * !* OF THE FREELIST OTHERWISE IT GOES ON THE FRONT. THIS GIVES THE * !* MAXIMUM CHANCES OF RECAPTURING ANYTHING USEFUL * !* DACT=0 FOR PON OR CALL WITHOUT STORESEMA * !* DACT=1 SPECIAL CALL FROM HOLDER OF STORESEMA * !* P_P2 HAS THE STORE INDEX OF THE RETURNED PAGE. THERE IS NO REPLY * !*********************************************************************** %routinespec STOP RECAPTURE %record (STOREF) %name ST %integer I,STOREX,STAD,ACT,RA ACT=P_DEST&1 %if MULTIOCP=YES %and ACT=0 %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %if MONLEVEL&2#0 %and KMON&1<<6#0 %then PKMONREC("RETURNEPAGE:",P) STOREX=P_P2 RA=STOREX*PAGESIZE ST==STORE(STOREX) ST_USERS=0 %if STOREX=0 %then MONITOR("PAGE 0 RETURNED???") %if ST_FLAGS&X'8000'#0 %thenstart OPMESS("PAGE ".STRINT(STOREX)." ABANDONNED") STOP RECAPTURE ->RETURN %finish %if SPSTOREX=0 %start STOP RECAPTURE %if XA=YES %thenstart *L_1,RA; *LA_2,24 {X'18'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,24 {X'18'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish I=RTV(RA) *l_0,i; *l_1,pagesize *lr_2,0; *slr_3,3; *mvcl_0,2 SPSTOREX=STOREX %finishelsestart %if ST_FLAGS&1#0 %start; ! RECAPTURABLE TO BACK ST_FLINK=0 ST_BLINK=BSTASL STORE(BSTASL)_FLINK=STOREX BSTASL=STOREX %finishelsestart; ! NOT RECAPTURABLE ON FRONT ST_BLINK=0 ST_FLINK=FSTASL STORE(FSTASL)_BLINK=STOREX FSTASL=STOREX %finish %if FREEEPAGES=0 %then UNINHIBIT(5) FREEEPAGES=FREEEPAGES+1 %finish %if XA=YES %thenstart *L_1,RA; *LA_2,248 {X'78'} *SSKE_2,1 %finishelseif XA=AMDAHL %start *L_1,RA; *LA_2,248 {X'78'} *SSK_2,1 %finishelsestart *L_1,RA; *LA_2,248 {X'78'} *SSK_2,1 *LA_1,2048(1); ! ON TO SECOND 2 K *SSK_2,1 %finish RETURN: %if MULTIOCP=YES %and ACT=0 %start; STORESEMA=-1; %finish %return %routine STOP RECAPTURE; ! SUBROUTINE TO BREAK LINK %if ST_FLAGS=1 %thenstart; ! RECAPTURABLE I=ST_LINK AMTDD(I)=AMTDD(I)!STXMASK ST_FLAGS=0 %finish %end %end %routine DEADLOCK !*********************************************************************** !* CALLED WHEN THE NUMBER OF PROCESSES NOT WAITING ON A PAGE FAULT * !* IS LESS THAN THE NUMBER OF OCPS TO EXECUTE THEM.THIS ROUTINE GOES* !* DOWN THE LIST OF GET EPAGES UNTIL IT FIND A PROCESS AND GIVES IT * !* PAGE ZERO AS A SIGNAL TO DEPART. NEEDS STORE SEMA TO CHECK FOR * !* A DEADLOCK AND THE MAINQSEMA FOR SUPPOFFING * !*********************************************************************** %record (PARMF) P %integer I,N,K %if MULTIOCP=YES %thenstart *basR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %unless PAGEFREES<=1 %and GETEPN>=MPLEVEL+1-COM_NOCPS %start %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return; ! NOT A TRUE DEADLOCK %finish N=GETEPN GETEPN=GETEPN-1; ! ASSUMES WE WILL CURE DEADLOCK %if MULTIOCP=YES %start; STORESEMA=-1; %finish %cycle I=1,1,4*N; ! ALLOW FOR PLENTY OF OTHER RQS SUPPOFF(SERVA(5),P); ! TAKE A GET PAGE REQUEST %if (P_SRCE=X'40003' %and LOCSN0>16<=LOCSN1) %or %c LOCSN0>16<=LOCSN1 %start ! 4-3=PAGEIN. P_P5 IS PT SRCE ! LC ACT 9 IS GET PAGE FOR PTS ! LC ACTF IS GET LOCKED PAGE P_DEST=P_SRCE P_SRCE=X'50000'; ! AS FROM GET EPAGE P_P2=0; ! PAGE 0 P_P4=-1; ! WHICH HAS REALAD OF -1 PON(P) PRINTSTRING("DEADLOCK RECOVERED ") K=1+COM_SEPGS//100; ! 1% OF STORE %if K>OVERALLOC %then K=OVERALLOC OVERALLOC=OVERALLOC-K UNALLOCEPS=UNALLOCEPS-K %return %finish PON(P); ! NOT SUITABLE: RETURN TO QUEUE %repeat GETEPN=GETEPN+1 OPMESS("DEADLOCK UNRECOVERABLE") %end %routine OVERALLOC CONTROL !*********************************************************************** !* SERVICE NO 16. * !* THIS ROUTINE IS KICKED PERIODICALLY TO TRY TO INCREASE THE STORE * !* OVERALLOCATION. EACH TIME THERE IS A DEADLOCK THE OVERALLOCATION * !* IS DECREASED. SYSTEM SHOULD SELF TUNE TO OCCAISIONAL DEADLOCKS * !* (1 EVERY 10-15MINS) WHICH IS OPTIMAL STORE USE. * !*********************************************************************** %integer K K=1+COM_SEPGS//400; ! 0.25% OF STORE %if OVERALLOC+K *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish DACT=P_DEST&X'F' ->ACT(DACT) ACT(0): ! INITIALISE %if MULTIOCP=YES %start; STORESEMA=-1; %finish REALAD=NEW EPAGE %if XA=NO %then LIM=(MAXAMTAK-4)//4 %else LIM=(MAXAMTAK-4)//64 ! PT SIZE WORST CASE %if XA=YES %start SEGTAB(AMTASEG)=REALAD!X'80'!LIM; ! COMMON BIT SET %else SEGTAB(AMTASEG)=LIM<<28!REALAD %finish ! ! SET UP PUBLIC SEGMENT 'AMTASEG' FOR AMTA RECORD ARRAY WITH ! PAGE TABLE FOR IT AT BEGINNING OF FIRST EPAGE OF ITSELF ! AMTAPT==ARRAY(AMTASEG<RETURN %if AMT_LENRETURN; ! EXTEND ? %cycle I=AMT_DDP+LEN,1,AMT_DDP+AMT_LEN-1 ! RETURN IF STILL IN USE %if AMTDD(I)&STXMASK#STXMASK %then AMTX=0 %and ->RETURN %repeat DEALLOCDD(AMT_DDP+LEN,AMT_LEN-LEN) AMT_LEN=LEN %finish %if AMT_USERS=0 %and AMT_OUTS>0 %start %cycle I=AMT_DDP,1,AMT_DDP+LEN-1 %if AMTDD(I)&NEWEPBIT#0 %then AMTX=-4 %and ->RETURN %repeat %finish AMT_USERS=AMT_USERS+1; ! USERS ->RETURN %finish AMTX=AMT_LINK %repeat %if AMTASL=0 %thenstart; ! NO AMT CELLS FREE ! TRY TO APPEND EPAGE TO AMTA AMTX=-1 %if AMTANEXT>=MAXAMTAK %then ->RETURN; ! ALREADY MAX SIZE REALAD=NEW EPAGE %if REALAD<=0 %then ->RETURN; ! NO FREE EPAGE APPENDAMTA(PAGESIZE,REALAD) %finish ! ALLOCATE NEW SPACE GARB=0; ! NOT GARBAGE COLLECTED YET %cycle %if DDASL(LEN)#0 %thenstart DDX=DDASL(LEN) DDASL(LEN)=AMTDD(DDX) ->SETAMT %finish ! TAKE SPACE FROM A BIGGER HOLE I=LEN+1 %while I<=MAXBLOCK %cycle DDX=DDASL(I) %if DDX#0 %thenstart DDASL(I)=AMTDD(DDX) AMTDD(DDX+LEN)=DDASL(I-LEN) DDASL(I-LEN)=DDX+LEN ->SETAMT %finish I=I+1 %repeat ! NO HOLES BIG ENOUGH %if GARB#0 %then AMTX=-2 %and ->RETURN; ! STILL NOT ENOUGH SPACE COLLECT DD GARBAGE ! TRY TO APPEND EPAGE TO AMTDD %if FREEMAX<32 %and AMTDDNEXT0 %then APPENDAMTDD(PAGESIZE,REALAD) %finish %repeat SETAMT: ! PUSHDOWN NEW AMT CELL AMTX=AMTASL AMT==AMTA(AMTX) AMTASL=AMT_LINK AMT_DA=DA AMT_DDP=DDX AMT_USERS=1 AMT_LEN=LEN AMT_OUTS=0 AMT_LINK=AMTHASH(HASH) AMTHASH(HASH)=AMTX %cycle I=DDX,1,DDX+LEN-1 AMTDD(I)<-MASK>>31<<15!STXMASK %repeat RETURN: P_P1=ID P_P2=AMTX %if MULTIOCP=YES %start; STORESEMA=-1; %finish %if SRCE>0 %then P_DEST=SRCE %and P_SRCE=X'80001' %and PON(P) %return ACT(2): ! RETURN AMTX IN P_P2 ! P_P3=0 FILE KEPT #0 DESTROY %begin %integerarray CLEARS(0:MAXBLOCK) AMTX=P_P2 AMT==AMTA(AMTX) %if AMT_DA=X'FF000000' %or AMT_DA=0 %then OPMESS("RETURNED AMT??") CN=0; ! NO CLEARS AS YET %if P_P3=0 %thenstart; ! FILE BEING KEPT %cycle I=AMT_DDP,1,AMT_DDP+AMT_LEN-1; ! CHECK "NEW" EPAGE BIT ! "NEW" SECTIONS NEVER SHARED %if AMTDD(I)&NEWEPBIT#0 %thenstart CLEARS(CN)=AMTX<<16!(I-AMT_DDP) CN=CN+1 AMT_OUTS=AMT_OUTS+1 %finish %repeat %finish AMT_USERS=AMT_USERS-1 ! ! NOW IF THERE WERE ANY CLEARS SET THEM OFF. THIS IS DONE LATER ! SO THAT THE STORE SEMA CAN BE FREE ON DUALS. IMPORTANT AS IT MAY ! BE NECESSARY TO EXTEND THE PARM ASL IF VERY LARGE NO OF CLEARS ! ARE REQUIRED ! P_P6=CN; ! SO L-C CAN ACCOUNT FOR CLEARS %if CN>0 %start DCLEARS=DCLEARS+CN %if MULTIOCP=YES %start; STORESEMA=-1; %finish Q_DEST=X'40004'; ! ZERO PAGE Q_SRCE=X'80080002' %cycle I=0,1,CN-1 Q_P1=CLEARS(I) PON(Q); ! PON to limit call depth & so %repeat; ! avoid possible LC stack o'flow %finish %end %if CN>0 %thenreturn; ! SEMA ALREADY RELEASED ! IF THERE WERE NO CLEARS THEN ! DROP THROUGH INTO ACT 3 ACT(3): ! RETURN AMTX AFTER TRANFERS END AMTX=P_P2 AMT==AMTA(AMTX) %unless AMT_USERS=0 %and AMT_OUTS=0 %and AMT_DA#X'FF000000' %start %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return; ! AWAIT TRANSFERS %finish DEALLOCDD(AMT_DDP,AMT_LEN) DEALLOCAMT %if MULTIOCP=YES %start; STORESEMA=-1; %finish %return ACT(4): ! ENTERED EVERY 10 SECS %if MULTIOCP=YES %start; STORESEMA=-1; %finish ! CODE WAS HERE TO ADJUST RESIDENCES ! BETWEEN MIN&MAX ACCORDING TO ! DRUM SATURATION. HARDLY SEEMS WORTH ! KEEPING THIS TO SAVE AMT SPACE RESIDENCES=MAXRESIDENCES ! ! EXAMINE PROCESS LIST EVERY 10 SECS. ALL PROCESSES THAT HAVE ! BEEN INACTIVE FOR MORE THAN 2 MINS ARE TOLD TO DEACTIVATE ! THEIR ACTIVE MEMORY FREEING DRUM & TABLESPACE ! P_SRCE=X'80000' K=(RESIDENCES-MINRESIDENCES+2)>>1; ! HOW LONG CAN HE HANG ON TO DRUM ! MAX 7 MIN 1 IN 20 SEC TICKS I=1; J=0 %until J=COM_USERS %or I>MAXPROCS %cycle PROC==PROCA(I) %if PROC_USER#"" %thenstart %if PROC_STATUS&AMTLOST=0 %and K>12<<4 %if AMTANEXT=0 %start; ! FIRST PT ENTRY I=RTV(REALAD); ! SET A GLOBAL MAPPING %if XA=YES %then INTEGER(I)=PTE %else SHORTINTEGER(I)<-PTE %if XA=NO %then LIM=(MAXAMTAK-4)//4 %else LIM=((MAXAMTAK-4)//64)*16+15 %for J=1,1,LIM %cycle AMTAPT(J)=-1 %repeat %finishelse AMTAPT(AMTANEXT)<-PTE AMTANEXT=AMTANEXT+1 FIRSTNEW=AMTASIZE+1 AMTASIZE=AMTASIZE+NEWSPACE//AMTFLEN; ! MIGHT WASTE THE ODD RECORD %cycle I=FIRSTNEW,1,AMTASIZE-1 AMTA(I)_LINK=I+1 %repeat AMTA(AMTASIZE)_LINK=AMTASL AMTASL=FIRSTNEW %end %routine APPENDAMTDD(%integer NEWSPACE,REALAD) !*********************************************************************** !* APPEND A NEW EPAGE TO AMTDD. PARAMETERS AS FOR APPENDAMTA * !*********************************************************************** %integer FIRSTNEW,I,J,LIM,PTE %if XA=YES %then PTE=REALAD %else PTE=REALAD>>12<<4 %if AMTDDNEXT=0 %start; ! FIRST PT ENTRY I=RTV(REALAD); ! SET A GLOBAL MAPPING %if XA=YES %then INTEGER(I)=PTE %else SHORTINTEGER(I)<-PTE %if XA=NO %then LIM=(MAXAMTDDK-4)//4 %else %c LIM=((MAXAMTDDK-4)//64)*16+15 %for J=1,1,LIM %cycle AMTDDPT(J)=-1 %repeat %finishelse AMTDDPT(AMTDDNEXT)<-PTE AMTDDNEXT=AMTDDNEXT+1 FIRSTNEW=AMTDDSIZE+1 AMTDDSIZE=AMTDDSIZE+NEWSPACE//DDFLEN FREEMAX=0 DDASLALLOC(FIRSTNEW,AMTDDSIZE) %end %routine DDASLALLOC(%integer FROM,TO) !*********************************************************************** !* CHOP UP AMTDD (FROM:TO) INTO AS MANY MAXIMUM SIZED BLOCKS * !* AS POSSIBLE AND A LEFTOVER * !*********************************************************************** %integer LEN %cycle LEN=TO-FROM+1 %if LEN>=MAXBLOCK %thenstart AMTDD(FROM)=DDASL(MAXBLOCK) DDASL(MAXBLOCK)=FROM FREEMAX=FREEMAX+1 FROM=FROM+MAXBLOCK %finishelsestart %if FROM<=TO %then AMTDD(FROM)=DDASL(LEN) %and DDASL(LEN)=FROM %return %finish %repeat %end %routine DEALLOCAMT !*********************************************************************** !* DEALLOCATE AMT ENTRY AND RETURN TO FREE LIST. RESETTING THE HASH * !* CHAIN IS THE ONLY PROBLEM * !*********************************************************************** %integer HASH,DA %record (AMTF) %name AMT %shortintegername PTR AMT==AMTA(AMTX) DA=AMT_DA AMT_DA=X'FF000000' *SR_0,0; *L_1,DA; *LA_2,509; *DR_0,2; *ST_0,HASH PTR==AMTHASH(HASH) PTR==AMTA(PTR)_LINK %while PTR#AMTX PTR=AMT_LINK; ! RESET CHAIN OMITTING THIS ENTRY AMT_LINK=AMTASL; ! RETURN CELL AMTASL=AMTX %end %routine DEALLOCDD(%integer DDX,LEN) !*********************************************************************** !* DEALLOCATE A SECTION OF AMTDD. DIFFICULT IN DUALS AS STORE * !* SEMA IS NEEDED TO CLEAR BACKLINKS * !*********************************************************************** %integer I,J,DTX %cycle I=DDX,1,DDX+LEN-1 J=AMTDD(I)&STXMASK AMTDD(I)=0 %if J#STXMASK %then STORE(J)_FLAGS=0 %repeat I=DDASL(LEN) AMTDD(DDX)=I DDASL(LEN)=DDX %end %end !----------------------------------------------------------------------- %if MONLEVEL&X'3C'#0 %thenstart %externallongintegerspec SEMATIME %routine TIMEOUT !*********************************************************************** !* Print out the session timing measurements * !*********************************************************************** %conststring (15) %array SERVROUT(0:LOCSN0+3)="Idle time", "Nowork time","Deadlock rcvry","Schedule", "Pageturn","Get epage","Return epage","File semaphore","Active mem", "","Elapsedint","Update time","Dponputonq","", "Activemem(Poll)","Schedule(Oper)","Overalloc cntrl",""(14), "", "Disc","Disc transfers","Disc interrupt","","Move requests", "Move transfers",""(2), "","","",""(5),"Devio requests","Tape", "Oper","LP adaptor","CR adaptor","CP adaptor","Printer", "Comms control","Combine","FEP adaptor","Devio interrupt", ""(2),"Bmrep","COmrep",""(2),"Local control","Foregrnd users", "Backgrnd users" %integer I,J,K %longreal PERIOD,TOTAL,IDLETIME,PROCTIME,SERVTIME,RSEMATIME %string (15) S %string (31) %fnspec STRPRINT(%longreal X, %integer A,B) %if MULTIOCP=YES %then RESERVE LOG %if MONLEVEL&4#0 %start PERIOD=(CLOCK-PERFORM_CLOCK)>>12 I=ADDR(COM_DATE0)+3 NEWPAGE PRINT STRING(" EMAS370 Sup".SUPID." Timing measurements ".STRING(I)." ".STRING(I+12)." Period=".STRPRINT(PERIOD/1000000,1,3)." Secs") %if MULTIOCP=YES %then PERIOD=PERIOD*COM_NOCPS IDLETIME=COM_ITINT*(IDLEIT+NOWORKIT) PROCTIME=COM_ITINT*(FLPIT+BLPIT) PRINT STRING(" Service Calls Time Average % of ". %c "% of % of (Secs) (Msecs) Total ". %c "Non-idle Supvsr ") TOTAL=0 %cycle I=0,1,LOCSN0+3 S=SERVROUT(I) J=PERFORM_SERVN(I) %if S#"" %and J>0 %thenstart PRINT STRING(" ".S.STRSP(16-LENGTH(S)).STRPRINT(J,9,0)) SERVTIME=COM_ITINT*PERFORM_SERVIT(I) PRINT STRING(STRPRINT(SERVTIME/1000000,6, 3).STRPRINT((SERVTIME/1000)/J,6, 3).STRPRINT(100*SERVTIME/PERIOD,7, 1)."%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME),6, 1)."%".STRPRINT(100*SERVTIME/(PERIOD-IDLETIME-PROCTIME), 6,1)." ") TOTAL=TOTAL+SERVTIME %finish %repeat RSEMATIME=SEMATIME PRINT STRING(" Interrupt/Activate etc.=".STRPRINT((PERIOD-TOTAL)/1000000,1, 3)." secs (".STRPRINT(100*(PERIOD-TOTAL)/PERIOD,1,1)."%) Semalockout=".STRPRINT(RSEMATIME/1000000,1, 3)."secs(".STRPRINT(100*RSEMATIME/PERIOD,1,1)."%) ") PRINTSTRING(" Overalloc=".STRINT(OVERALLOC)." Pageins=".STRINT(PERFORM_PTURNN)." Recaptures=".STRINT(PERFORM_RECAPN)." Shared pages=".STRINT(PERFORM_PSHAREN)." New pages=".STRINT(PERFORM_NEWPAGEN)." Writeouts=".STRINT(PERFORM_PAGEOUTN)." Pages zeroed=".STRINT(PERFORM_PAGEZN)." Pages snoozed=".STRINT(PERFORM_SNOOZN)." Pages aborted=".STRINT(PERFORM_ABORTN)) PRINTSTRING(" Snoozes complete =".STRINT(PERFORM_SNOOZOK)." Snoozes timedout =".STRINT(PERFORM_SNOOZTO)." Snoozes abandoned=".STRINT(PERFORM_SNOOZAB)." ") %finish %if MONLEVEL&32#0 %thenstart NEWPAGE PRINTSTRING(" Category table transitions TO->") %cycle I=4,1,MAXCAT WRITE(I,4) %repeat NEWLINE %cycle J=1,1,MAXCAT WRITE(J,3) %cycle I=4,1,MAXCAT K=CATREC(I,J) WRITE(K,4) %repeat NEWLINE SPACES(4) %cycle I=4,1,MAXCAT K=FLYCAT(I,J) %if K#0 %then WRITE(K,4) %else SPACES(5) %repeat NEWLINE %repeat %finish %if MONLEVEL&16#0 %thenstart PRINTSTRING(" Cat Seqout Strobes Epsexamined Epsout ") %cycle I=1,1,MAXCAT %if STROBEN(I)#0 %start WRITE(I,2) WRITE(SEQOUT(I),7) WRITE(STROBEN(I),7) WRITE(STREPN(I),11) WRITE(STROUT(I),6) %if STROUT(I)#0 %then WRITE(STREPN(I)//STROUT(I),6) NEWLINE %finish %repeat %finish NEWPAGE PPROFILE %if MULTIOCP=YES %then RELEASE LOG CLEAR TIME %return %string (31) %fn STRPRINT(%longreal X, %integer N,M) !*********************************************************************** !* Prints a real number (x) allowing n places before the decimal * !* point and m places after.It requires (m+n+2) print places * !* unless (m=0) when (n+1) places are required. * !* * !* A little care is needed to avoid unnecessary loss of accuracy * !* and to avoid overflow when dealing with very large numbers * !*********************************************************************** %longreal ROUND,Y,Z %string (127) S %integer I,J,L,SIGN,SPTR LENGTH(S)=127; ! avoid charno check SIGN=' '; ! '+' IMPLIED %if X<0 %then SIGN='-' Y=MOD(X); ! ALL WORK DONE WITH Y ROUND=0.5/10.0**M; ! ROUNDING FACTOR Y=Y+ROUND I=0; Z=1 %until Z>Y %cycle; ! COUNT LEADING PLACES I=I+1; Z=10*Z; ! NO DANGER OF OVERFLOW HERE %repeat SPTR=1 %while SPTR<=N-I %cycle CHARNO(S,SPTR)=' ' SPTR=SPTR+1 %repeat CHARNO(S,SPTR)=SIGN SPTR=SPTR+1 J=I-1; Z=10.0**J %cycle %until J<0 %cycle L=INT PT(Y/Z); ! OBTAIN NEXT DIGIT Y=Y-L*Z; Z=Z/10; ! AND REDUCE TOTAL CHARNO(S,SPTR)=L+'0' SPTR=SPTR+1 J=J-1 %repeat %if M=0 %thenexit; ! NO DECIMAL PART TO BE O/P CHARNO(S,SPTR)='.' SPTR=SPTR+1 J=M-1; Z=10.0**(J-1) M=0 Y=10*Y*Z %repeat LENGTH(S)=SPTR-1 %result=S %end %end !----------------------------------------------------------------------- %routine CLEAR TIME !*********************************************************************** !* Clear out the timing measurements * !*********************************************************************** %integer I,J %if MONLEVEL&4#0 %thenstart %cycle I=0,1,LOCSN0+3 PERFORM_SERVIT(I)=0 PERFORM_SERVN(I)=0 %repeat PERFORM_RECAPN=0 PERFORM_PTURNN=0 PERFORM_PSHAREN=0 PERFORM_NEWPAGEN=0 PERFORM_PAGEOUTN=0 PERFORM_PAGEZN=0 PERFORM_SNOOZN=0 PERFORM_ABORTN=0 PERFORM_SNOOZOK=0 PERFORM_SNOOZTO=0 PERFORM_SNOOZAB=0 SEMATIME=0 PERFORM_CLOCK=CLOCK %finish %if MONLEVEL&32#0 %thenstart %cycle I=0,1,MAXCAT %cycle J=0,1,MAXCAT FLYCAT(I,J)=0; CATREC(I,J)=0 %repeat %repeat %finish %if MONLEVEL&16#0 %thenstart %cycle I=0,1,MAXCAT STROBEN(I)=0 STREPN(I)=0 STROUT(I)=0 SEQOUT(I)=0 %repeat %finish %end %finish %routine UPDISP(%integer PROCESS,OFFSET, %string (13) S) %integer LINE,POS PROCESS=PROCESS-1 LINE=PROCESS//3; ! 3 PER LINE +HEADER POS=(PROCESS-3*LINE)*13; ! 40CHARS FOR EACH 3 PROCS DISPLAY TEXT(-1,LINE+5,POS+OFFSET,S); ! CURRENTLY 5 HEADER LINES %end ! !----------------------------------------------------------------------- ! %list %routine LOCAL CONTROL ! CLAIMED BLOCK TABLES %record (CBTF) %name CBT ! CONSOLE IO & ACCOUNTS RECORDS %integername SEMAHELD; ! DIRECTOR HOLDING SEMA WORD ! ACTIVE SEGMENT TABLES %constinteger MAXAS=31 %integerarray AS(0:7,0:MAXAS) %byteintegerarray ASEG(0:MAXAS) %integerarray ASPTVAD(0:MAXAS) %integerarray OLDASWIPS(0:MAXRESIDENCES) %constinteger TOPBIT=X'80000000' !----------------------------------------------------------------------- ! LOCAL SEGMENT INFORMATION %byteintegerarray TST(0:LSTLEN-1); ! TERTIARY SEGMENT TABLE POINT TO AS %constinteger SMALL SEQUENTIAL=8; !USED TO DECIDE TO RECAP OR NOT %integerfnspec DXR(%longlongrealname T, %longlongreal B) %integerfnspec CHECK RES(%integer WRITE,LEN,AD) %integerfnspec CHECKDA(%integer DA) %routinespec PAGEOUT(%integer VSSEG,VSEPAGE, %record (CBTF) %name CBT) %routinespec ASOUT(%integer ASP) %routinespec STROBE(%integer SFLAGS) %routinespec WORKSET(%integer RECAP) %routinespec CLEAR ACCESSED BITS %routinespec DEACTIVATE(%integer MASK) %routinespec FREE AS %routinespec RETURN PTS %integerfnspec FIND PROCESS %routinespec WAIT(%integer DACT,N) !----------------------------------------------------------------------- %integer CBTP,ASFREE,ASWAP,ASWIP,ASSHR {%bitarray (0:MAXAS)},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,NONSEQVSIS,LCERRS, XSTROBE,SEGLEN,PTEPS,ASDESTROY,PTP,ASP,ASB,OUTN,PTE,HIGHSEG,LOCKST, LOCKSTX,LTAD,TSTPTR,NEXTPTP,PTPVAD,PTVAD,CABI %longinteger PSW %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 %thenstart %integerarrayname PT %else %shortintegerarrayname PT %finish %if MONLEVEL&4#0 %thenstart %integer MONVAD,MONPTAD,MONLIM %longinteger TIMER1,TIMER2 %routinespec GARNER(%integer EVENT,PARAM) %longintegername LPIT %finish %string (15) INTMESS %switch ACTIVITY(0:16),ASYN0(1:3),AMTXSW(-4:0) %constinteger 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 %c 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=X'FFFFFFFF'; ! ALL FREE ASWAP=0 ASSHR=0 ASWIP=0 PEPARM=-1 SUSP=0 ASDESTROY=0 !----------------------------------------------------------------------- ! CONNECT DIRECTOR FILES ! CODE AS SEG66 USING TOP 2 CBTS ! GLA AS SEG67 USING CBT0 ! STACK AS SEG68 USING CBT1 %if XA=NO %thenstart J=DCODESEGS SST(DCODESEG+I)=CBTLEN-J+I %for I=0,1,J-1 %finishelse 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 %thenstart LST(DCODESEG)=X'23'; ! 256K INVALID LST(DGLASEG)=X'20'; ! 64K AND INVALID LST(DSTKSEG)=X'21'; ! 128K & INVLID %finishelseif XA=AMDAHL %start LST(DCODESEG)=7<<28!1 LST(DGLASEG)=0<<28!1 LST(DSTKSEG)=1<<28!1 %finishelsestart LST(DCODESEG+I)=15<<28!1 %for I=0,1,J-1 LST(DGLASEG)=(DGLAEPAGES-1)<<28!1 LST(DSTKSEG)=15<<28!1 %finish !----------------------------------------------------------------------- %if PROCESS=1 %thenstart; ! 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, *ST_1,PSW+4 *DROP_2 LONGINTEGER(X'208')=PAGE0_PENEWPSW; ! COPY AWAY G-C PE PSW PAGE0_PENEWPSW=PSW %if MULTIOCP=YES %thenstart; %finish ! SET INTERVAL TIMER IST ENTRY *BASR_2,0; *USING_2 *LA_1, *ST_1,PSW+4 *DROP_2 LONGINTEGER(X'210')=PSW; ! EXTERNALS ARE GLOBAL ! G-C USES THIS PSW TO REROUTE %if MULTIOCP=YES %thenstart; %finish ! SET UP SVC PSW ENTRY *BASR_2,0; *USING_2 *LA_1, *ST_1,PSW+4 *DROP_2 PAGE0_SVCNEWPSW=PSW %if MULTIOCP=YES %thenstart; %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 %thenstart *STPT_PSW LCIT=LCIT+(MAXCPUTIMER-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) ->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,1128(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); ! 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) %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=CONTEXT_CPUTIMER<<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 %c ACNT_LLIMIT=X'1000' {4 SECS} %and PEPARM=17 %and ->PE RTN=RTN+1 %if RTN=1 %thenstart PROC_RUNQ=CATTAB(PROC_CATEGORY)_RQTS2 %if MONLEVEL&1#0 %then UPDISP(PROCESS,11,"R".TOSTRING(PROC_RUNQ+'0')) %finishelsestart %if RTN=RTLIM %thenstart 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 %c GARNER(7,2<<24!PROC_CATEGORY<<16!EPN) %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish SCHEDULE(POUT) %if MONLEVEL&12=12 %thenstart *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 %thenstart WORKSET(0) POUT_DEST=X'30004'; ! OUT OF TIME POUT_SRCE=ME!1 POUT_P1=PROCESS POUT_P2=EPN; ! EPAGES USED SO FAR PON(POUT) ->RETURN %finish EPLIM=POUT_P1 RTLIM=POUT_P2 RTN=0 STROBE(0) %if POUT_P3#0; ! NEWCAT_STROBEI#0 %finishelsestart 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 PROCESS>1 %and (RUNQ1#0 %or (PREEMPTED!RUNQ2#0 %and %c 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,1128(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); ! 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) %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,1128(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); ! 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) %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 PEPARM=1 %start; ! CHECK AND EMULATE DXR I=PAGE0_PE ILC>>1&3 J=INTEGER(ADDR(CONTEXT_PSW)+4)-4 %if I=2 %and SHORTINTEGER(J)=X'FFFFB22D' %start J=SHORTINTEGER(J+2)&255 K=ADDR(CONTEXT_FR(0)) %if J=X'04' %then I=DXR(LONGLONGREAL(K),LONGLONGREAL(K+16)) %if J=X'40' %then I=DXR(LONGLONGREAL(K+16),LONGLONGREAL(K)) %if I=0 %then ->ACT; ! DXR HAS BEEN EMULATED %finish %finish PEPARM=PEPARM<<8!PETLATE(PEPARM) I=LCTABLES_CURCONTEXT LCTABLES_CURCONTEXT=0 LCPE: ! L-C HAS PE OR ILLEAGL VSI %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 NEWCONTEXT=2; ! SIGNAL CONTEXT %if PROC_STACK=NEWCONTEXT %thenstart PRINT STRING("PROGRAM ERROR ON SIGNAL STACK CLASS=".STRINT %c (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&X'FF0000FF'!K&X'00FFFF00'; ! 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 %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 HIGHSEG=2 RETIME: ! START NEW TIMESLICE CONTEXT==LCTABLES_CONTEXTS(PROC_STACK); ! CORRECT USER CONTEXT %if CONTEXT_CPUTIMER>0 %start %if MONLEVEL&4#0 %then LPIT=LPIT-CONTEXT_CPUTIMER>>12 ACNT_LTIME=ACNT_LTIME-(CONTEXT_CPUTIMER>>12)>>10 ACNT_LLIMIT=ACNT_LLIMIT+(CONTEXT_CPUTIMER>>12)>>10 %finish CONTEXT_CPUTIMER=TIMESLICE<<12; ! TIMESLICE IN MICROSECS %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 CONTEXT==LCTABLES_CONTEXTS(PROC_STACK) %if KERNELQ#0 %then ->ONFRUNQ; ! DO ANY KERNEL SERVICES ! ! COUNT ACTIVATIONS TO PROCESS ! %if MONLEVEL&4#0 %thenstart %if PROC_STATUS&4=0 %then FLPN=FLPN+1 %else BLPN=BLPN+1 *STPT_PSW LCIT=LCIT+(MAXCPUTIMER-PSW)>>12 %finish LCTABLES_CURCONTEXT=PROC_STACK CONTEXT_ASYNI=0; ! not suspended (obviously) *L_1,CONTEXT; ! ADDR SAVE ARE TO GR1 *MVC_2048(8,0),0(1); ! USER PSW TO PAGE 0 *LD_0,72(1); *LD_2,80(1); ! LOAD UP FLOATING REGS *LD_4,88(1) *LD_6,92(1) *LCTL_0,1,104(1) *SPT_168(1) *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)=X'FFFF' %then ->ACT; ! SIGNAL STACK NOT CREATED(STARTUP) ! OR HAS BEEN DESTROYED(CLOSEDOSN) !----------------------------------------------------------------------- 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 %c OPMESS("PROCESS ".STRINT(PROCESS)." TERMINATED") %and %c NEWCONTEXT=PROC_STACK %and ->TERMINATE %if I=X'FFFE' %thenstart 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 %thenstart %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) %c _CPUTIMER PROC_STACK=NEWCONTEXT CONTEXT==LCTABLES_CONTEXTS(NEWCONTEXT) %if CONTEXT_GR(11)>>SSHIFT#DSIGSTKSEG %then PRINT STRING(" ACTIVATE CONTEXT INVALID") %and ->TERMINATE ->ACTIVATE %finishelsestart %if LENGTH(INTMESS)>1 %then IOSTAT_INTMESS=INTMESS %if P_P2>=0 %and IOSTAT_IAD#P_P2 %thenstart 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 %thenstart SERV==SERVA(SUSP) %if SERV_P<<2#0 %then ->DPR; ! DIRPONREPLY %finish SRCE=SUSP ->SUSPWS; ! MAY JUST HAVE SWAPPED STACK ! %finish !----------------------------------------------------------------------- ASYN0(1): ! DISC READ FAILS PEPARM=P_P2!18; ! TOP 22 BITS ARE VIRTADDR OF PAGE ->PE ASYN0(2): ! RELEASE ACTIVE BLOCKS DEACTIVATE(\ASFREE); ! IE ALL USED ACTIVATE BLKS PROC_STATUS=PROC_STATUS!24; ! SET AMT GOING & AMT GONE BITS ->RESUSP 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 %thenstart %if MONLEVEL&4#0 %then PERFORM_SNOOZN=PERFORM_SNOOZN+EPN EPLIM=P_P1 RTLIM=P_P2 ! SNOOZES=SNOOZES+1 NONSEQVSIS=0 CLEAR ACCESSED BITS ! STROBE %if SNOOZES&15=0 ACNT_PTURNS=ACNT_PTURNS+EPN PROC_STATUS=PROC_STATUS&(\(HADPONFLY!HADTONFLY)) ! RESET FOR NEW RESIDENCE ->RETIME %finish !---------------------------------------------------------------------- VSERRI: ! VIRTUAL STORE INTS ENTER HERE VSPARM=INTEGER(144) VSSEG=VSPARM>>SSHIFT %if 0>(32-SSHIFT+12) %if VSSEG<12 %or 16<=VSSEG<=LCSTKSEG %or VSSEG>LSTLEN-1 %then %c 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 ->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 %thenstart PRINT STRING("VS ERROR ON SIGNAL STACK PARM=".STRHEX(VSPARM)." ") ->TERMINATE %finish ->SIGACT !----------------------------------------------------------------------- SEGTRAP: ! SEGMENT NOT AVAILABLE %if SST(VSSEG)=-1 %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 %c I=(CONTEXT_CONTROLR(1)>>24+1)*16-1 {GUESS!} %if VSSEG>I %then ->VSE %if XA=YES %then SEGLEN=(LST(VSSEG)&127+1)*16 %elseif 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 SEGLEN<=PTEPS %then ->OLDPTP %if EPN>=EPLIM %or NEXTPTP=15 %then ->NOPAGES %if MULTIOCP=YES %thenstart *BALR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT: %finish %if FREE EPAGES>0 %start STOREX=QUICK EPAGE(0,X'10'); ! ZEROE AND KEY OF 1 %if MULTI OCP=YES %start; STORESEMA=-1; %finish ->ACT9 %finish POUT_SRCE=ME!9 POUT_P2=0; ! CLEAR TO ZERO POUT_P3=X'10'; ! KEY OF ONE GET EPN=GET EPN+1 %if MULTIOCP=YES %start; STORESEMA=-1; %finish %if PAGEFREES<=1 %and GETEPN>=MPLEVEL+1-COM_NOCPS %then %c POUT_DEST=X'20000' %and PON(POUT) POUT_DEST=X'50000' PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(9): ! REPLY FROM GET EPAGE FOR PT STOREX=P_P2 %if STOREX=0 %then ->DEAD; ! DEADLY EMBRACE RECOVERY ACT9: ! PAGE TABLE EPAGE HERE ST==STORE(STOREX) ST_LINK=PTP; ! LIST OF PAGE TABLE PAGES PTP=STOREX PTAD=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 %if XA=AMDAHL %and CBTA(SST(VSSEG))_TAGS&READONLY#0 %then %c LST(VSSEG)=LST(VSSEG)!4 ! SEGMENT PROTECTION FEATURE %finish %if VSSEG>HIGHSEG %then HIGHSEG=VSSEG %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 %thenstart; ! 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=TOPBIT>>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 CBTP=SST(VSSEG) EPX=VSEPAGE CBT==CBTA(CBTP) %cycle %if EPX<=CBT_LNGTH %thenexit EPX=EPX-CBT_LNGTH-1 CBTP=CBTP+1 %if CBTP>=CBTLEN %then VSPARM=3 %and ->VSE CBT==CBTA(CBTP) %if CBT_TAGS&CONTINUATN BLK=0 %then VSPARM=3 %and ->VSE %repeat %if CBT_TAGS&ACTIVE=0 %thenstart; ! 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 %thenstart *STPT_TIMER1 %finish ACTIVE MEM(POUT) %if MONLEVEL&12=12 %thenstart *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 %finishelseif TSTPTR=127 %or ASPTVAD(TSTPTR)=-1 %then %c MONITOR("ASPTVAD invalid??") %if CBT_AMTX=0 %then VSPARM=255 %and ->VSE; ! TOMY LEFT ACTIVE SET 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 %if XA#YES %and 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 MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish PAGETURN(POUT) %if MONLEVEL&12=12 %thenstart *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 %if CBT_TAGS&ADVISORY SEQ#0 %then PAGEOUT(VSSEG,VSEPAGE-2,CBT) %elsestart 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 PAGEOUT(VSSEG,VSEPAGE-2,CBT) %else %c NONSEQVSIS=NONSEQVSIS+1 %finish PROC_STATUS=PROC_STATUS!2; ! DEMAND PAGE PRIORITY ->RETURN !----------------------------------------------------------------------- ACTIVITY(10): ! EPAGE HERE ! P_P1=RUBBISH IDENT ! P_P2=STORE(EPAGE)_REALAD ! VSSEG,VSEPAGE&TSTPTR INTACT !! EPH: PROC_STATUS=PROC_STATUS&X'FFFFFFFD' PTE=P_P2 ACT10: ! ENTERS HERE IF PAGE NOT TRANFRD ASP=TSTPTR I=VSEPAGE>>5 AS(I,ASP)=AS(I,ASP)!TOPBIT>>(VSEPAGE&31) ASB=TOPBIT>>ASP ASWAP=ASWAP!ASB ASWIP=ASWIP&(\ASB) EPN=EPN+1 %if CBT_TAGS&SMULTIPLE CON=0 %then UEPN=UEPN+1 PROC_EPN=EPN ACNT_PTURNS=ACNT_PTURNS+1 I=ASPTVAD(ASP); ! VIRTUAL ADDRESS OF PAGETABLE ! FILL PAGE TABLE ENTRY VIA VIRTUAL ADDRESS %if XA=YES %thenstart %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 ->ACTIVATE !-------------------------------------------- ACTIVITY(11): ! PAGE READ FAILURE %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) ->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 !----------------------------------------------------------------------- NOPAGES: ! NO EPAGES FOR PAGEFLT %if MONLEVEL&4#0 %and MONVAD>0 %then %c GARNER(7,3<<24!PROC_CATEGORY<<16!EPN) %if EPLIM>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 PERFORM_SERVN(3)=PERFORM_SERVN(3)+1 %finish %if POUT_P1#0 %thenstart EPLIM=POUT_P1 RTLIM=POUT_P2 RTN=0 STROBE(0) %if POUT_P3#0; ! NEWCAT_STROBEI#0 ->ACTIVATE %finish %finish %if XSTROBE<0 %thenstart; ! HAD A CHANGE CONTEXT SINCE LAST STROBE STROBE(1) %if EPNACTIVATE; ! GOT SOME BACK ! %finish WORKSET(1) POUT_DEST=X'30003'; ! OUT OF EPAGES POUT_SRCE=ME!1 POUT_P1=PROCESS POUT_P2=RTN; ! TIMESLICES USED SO FAR PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(7): ! MORE ALLOCATION AVAILABLE !----------------------------------------------------------------------- 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 0<=OUTN<=MAXDIROUT %thenstart %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 ASDESTROY=2; ! PRESERVE EVERYTHING BUT DONT ZERO UNUSED DOUT0: ! NORMAL STOPS JOIN HERE DEACTIVATE(\ASFREE) ASDESTROY=0 %if SEMAHELD#0 %then OPMESS("PROC".STRINT(PROCESS)." DIES WITH SEMA") RETURN PTS ALLOUTP_DEST=(LOCSN1+1)<<16!X'17'; ! DIRECT=PROCESS 1 ! X'17' NOT YET PARAMETERISED !!! ALLOUTP_SRCE=(LOCSN1+PROCESS)<<16 PON(ALLOUTP) POUT_DEST=X'30008'; ! SCHEDULE/DESTROY POUT_SRCE=ME POUT_P1=PROCESS PON(POUT) ->RETURN !----------------------------------------------------------------------- DIROUT(0): ! DIRECTOR STOPS PROCESS(NORMAL) ASDESTROY=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) 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 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>100 %and LASTDA#0 %and CHECKDA(LASTDA)>0 %then %c 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' %thenstart; ! RELAY MESSAGE %if FIND PROCESS=0 %then ->ACTIVATE; ! NOT LOGGED ON %finishelsestart 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 %thenstart 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 EDAR AND TAPES ->ONFRUNQA !----------------------------------------------------------------------- ACTIVITY(12): ! RE-ENTRY AFTER DIRECTOR PON PROC_STATUS=PROC_STATUS&(\2) %if SRCE>LOCSN3 %thenstart %if SERV3_P<<2#0 %then ->ASYNCH %finishelsestart SERV==SERVA(SRCE) %if SERV_P<<2#0 %then SUPPOFF(SERV,ALLOUTP) %and ->ACTIVATE %finish SUSPWS: !SUSPEND AWAITING A REPLY ! TRY TO STAY IN STORE IF CORE ! IS PLENTIFUL %if SNOOZING=YES %thenstart ->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 %thenstart; ! SUSPED ON FLY %if MONLEVEL&4#0 %and MONVAD>0 %then GARNER(5,EPN) SUSP=SRCE; ->RETURN %finish %finish ACTIVITY(8): DEPART: ! suspended but must now go %if MONLEVEL&4#0 %and MONVAD>0 %then %c 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 %if PROC_STACK=2 %then PRINT STRING(" SUSPENDED IN SIGNAL STATE") %and NEWCONTEXT=2 %and ->TERMINATE ->RETURN !----------------------------------------------------------------------- DIRPONREPLY: ! REPLY HAS WOKEN PROCESS UP SERV==SERVA(SUSP) DPR: SUPPOFF(SERV,ALLOUTP) SUSP=0 ->ACTIVATE !----------------------------------------------------------------------- DIROUT(6): ! PON & CONTINUE SRCE=PROCESS+LOCSN1 DIRPONC: ! OTHER PONS JOIN HERE DEST=ALLOUTP_DEST>>16 %if DEST=X'FFFF' %thenstart %if FIND PROCESS=0 %then ->ACTIVATE %finishelsestart 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 %thenstart; ! 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 %thenstart %if SERV3_P<<2#0 %then ->ASYNCH ALLOUTP_DEST=0 %finishelsestart 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 %thenstart *BALR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,SCHEDSEMA *BC_8, *DROP_1 SEMALOOP(SCHEDSEMA,0) SSEMAGOT1: %finish MPLEVEL=MPLEVEL-1; ! DECREASE MPLEVEL&CHECK DEADLOCKS %if PAGEFREES<=2 %and 0=MPLEVEL-1 %then %c P_DEST=X'20000' %and PON(P) %if MULTIOCP=YES %start; SCHEDSEMA=-1; %finish ->RETURN; ! WAIT IN STORE FOR REPLY !----------------------------------------------------------------------- ACTIVITY(13): ! REPLY TO PON & WAIT IN STORE %if MULTIOCP=YES %thenstart *BALR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,SCHEDSEMA *BC_8, *DROP_1 SEMALOOP(SCHEDSEMA,0) SSEMAGOT2: %finish MPLEVEL=MPLEVEL+1 PROC_RUNQ=J %if MULTIOCP=YES %start; SCHEDSEMA=-1; %finish ALLOUTP=P ALLOUTP_DEST=SRCE %if PROCESS>=FIRST UPROC %start CONTEXT==LCTABLES_CONTEXTS(PROC_STACK) CONTEXT_CPUTIMER=CONTEXT_CPUTIMER-OUT18CHARGE %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<=I<=LCONTN %then ->FREACT %unless 0#I#PROC_STACK %then ->FREACT ! MOVE IT TO NEW STACK LCTABLES_CONTEXTS(I)_CPUTIMER=LCTABLES_CONTEXTS(PROC_STACK)_CPUTIMER PROC_STACK=I SUSP=K; ! GO BACK TO CORRECT SUSPEND STATUS %if PROC_STACK=2 %then ALLOUTP==SIGOUTP %else ALLOUTP==DIROUTP ->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(DIROUTPAD+4*CABI) %if K=0 %then ->REACT K=CHECKDA(K) %if K#0 %thenstart %if K<0 %and J>0 %then %c OPMESS("? BLK ACTIVTY ".STRHEX(INTEGER(DIROUTPAD+4*CABI))) %and %c ->FREACT ! ! CAN BE A RACE CONDITIONS BETWEEN PONS ON STOPPING A PROCESS. SO ! IF AMT BLOCK STILL HAS USERS WAIT JUST ONCE TO CLEAR ANY BACKLOG ! OF PONNED DEALLOCATES. CONDITION SEEN ON A DUAL SUSPECTED AT KENT ! %if J=10 %then OPMESS("BLOCK PAGE-OUTS ?") %and ->FREACT WAIT(14,PAGEOUT DELAY(J)) ->RETURN %finish 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 %c ->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 MOPTAD=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)>>12 %cycle ->FREACT %if INTEGER(J+4*I)&X'400'#0 %repeat %else %for I=0,1,INTEGER(MONVAD+8)>>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 %thenstart; ! NO SEG TABLE AROUND ->FREACT %unless ALLOUTP_P1>0 %if MULTIOCP=YES %thenstart *BALR_1,0; *USING_1 *SR_0,0; *LR_2,0; *BCTR_2,0 *CS_2,0,STORESEMA *BC_8, *DROP_1 SEMALOOP(STORESEMA,0) SSEMAGOT3: %finish %if FREE EPAGES>0 %thenstart STOREX=QUICK EPAGE(0,X'10') %if MULTIOCP=YES %start; STORESEMA=-1; %finish ->ACTF %finish POUT_SRCE=ME!X'F' POUT_P2=0; ! CLEAR TO ZERO GET EPN=GET EPN+1 %if MULTIOCP=YES %start; STORESEMA=-1; %finish %if PAGEFREES<=1 %and GETEPN>=MPLEVEL+1-COM_NOCPS %then %c POUT_DEST=X'20000' %and PON(P) POUT_DEST=X'50000' PON(POUT) ->RETURN !----------------------------------------------------------------------- ACTIVITY(15): ! REPLY FROM GET EPAGE ! WITH PAGE FOR LOCKED SEG TABLE STOREX=P_P2 %if STOREX=0 %then ALLOUTP_DEST=-1 %and ->DEAD ! DEADLOCK PAGE. DIR WILLTRY AGN ACTF: LOCKSTX=STOREX LOCKST=LOCKSTX*PAGESIZE %if XA=YES %then LCTABLES_LCPTABLE(15)=LOCKST %else %c LCTABLES_LCHPTABLE(15)<-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'! %c (LTAD-LOCKSTVAD+LOCKST) %finish %finishelsestart; ! 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 %if XA=YES %then LCTATBLES_LCPATBLE(15)=-1 %else %c LCTABLES_LCHPTABLE(15)=-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 %thenstart *STPT_TIMER1 %finish RETURN EPAGE(POUT) %if MONLEVEL&12=12 %thenstart *STPT_TIMER2 RETIT=RETIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 RETCALLN=RETCALLN+1 %finish LOCKST=0 %finish %finish PT==ARRAY(ASPTVAD(TST(VSSEG)),PTF) J=ALLOUTP_P6-VSSEG<<18 %cycle VSEPAGE=J>>12,1,(J+ALLOUTP_P5-1)>>12 %if ALLOUTP_P1>0 %then K=PT(VSEPAGE) %else K=-1 %if XA=YES %thenstart 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 %finishelsestart 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 %thenstart *STPT_TIMER1 %finish PAGETURN(POUT) %if MONLEVEL&12=12 %thenstart *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 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): ! EXIT TO NOMINATED ENV(SAME STK) ! ALLOUTP_P1-5==LNB->SF ->FREACT !----------------------------------------------------------------------- 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 !----------------------------------------------------------------------- %integerfn CHECKDA(%integer DA) !*********************************************************************** !* CHECKS A DISC ADDRESSAND REPLIES AS FOLLOWS * !* RESULT=0 ADDRESS NOT ACTIVE * !* RESULT=1 TRANSFERS OR CLEARS IN PROGRESS * !* RESULT<0 OTHER USERS OF SAME * !*********************************************************************** %record (PARMF) POUT POUT_DEST=X'80005' POUT_P1=DA %if MONLEVEL&12=12 %thenstart *STPT_TIMER1 %finish ACTIVE MEM(POUT) %if MONLEVEL&12=12 %thenstart *STPT_TIMER2 AMIT=AMIT+(TIMER1-TIMER2)>>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 AMCALLN=AMCALLN+1 %finish %result=POUT_DEST %end %integerfn CHECK RES(%integer WRIT,LEN,AD) !*********************************************************************** !* CHECKS THAT THE AREA OF LEN AT AD IS LOCKED DOWN AND ORS WRIT * !* INTO THE WRITE MARKER IN THE 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 %thenstart; ! PREVIOUS SEGMENT %if CBT_TAGS&CONTINUATN BLK=0 %thenreturn 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 ROD 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 %c 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 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 %integer MARK,VSSEG,VSEPAGE,SH,CBTP,ASB,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) 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 ROD 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 %c 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 %thenstart 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 %thenstart *STPT_TIMER1 %finish ACTIVE MEM(POUT) %if MONLEVEL&12=12 %thenstart *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 %if XA=YES %start LST(VSSEG)=LST(VSSEG)!X'20'; ! NOW MARKED AS INVALID %else LST(VSSEG)=LST(VSSEG)!1 %finish AS(ASI,ASP)=0 %for ASI=0,1,SEGLEN>>1 ASEG(ASP)=0; ! FOR DUMP CRACKING ! NOT OTHERWISE NEEDED ASPTVAD(ASP)=-1 TST(VSSEG)=127 ASB=TOPBIT>>ASP ASWAP=ASWAP&(\ASB) ASWIP=ASWIP&(\ASB) ASSHR=ASSHR&(\ASB) ASFREE=ASFREE!ASB %if XA#AMDAHL %start; ! OTHER HAVE NO PURGE PAGE *PTLB_0(0); ! UTILISE THE BLUNDERBUSS %finish %end !----------------------------------------------------------------------- %routine STROBE(%integer SFLAGS) !*********************************************************************** !* WHIP THROUGH ALL THE ACTIVE PAGES IN EACH ACTIVE SEGMENT * !* ANY PAGES NOT REFERNECED ARE PAGED OUT. THE REFERENCE BITS ARE * !* CLEARED IN CASE THIS PAGES IS NOT USED FURTHER. * !* A CRITICAL ROUTINE FOR PERFORMANCE HENCE HAND CODING * !* 2**0 OF SFLAGS SET FOR NOT CLEARING PT USE BITS * !* 2**1 OF SFLAGS NOT USED * !*********************************************************************** %record (CBTF) %name CBT %integer MARK,POFL,ASMASK,ASP,VSSEG,VSEPAGE,CBTP,EPMASK,ASB,PTAD,I,J,ASI,SEGLEN %if MONLEVEL&16#0 %thenstart %integer CAT %finish ASMASK=ASWAP; ! ALL SLOTS WITH ACTIVE PAGES ASP=-1 %if MONLEVEL&16#0 %thenstart 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 %elseif XA=AMDAHL %then %c SEGLEN=PTAD>>28 %else SEGLEN=0 %if CBTA(SST(VSSEG))_TAGS&ADVISORY SEQ#0 %thencontinue %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 ROD 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: %finishelseif XA=AMDAHL %start; ! KEYS GANGED IN PAIRS *ISK_0,2; *ST_0,MARK *TM_SFLAGS+3,1; *BC_1, *RRB_0(2) *PUT_X'B2F0'; *PUT_X'2000'; ! PURGE PAGE 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 %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 %c 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 %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 AS(ASI,ASP)=AS(ASI,ASP)&(\(TOPBIT>>(VSEPAGE&31))) %finish %repeat %repeat J=AS(0,ASP) J=J!AS(ASI,ASP) %for ASI=1,1,SEGLEN>>1 %if J=0 %thenstart ASB=TOPBIT>>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 %elseif XA=AMDAHL %then %c SEGLEN=PTAD>>28 %else SEGLEN=0 %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 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 ROD 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 %c 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 %thenstart EPN=EPN-1 %if CBT_TAGS&SMULTIPLE CON=0 %then UEPN=UEPN-1 %finish %repeat AS(ASI,ASP)=0 %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 ! J=ASWIP&(\ASSHR); ! ONLY PRIVATE SEGMENTS %cycle I=MAXRESIDENCES-1,-1,0 J=J&OLD ASWIPS(I) %if I>4<<20>>8 %finish W1=CONTEXT_CPUTIMER>>12&X'3FF' W1=FLAG<<28!(ACNT_LTIME<<10-W1) PVAD0=RTV(RAD0) AD=INTEGER(PVAD0); ! FILE RELATIVE OFFSET OF NEXT RECORD %if AD>12)&X'7FFFFFC0' %else RAD1=SHORTINTEGER(J+AD>>12)>>4<<20>>8 %finish PVAD1=RTV(RAD1) INTEGER(PVAD1)=W1 INTEGER(PVAD1+4)=PARAM %finish J=RTV(-1); ! CLEAR THE RTV ENTRY %end %finish %routine CLEAR ACCESSED BITS !*********************************************************************** !* CALLED AFTER A "CHANGE CONTEXT" TO CLEAR THE USED BITS ON EACH * !* PAGE ACTUALLY IN CORE. THEREAFTER A STROBE OR EXTRA STROBE WILL * !* DISCARD ANY PAGES FROM THE OLD CONTEXT WITHOUT BOUNCING PROCESS * !*********************************************************************** %integer ASMASK,VSEPAGE,ASP,I,PTAD,ASI,SEGLEN,EPMASK,MARK,VSSEG ASMASK=ASWAP; ! ACTIVE SLOTS WITH ACTIVE PAGES ASP=-1 %while ASMASK#0 %cycle; ! FOR EACH ACTIVE SEGMENT ASP=ASP+1 %and ASMASK=ASMASK<<1 %while ASMASK>0 ASP=ASP+1 ASMASK=ASMASK<<1 VSSEG=ASEG(ASP) PTAD=LST(VSSEG) %if XA=YES %then SEGLEN=PTAD&15 %elseif XA=AMDAHL %then %c 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 ROD 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&31 I=1<>12 LCIT=LCIT-(TIMER1-TIMER2)>>12 RETCALLN=RETCALLN+1 %finish %repeat %end !----------------------------------------------------------------------- %integerfn 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 %thenstart K=LOCSN0+J*MAXPROCS DACT=ALLOUTP_DEST&X'FFFF' %unless J=3 %and (DACT=0 %or DACT=X'FFFF') %thenstart %cycle I=1,1,MAXPROCS-1 %if USER=PROCA(I)_USER %and PROCA(I)_INCAR=INCAR %then %c ALLOUTP_DEST=(I+K)<<16!DACT %andresult=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 %integerfn DXR(%longlongrealname TOP, %longlongreal BOTTOM) %integername PSW2 %integer OLD,NEW %longreal X %longlongreal 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 %if X=0 %then ->FAIL APPROX=1.0/X 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=1 %end !----------------------------------------------------------------------- %end !----------------------------------------------------------------------- !----------------------------------------------------------------------- %end !*********************************************************************** !* THESE THREE ROUTINES ARE SYTEMCALLED DIRECTLY FROM USER * !*********************************************************************** %externalintegerfn REQUEST INPUT(%integer OUTPUT POSN,TRIGGER POSN) %unless IOSTAT_OUTBUFLEN>0 %and 0<=OUTPUT POSN0 %and 0<=TRIGGER POSN0 %and 0<=OUTPUT POSN