%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
         %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
      %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
         *BALR_1,0; *USING_1
         *SR_0,0; *LR_2,0; *BCTR_2,0
         *CS_2,0,STORESEMA
         *BC_8,<SSEMAGOT>
         *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<PS>>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}
         *BALR_1,0; *USING_1
         *SR_0,0; *LR_2,0; *BCTR_2,0
         *CS_2,0,STORESEMA
         *BC_8,<USESPARE>
         *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
         *BALR_1,0; *USING_1
         *SR_0,0; *LR_2,0; *BCTR_2,0
         *CS_2,0,STORESEMA
         *BC_8,<SSEMAGOT>
         *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
         %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
      %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
         *BALR_1,0; *USING_1
         *SR_0,0; *LR_2,0; *BCTR_2,0
         *CS_2,0,STORESEMA
         *BC_8,<SSEMAGOT>
         *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<P_P5>>16<=LOCSN1) %or %c
            LOCSN0<P_SRCE>>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<MAX OVERALLOC %then %c
         OVERALLOC=OVERALLOC+K %and UNALLOCEPS=UNALLOCEPS+K
%end
%endoffile