%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 %if MONLEVEL&4#0 %start I=ADDR(LCTABLES_CONTEXTS(0)) *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 %if MONLEVEL&4#0 %start I=ADDR(LCTABLES_CONTEXTS(0)) *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 %if MONLEVEL&4#0 %start I=ADDR(LCTABLES_CONTEXTS(0)) *L_1,I; *SPT_168(1); ! TO TIME LOCAL CONTROLLER %finish PEPARM=PAGE0_PE CODE&127 %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 2<=PROC_STACK<=3 %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 *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 2<=PROC_STACK<=3 %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 ASPTVAD(ASP)=PTVAD 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 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 %finish %else %if TSTPTR=127 %or ASPTVAD(TSTPTR)=-1 %then 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) %else %c NONSEQVSIS=NONSEQVSIS+1 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 2<=PROC_STACK<=3 %and 1<ILLEGAL OUT ! ALLOWS OUT 0,1,3,6,8,10,12,13,14,15 ! 16,19,20,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=0; ! PRESERVE EVERYTHING 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=1; ->DOUT0; ! DESTROY ALL (REMAINING) FILES DIROUT(1): ! PRINT STRING FOR DIRECTOR %if ALLOUTP_DEST>>24>31 %then ->FREACT PRINT STRING(STRING(ADDR(ALLOUTP_DEST))) ->REACT !----------------------------------------------------------------------- DIROUT(2): ! INPUT REQUEST MESSAGE %if ALLOUTP_P3#IOSTAT_IAD %then ->ACTIVATE; ! INPUT ALREADY HERE POUT=ALLOUTP POUT_DEST=X'00370006' POUT_SRCE=LSN3<<16!1 PON(POUT) SRCE=X'80000000'!LSN3; ! TOP BIT SET FOR INPUT WAIT ->SUSPWS !----------------------------------------------------------------------- DIROUT(3): ! DISCONNECT SEGMENT ! ALLOUTP_P1=SEG, P2#0 DESTROY VSSEG=ALLOUTP_P1 ->FREACT %unless 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 %unless 0<=DESTFREACT %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 %if 2<=PROC_STACK<=3 %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 %unless 0<=DESTFREACT %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 ->DIRPONS %unless ALLOUTP_DEST=X'370007' 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 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#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; ! DESTROY FLAG %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 *PTLB_0(0) %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) 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 !----------------------------------------------------------------------- %endoffile