%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
      %integer IT,IC
      %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
         *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
      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
      %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<SRCE>>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
            {SAVE INTERVAL TIMER}
         %finish
         PDISC(TDISC)
         %if MONLEVEL&12=12 %thenstart
            PDISCCALLN=PDISCCALLN+1
            {RESET ITIMER AND ACCOUNT CORRECTLY FOR CALLED ROUTINE}
         %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
         {SAVE INTERVAL TIMER}
      %finish
      RETURN EPAGE(P)
      %if MONLEVEL&12=12 %thenstart
         RETCALLN=RETCALLN+1
         {RESET ITIMER AND ACCOUNT CORRECTLY FOR CALLED ROUTINE}
      %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
               {SAVE INTERVAL TIMER}
            %finish
            ACTIVE MEM(P)
            %if MONLEVEL&12=12 %thenstart
               AMCALLN=AMCALLN+1
               {RESET ITIMER AND ACCOUNT CORRECTLY FOR CALLED ROUTINE}
            %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
%endoffile