         SYSTEM   UTS
TXTC     CNAME
         PROC
         LOCAL    I,VEC
LF       EQU      %
VEC      SET      NUM(S:UT(AF)),S:UT(AF)
I        DO       (NUM(VEC)+3)/4
         GEN,8,8,8,8  VEC(I*4-3),VEC(I*4-2),VEC(I*4-1),VEC(I*4)
         FIN
         PEND
DEBUG    SET      0
NDEBUG   SET      1
*
         DEF      DATA,PPS
         DEF      PATCH
         REF      MDYNRESDF,DYNRESDF,RESDF,RESDFP
         REF      PPTABLE,PPTABLSZ,S:PCORE,S:ACORE
         REF      PP:UPPH,PP:UPPT,PP:UPPC,MX:PPUT
         REF      CRESDF,UH:FLG2
         REF      T:GPP,JB:PPC
         REF      HIGH,JX:CMAP,T:RVSPI,T:FPP,FPMC
         REF      MP:UPPH,PWPTABLE,PWPEND
         REF      S:BUIS,S:OUIS,MAXG,SB:GJOBUN,MING,T:TOTSZ,S:CUN
*
DATA     EQU      %
         BOUND    8
DDPGS    DATA     0,0               DYNAMIC DATA  1ST PG / # OF PGS
CPAGES   DATA     0,0               FIRST/LAST PAGE OF CURRENT SEGMENT
PGCNT    DATA     0                 # OF PAGES LEFT IN THIS SEGMENT
PGCNT2   DATA     0                 ORIGINAL # OF PAGES IN THIS SEGMENT
ENTRY    DATA     0                 PPTABLE FORMAT
CENTRY   DATA     0                 INDEX INTO PPTABLE
WAITCT   DATA     0
PP:RPPH  DATA     0                 HEAD OF UNUSED STOLEN PAGES
PP:RPPT  DATA     0                 TAIL OF UNUSED STOLEN PAGES
PP:RPPC  DATA     0                 COUNT OF UNUSED STOLEN PAGES
*
DM1      TXTC     '     MAXIMUM DYNRESDF = YYY',X'15'
DM2      TXTC     '     CURRENT DYNRESDF = YYY',X'15'
DM3      TXTC     '     DYNRESDF SEGMENT   YYY  XXXXX',X'15'
DM4      TXTC     '     RESDF SEGMENT      YYY  XXXXX',X'15'
DM5      TXTC     '     MAXIMUM USER CORE = YYY',X'15'
DYM1     TXTC     X'15','PPS:  CURRENT DYNRESDF PAGES > NEW MAXIMUM'
GMSG1    TXTC     X'15','PPS: EXCEEDS MAXIMUM DYNRESDF '
GMSG2    TXTC     X'15','PPS:  PAGES ARE REAL-TIME PAGES'
GMSG3    TXTC     X'15','PPS:  MAXIMUM DYNRESDF SEGMENTS ALLOCATED'
GMSG4    TXTC     X'15','PPS:  UNABLE TO OBTAIN PAGES'
GMSG5    TXTC     X'15','PPS:  PAGES IN USE BY MONITOR'
RSMSG1   TXTC     X'15','PPS:  NO RESDF PAGES ALLOCATED'
RSMSG2   TXTC     X'15','PPS:  RESDF PAGES ALREADY ALLOCATED'
FMSG1    TXTC     X'15','PPS:  NOT A DYNRESDF MEMORY SEGMENT'
*
*
QUEST    TXTC     'PPS:  ?? ',X'15'
NL       DATA     X'01150000'
*
*
MSG1     TXTC     X'15','PPS: MUST BE EXECUTED AS A GHOST JOB'
MSG2     TXTC     X'15','PPS:  ENTER COMMAND: '
MSG3     TXTC     X'15','PPS:  EXPRESS # OF PAGES IN DECIMAL  0-999'
MSG4     TXTC     X'15','PPS:  EXPRESS PG ADDR IN HEX  10000-XXXXX'
MSG5     TXTC     X'15','PPS:  INSUFFICIENT PRIVILEGE'
MSG6     TXTC     X'15','PPS:  SYSTEM IS ACTIVE'
MSG7     TXTC     X'15','PPS: DONT LOCK OUT SYSTEM GHOSTS'
ERRMSG   TXTC     X'15','PPS:  PPS DETECTED ERROR'
*
XCONFPT  GEN,12,20 X'198',XCON
*
TRAPFPT  DATA     X'14000000'       IGNORE ARITHMETIC TRAP
         DATA     X'00000003'        WHEN IN MASTER MODE
*
TYPFPT   DATA     X'02000000'       M:TYPE
         DATA     X'80000000'       PLIST
         DATA     X'8000000F'       MSG ADDRESS IN R15
*
TYPNL    DATA     X'02000000'       M:TYPE
         DATA     X'80000000'       PLIST
         DATA     NL
*
CMDFPT   DATA     X'04000000'       M:KEYIN
         DATA     X'F0000000'       PLIST
         DATA     MSG2              'ENTER COMMAND'
         DATA     REPLY             BUFFER FOR REPLY
         DATA     19                SIZE OF REPLY
         DATA     ECB               ECB
*
WAITFPT  DATA     X'0F000001'
*
VPFPT    DATA     X'04000000'
GPFPT    DATA     X'080000FF'
FPFPT    DATA     X'090000FF'
GPFPT2   DATA     X'88000000'       # OF PAGES IN R0
*
*
*
PSTACK   DATA     0                 TEMP STACK ADDRESS
REPLY    DATA     0,0,0,0,0         BUFFER FOR KEYIN COMMAND
ECB      DATA     0
BUFPTR   DATA     0                 INDEX INTO REPLY
*
*
*
*
RMABIT   DATA     X'0800'
RMABIT2  DATA     X'F7FF'
TEN      DATA     10
YFFFF    DATA     X'FFFF0000'
M16      DATA     X'FFFF'
M17      DATA     X'1FFFF'
         BOUND    8
ALFA     DATA     C'A',C'F'         FOR VALIDATING INPUT HEX
NUMR     DATA     C'0',C'9'           CHARACTERS
*
COMMANDS DATA,2   0,C'DI',C'GE',C'FR',C'DY',C'RE',C'EN'
         BOUND    4
#CMMDS   EQU      6
*
* DATA FROM ERROR CONDITIONS
*
SAVE15   DATA     0                 BAL,15 GSTERR
SAVEREGS RES      16
XCONC    DATA     0                 FOR RE-ENTRY
*
SYSFPT   DATA     X'08000000'
*
SNAPFPT  DATA     0
         DATA     X'80000000'
         DATA     X'80000001'
         TEXT     'SNAP1   '
         NOP
         B        SNAPIT+1
PATCH    RES      50
         PAGE
         CSECT    1
PPS      EQU      %
         STW,0    PSTACK
         DO       NDEBUG
*
* PPS MUST BE RUN AS A GHOST JOB
*
         LI,15    MSG1
         LC       X'8C00'
         BCR,4    PPSABT
*
* GO MASTER MODE
*
         CAL1,6   SYSFPT            GO MASTER MODE
         BCR,8    %+4
         LI,15    MSG5              = INSUFFICIENT PRIV
PPSABT   CAL1,2   TYPFPT
         CAL1,9   1
         FIN
* SET UP HIGH IN ERR MSG
*
         LW,1     HIGH
         SLS,1    21                WORD ADDR OF LAST PG(LEFT JUSTIFIED)
         LI,2     38                INDEX INTO MSG
         LI,3     5                 # OF CHARACTERS
         LI,15    MSG4              ADDR OF MSG
         BAL,4    CVTBCD            CONVERT AND STORE IN MSG
*
* SET UP TRAP CONTROL, EXIT CONTROL
*
         CAL1,8   TRAPFPT           IGNORE ARITHMETIC TRAPS
         CAL1,8   XCONFPT           GET XIT CONTROL
         PAGE
*
* ASK OPERATOR FOR COMMANDS
*
GST1     EQU      %
         DO       DEBUG
         REF      M:FPPC
         LW,1     S:ACORE
         AW,1     DYNRESDF
         AW,1     RESDF
         CI,1     X'C0'
         BE       %+2
         BAL,15   GSTERR
         LW,1     M:FPPC
         AW,1     DYNRESDF
         AW,1     RESDF
         CI,1     X'C0'
         BE       %+2
         BAL,15   GSTERR
         LW,1     S:PCORE
         AW,1     MDYNRESDF
         AW,1     RESDF
         CI,1     X'B9'
         BE       %+2
         BAL,15   GSTERR
         FIN
         LI,1     0
         STW,1    WAITCT
         CAL1,2   CMDFPT            M:KEYIN
         CAL1,8   WAITFPT           M:WAIT
         MTW,0    ECB               WAIT FOR ANSWER
         BLZ      %-2
         LI,0     0                 TO ZAP EOM
         LB,1     REPLY             FIND WHERE IT IS
         STB,0    REPLY,1           ZAP IT
         LI,4     1                 SET INITIAL INDEX INTO REPLY
         STW,4    BUFPTR
         LI,14    0                 INDICATE CHARACTER INPUT
         BAL,1    CVTHEX            BUMP POINTER PAST COMMAND KEY WORD
         NOP
GST2     LW,1     REPLY             PICK FIRST WORD
         SLS,1    -8                JUST LOOK AT 1ST 2 CHARACTER
         OR,1     YFFFF             FOR CH SIGN EXTENSION
         LI,2     #CMMDS
         CH,1     COMMANDS,2        LOOK FOR MATCH
         BE       GST3,2            GOT IT
         BDR,2    %-2               KEEP LOOKING
TYPQUEST LI,15    QUEST             M:TYPE QUESTION MARKS
TRYAGAIN CAL1,2   TYPFPT
         B        GST1
GST3     B        %                 NO 'ZERO' ENTRY
         B        DISPLAY
         B        GET
         B        FREE
         B        DYNRESDFX
         B        RESDFX
         CAL1,9   1                 END
         PAGE
DISPLAY  EQU      %
         CAL1,2   TYPNL
*
*   MAXIMUM DYNRESDF = YYY
*
         LI,15    DM1               ADDR OF MESSAGE
         LW,1     MDYNRESDF         VALUE TO CONVERT
         BAL,5    DSPLY
*
*  CURRENT DYNRESDF = YYY
*
         LI,15    DM2
         LW,1     DYNRESDF
         BAL,5    DSPLY
         CAL1,2   TYPNL
*
*  DYNRESDF/RESDF SEGMENT  YYY  XXXXX
*
         LI,7     PPTABLSZ          FOR BDR LOOP
         LI,15    DM3               ADDR OF DYNRESDF MSG
DISPLAY1 LW,1     PPTABLE-1,7       GET ENTRY
         CI,7     1                 IS IT THE RESDF ENTRY
         BNE      DISPLAY2          NO
         CAL1,2   TYPNL
         LI,15    DM4               ADDR OF RESDF MSG
         B        DISPLAY3          DISPLAY EVEN IF = 0
DISPLAY2 LW,1     1                 IS DYNRESDF ENTRY NULL
         BEZ      DISPLAY4          YES-DONT PRINT
DISPLAY3 AND,1    YFFFF
         SLS,1    5                 LEFT JUSTIFY WA(1ST PAGE)
         LI,2     30                INDEX INTO MSG
         LI,3     5                 # OF CHARACTERS TO CONVERT
         BAL,4    CVTBCD            CONVERT/STORE IN MSG
         LW,1     PPTABLE-1,7       GET # OF PAGES
         AND,1    M16
         BAL,5    DSPLY             CONVERT/STORE/PRINT MSG
DISPLAY4 BDR,7    DISPLAY1          OUTPUT REST OF PPTABLE
*
*  MAXIMUM USER CORE = YYY
*
         CAL1,2   TYPNL
         LI,15    DM5               ADDR OF MSG
         LW,1     S:PCORE
         LI,2     28                INDEX INTO MSSG
         BAL,5    DSPLY2            CONVERT/STORE/PRINT MSG
         B        GST1              GET NEXT COMMAND
*
*
DSPLY    LI,2     27                INDEX INTO DYNRESDF LIMIT MSGS
DSPLY2   EQU      %
         LI,3     3                 # OF CHARACTERS TO CONVERT
         BAL,4    CVTDBCD           CONVERT AND STORE IN MSG
         CAL1,2   TYPFPT            TYPE MESSAGE
         B        0,5
         PAGE
DYNRESDFX EQU     %
         LI,14    -1                INDICATE DECIMAL VALUE
         LI,15    MSG3              FOR ERROR RETURN
         BAL,1    CVTHEX            GET # OF PAGES
         B        TRYAGAIN          TYPE MSG-GET COMMAND
         CI,6     0                 WAS THERE ANY INPUT
         BE       TYPQUEST          BAD FORMAT
         CI,3     0                 OR TOO MUCH INPUT
         BNE      TYPQUEST          YES
         CI,2     999               TRYING TO GET GREATER THAN MAX
         BG       TRYAGAIN          YES
         CW,2     MDYNRESDF         INCREASE OR DECREASE
         BG       DYN3              INCREASE
*
* DECREASING MDYNRESDF
*
         LI,15    DYM1              > ALLOC. ERROR MSG
         CW,2     DYNRESDF          IS DECREASE BELOW CURRENT ALLOCATIONN
         BL       TRYAGAIN          YES-DONT RESET MDYNRESDF
         LW,3     MDYNRESDF         FIND AMOUNT OF DECREASE
         SW,3     2
         AWM,3    S:PCORE           INCREASE USER SIZE
         STW,2    MDYNRESDF         SET NEW MAXIMUM
         B        GST1              GET NEXT COMMAND
*
* INCREASING MDYNRESDF
*
DYN3     EQU      %
         LW,3     S:PCORE           FIND NEW PCIRE SIZE
         AW,3     MDYNRESDF
         SW,3     2
         BAL,11   CHKUSRS           IS NEW PCORE SIZE OK
         B        TRYAGAIN
         STW,3    S:PCORE           YES-USE IT
         STW,2    MDYNRESDF         AND RESET MAXIMUM DYNRESDF
         B        GST1
         PAGE
RESDFX   EQU      %
         BAL,11   GETFREE           SET UP REGISTERS
         LW,7     PGCNT             IS THIS RELEASE
         BNEZ     RSDF2             NO-RESTORE RESDF
         LI,15    RSMSG1            =NO RESDF PAGES ALLOCATED
         LW,0     PPTABLE           IS RESDF ALLOCATED
         BEZ      TRYAGAIN          NO-NOTHING TO RELEASE
         SLD,0    -16               SET UP R0-R1
         SLS,1    -16
         STW,1    PGCNT
         STW,1    PGCNT2
         AW,1     0
         AI,1     -1
         STD,0    CPAGES
         BAL,5    RELPG             GO RELEASE THEM
         BAL,15   GSTERR
         LW,0     PGCNT2
         AWM,0    S:PCORE           INCREASE USER SIZE
         LI,0     0
         STW,0    PPTABLE           ZAP PPTABLE RESDF ENTRY
         XW,0     RESDF
         STW,0    CRESDF
         B        GST1
*
* RESTORE THE RESDF MEMORY SEGMENT
*
RSDF2    LI,15    RSMSG2            =RESDF ALREADY ALLOCATED
         LW,5     PPTABLE           IS IT ALREADY ALLOCATED
         BNEZ     TRYAGAIN          YES
         STW,2    RESDFP            RESET 1ST PAGE
         LW,5     PGCNT              AND # OF RESDF PAGES
         STW,5    RESDF
         LW,3     S:PCORE           FIND NEW PCORE SIZE
         SW,3     5
         BAL,11   CHKUSRS           IS NEW PCORE OK
         B        TRYAGAIN
         STW,3    S:PCORE
         LI,7     0                 INDEX TO RESDF IN PPTABLE
         BAL,11   GETPGS            GO GET THEM
         B        RSDF3             DIDNT GET THEM
         B        GST1              GOT THEM-ALL OK
RSDF3    LI,1     0
         XW,1     RESDF             INDICATE NONE ALLOCATED
         AWM,1    S:PCORE
         B        TRYAGAIN
         PAGE
*
* DETERMINE IF PCORE MAY BE RESET
*
*  BAL,11 CHKUSRS
*  ERROR RETURN
*  NORMAL RETURN
*
* INPUT  R3=NEW PCORE SIZE
*
CHKUSRS  LI,15    MSG6              = SYSTEM IS ACTIVE
         DO1      NDEBUG
         DISABLE
         LW,6     S:BUIS            ANY BATCH USERS
         BNEZ     CKUS4             YES
         LW,6     S:OUIS            ANY ON-LINE USERS
         BNEZ     CKUS4             YES
         LI,6     MAXG              TO CHECK FOR GHOST USERS
CKUS2    LB,4     SB:GJOBUN,6       GET GHOST JOB USER #
         BNEZ     CKUS5             AND GO CHECK IT
CKUS3    BDR,6    CKUS2             CHECK ALL GHOSTS
         AI,11    1                 ALL OK
CKUS4    EQU      %
         DO1      NDEBUG
         ENABLE
         LD,0     CPAGES            RESTORE 1ST-LAST PAGE
         B        *11
*
*
CKUS5    CI,4     MING              IS THIS A SYSTEM GHOST
         BLE      CKUS6             YES
         CW,4     S:CUN             OR PPS
         BNE      CKUS4             NO
CKUS6    BAL,7    T:TOTSZ           RETURN WITH R0=USER SIZE
         CW,4     S:CUN             IS THIS PPS
         BNE      %+2               NO
         AI,0     2                 SO I CAN GET SOME DYNAMIC DATA
         LI,15    MSG7              = LOCKS OUT SYSTEM GHOSTS
         SW,0     1                 FOR OVERLAYS
         CW,0     3                 SIZE : NEW PCORE
         BG       CKUS4             WONT FIT
         LI,15    MSG6              = SYSTEM ACTIVE
         B        CKUS3
         PAGE
GET      EQU      %
         BAL,11   GETFREE
         LI,15    GMSG1             =MAX DYNRESDF ALLOCATED
         LW,2     PGCNT
         AW,2     DYNRESDF          FIND WHAT TOTAL WOULD BE
         CW,2     MDYNRESDF         WOULD IT BE > MAX
         BG       TRYAGAIN          YES
         LI,15    GMSG3             =ALL DYNAMIC SEGS ALLOCATED
         LI,7     PPTABLSZ-1        # OF DYNRESDF SEGS
         MTW,0    PPTABLE,7         IS THIS A FREE ENTRY
         BEZ      %+3               YES-USE IT
         BDR,7    %-2               NO-KEEPLOOKING
         B        TRYAGAIN          TYPE MSG-GET COMMAND
         BAL,11   GETPGS            GO GET THEM
         B        TRYAGAIN          DIDNT GET THEM
         LW,0     PGCNT2
         AWM,0    DYNRESDF          BUMP COUNT
         B        GST1
         PAGE
* BAL,11  GETPGS
* ERROR RETURN
* NORMAL RETURN
*
* INPUT  R0/R1 = 1ST PAGE/LAST PAGE
*        R7 = INDEX TO PPTABLE
*
* OUTPUT  R15 = ERR MESSAGE ADDRESS (IF PGS NOT OBTAINED)
*
GETPGS   EQU      %
         BAL,4    CHKRTPG           SEE IF THEY ARE ALREADY STOLEN
         B        *11               YES
         PSW,11   *PSTACK           SAVE RETURN
         STW,7    CENTRY
GET1     EQU      %
         BAL,6    GETDD
         BAL,6    STEALPGS
         B        GET2              DIDNT GET THEM ALL
*
* GOT ALL THE PAGES
*
GET15    EQU      %
         LW,7     CENTRY
         LW,0     ENTRY             GET PPTABLE ENTRY
         STW,0    PPTABLE,7         STORE IT
         LW,1     *PSTACK
         MTW,1    *1                BUMP RETURN
         B        GET6              FREE DYNAMIC DATA
*
* CANT GET ALL PAGES IN THIS SET OF DYNAMIC DATA
*
GET2     EQU      %
         BAL,11   STEALFP           FIND THEM IN FREE PAGES
         MTW,0    PGCNT             GET THEM ALL
         BEZ      GET15             YES
         MTW,1    WAITCT
         LW,10    WAITCT
         CI,10    5                 HAVE WE TRIED LONG ENOUGH
         BG       GET3              YES
         CAL1,8   WAITFPT           SWAP-GET NEW PAGES
         B        GET1
*
* MUST CAUSE SHARED PROCESSORS TO BE OUTSWAPPED
*
GET3     EQU      %
         LI,11    GET4
         PSW,11   *PSTACK
         B        GET6              GET RID OF DYNAMIC DATA
GET4     BAL,11   STEALFP           BECAUSE WE DONT WANT TO LOOK AT THEEM AGAIN
         MTW,0    PGCNT             GET THEM
         BEZ      GET15             YES
         BAL,7    T:TOTSZ           R0= PPS SIZE
         LW,1     S:ACORE
         SW,1     0                 # OF DD PGS NOW AVAILABLE
         BLEZ     GET5              MUST GIVE UP
         CAL1,8   GPFPT2            # OF PAGES IN R0
         BAL,6    GETDD2            SET UP POINTERS
         BAL,6    STEALPGS          TRY TO GET THEM
         B        GET3              DIDNT GET THEM ALL YET
         BAL,11   FREERPP           GIVE BACK UNUSED STOLEN PAGES
         B        GET15             GOT THEM ALL
*
* CANT GET THE PAGES
*
GET5     BAL,11   FREERPP           GIVE BACK UNUSED STOLEN ONES
         LW,6     PGCNT2
         SW,6     PGCNT             RESTORE PGCNT
         STW,6    PGCNT
         BEZ      %+3
         BAL,5    RELPG             GIVE BACK ANY WE DID GET
         BAL,15   GSTERR
         LI,15    GMSG4             = UNABLE TO OBTAIN PGS
GET6     BAL,6    GETDD             FILL UP HOLES
         CAL1,8   FPFPT             GET RID OF DYNAMIC DATA
         LI,1     0
         STW,1    DDPGS             INDICATE NO DYNAMIC DATA
         PLW,11   *PSTACK
         B        *11               ERROR RETURN
         PAGE
*
* ROUTINE TO STEAL THE PAGES FROM THE SYSTEM
*
*        BAL,6    STEALPGS
*        RETURN IF PAGES NOT IN DYNAMIC DATA
*        RETURN IF ALL PAGES WERE STOLEN
*
STEALPGS EQU      %
         PSW,6    *PSTACK           SAVE RETURN
         BAL,6    LOCK
         LD,0     CPAGES
STLPGS2  LCI      2
         LM,7     DDPGS             RESTORE LL AND SIZE OF DYNAMIC DATA
STLPGS3  LOAD,3   JX:CMAP,7         GET THE PP NUMBER
         CLR,0    3                 IS THIS A PAGE WE WANT
         BCR,6    STLPGS5           YES
STLPGS4  AI,7     1                 SET TO LOOK AT NEXT PAGE
         BDR,8    STLPGS3
         BAL,6    UNLOCK
         PLW,6    *PSTACK           DIDNT GET THEM THIS PASS
         B        0,6
*
* GET THE PAGE OUT OF THE MONITORS CHAIN
*
STLPGS5  EQU      %
         DO       DEBUG
* CHECK FOR ALREADY IN STOLEN CHAIN SINCE I REALLY CANT SAVE PP
         LW,4     PP:UPPH
CHKSV    BEZ SAVEOK
         CW,3     4
         BE       STLPGS4           ALREADY IN STOLEN CHAIN
         LOAD,4   MX:PPUT,4
         B        CHKSV
SAVEOK   EQU      %
* END PHONEY TESTING CODE
         FIN
         PSW,8    *PSTACK           SAVE # OF PAGES LEFT
         LCI      4
         PSM,0    *PSTACK
         BAL,11   T:RVSPI           VP IS IN R7
         LCI      4
         PLM,0    *PSTACK
         PLW,8    *PSTACK
         MTW,-1   S:ACORE
         BAL,11   PUTCHAIN          ADD TO RT PAGE CHAIN
         MTW,0    PGCNT             GOT THEM ALL
         BNEZ     STLPGS4
         BAL,6    UNLOCK
         PLW,6    *PSTACK
         B        1,6               GOT ALL REQUIRED PAGES
*
* ROUTINE TO ADD PAGE TO REAL-TIME PAGE CHAIN
*
PUTCHAIN EQU      %
         LI,4     0
         STORE,4  MX:PPUT,3         SET END OF CHAIN IN PPUT
         LW,4     PP:UPPT           USED TAIL
         BNEZ     STLPGS6           THIS IS NOT 1ST STOLEN PAGE
         STW,3    PP:UPPH           BUT IF SO, IS ALSO THE HEAD
         B        %+2
STLPGS6  STORE,3  MX:PPUT,4         LINK UP CHAIN
         STW,3    PP:UPPT           AND SET NEW TAIL
         MTW,1    PP:UPPC           COUNT OF STOLEN PAGES
         MTW,-1   PGCNT             SEE IF WE HAVE THEM ALL
         B        *11
         PAGE
*
* ROUTINE TO STEAL PAGES FROM MONITOR FREE PAGE CHAIN
*
STEALFP  EQU      %
         PSW,11   *PSTACK           SAVE RETURN
         LD,0     CPAGES
SFP10    BAL,2    T:GPP             STEAL FROM FREE CHAIN
         CI,3     0                 END OF CHAIN
         BE       SFP31             YES
         MTW,-1   S:ACORE           FOR SCHED
         CLR,0    3                 IS THIS A PAGE I WANT
         BCR,6    SFP20             YES
*
* PUT UNWANTED PAGE IN PP:RPP CHAIN
*
         LI,4     0
         STORE,4  MX:PPUT,3         SET END OF CHAIN IN PPUT
         LW,4     PP:RPPT           GET CURRENT TAIL
         BNEZ     %+3               NOT FIRST IN CHAIN
         STW,3    PP:RPPH           BUT IF SO IT IS ALSO THE HEAD
         B        %+2
         STORE,3  MX:PPUT,4         LINK UP CHAIN
         STW,3    PP:RPPT           SET NEW TAIL
         MTW,1    PP:RPPC           COUNT OF UNUSED STOLEN PAGES
         B        SFP10             GO GET NEXT PAGE IN FREE PG CHAIN
*
* PUT WANTED PAGE IN PP:UPP CHAIN
*
SFP20    BAL,11   PUTCHAIN          DO IT
         MTW,0    PGCNT             GOT THEM ALL
         BNEZ     SFP10             NO-KEEP LOOKING
SFP30    BAL,11   FREERPP           GIVE BACK THOSE WE DIDNT USE
SFP31    PLW,11   *PSTACK
         B        *11
         PAGE
*
* ROUTINE TO RETURN UNUSED STOLEN PAGES TO THE MONITORS FREE PAGE CHAIN
*
FREERPP  EQU      %
         LW,3     PP:RPPH           ANY STOLEN
         BEZ      *11               NO
FRPP2    LOAD,5   MX:PPUT,3         GET FORWARD LINK
         BAL,2    T:FPP             GIVE IT PACK
         MTW,1    S:ACORE
         MTW,-1   PP:RPPC
         LW,3     5                 ANY MORE TO RETURN
         BNEZ     FRPP2             YES
         MTW,0    PP:RPPC           CONSISTENCY CHECK
         BEZ      %+2
         BAL,15   GSTERR
         LI,0     0
         STW,0    PP:RPPH           ZAP HEAD
         STW,0    PP:RPPT            AND TAIL
         B        *11               EXIT
         PAGE
*
* ROUTINE TO SEE IF PAGES ARE IN RT PAGE CHAIN
*
* BAL,4 CHKRTPG
* RETURN IF PAGES ARE IN CHAIN
* RETURN IF PAGES NOT IN CHAIN
*
* INPUT  R0=1ST PAGE
*        R1=LAST PAGE
*
CHKRTPG  EQU      %
         LI,15    GMSG2             = PGS ARE RT PGS
         LW,3     PP:UPPH           GET HEAD OF RT PAGE CHAIN
         BEZ      CHKMON            NONE IN CHAIN
CHKRTPG2 CLR,0    3                 IS RT PAGE ONE WE WANT
         BCR,6    0,4               YES-PG IN CHAIN
         LOAD,3   MX:PPUT,3         GET NEXT IN CHAIN
         BNEZ     CHKRTPG2          KEEP LOOKING
*                                   PAGES NOT IN RT CHAIN
*
* ROUTINE TO SEE IF THE MONITOR IS USING THE PAGE
*
CHKMON   EQU      %
         LI,15    GMSG5             = PGS IN USE BY MON
         LW,3     MP:UPPH           HEAD OF MONITOR UNMAPPED PGS
         BEZ      CHKMON3           NONE IN CHAIN
CHKMON2  CLR,0    3                 ARE WE AFTER A MONITOR PG
         BCR,6    0,4               YES
         LOAD,3   MX:PPUT,3         NEXT IN CHAIN
         BNEZ     CHKMON2           AND CHECK IT
*                                   NOT USED BY MON UNMAPPED ROUTINES
CHKMON3  LI,5     PWPTABLE          NOW CHECK FOR TP WORK PGS
         CI,5     PWPEND-1            IF ANY
         BE       1,4               NONE
CHKMON4  LOAD,3   *5                GET PG #--IF ANY
         CLR,0    3                 IS IT ONE WE WANT
         BCR,6    0,4               YES
         AI,5     1
         CI,5     PWPEND            MORE IN THE TABLE
         BG       1,4               NO-OK TO GET THE PAGE
         B        CHKMON4           YES-KEEP CHECKING
         PAGE
FREE     EQU      %
         BAL,11   GETFREE
         LI,7     PPTABLSZ-1        # OF DYNRESDF SEGMENTS
         LW,11    PPTABLE,7         GET TABLE ENTRY
         CW,11    ENTRY             IS IT A MATCH
         BE       FREE2             YES
         BDR,7    %-3               NO-KEEP LOOKING
         LI,15    FMSG1             =NOT DYNRESDF SEGMENT
         B        TRYAGAIN
FREE2    BAL,5    RELPG             GO RELEASE THEM
         BAL,15   GSTERR            ERROR
         LI,2     0
         XW,2     PPTABLE,7         ZAP PPTABLE ENTRY
         AND,2    M16               # OF PAGES
         LCW,2    2
         AWM,2    DYNRESDF          ADJUST CURRENT COUNT
         B        GST1
         PAGE
*
* REMOVE THE PAGES FROM THE CHAIN
*        BAL,5    RELP2
*        RETURN IF NOT ALL RELEASED
*        RETURN IF ALL RELEASED
*
RELPG    LW,3     PP:UPPH           GET FIRST STOLEN PAGE
         BEZ      0,5               ERROR
         LD,0     CPAGES
RELP3    CLR,0    3                 IS THIS PAGE TO BE RELEASED
         BCR,6    RELP4             YES
         LW,4     3                 SAVE BACKWARD LINK
         LOAD,3   MX:PPUT,3         GET FORWARD LINK
         BNEZ     RELP3              AND SEE IF WE SHOULD RELEASE IT
         B        0,5               ERROR
*
RELP4    CW,3     PP:UPPH           ARE WE RELEASING THE HEAD
         BNE      RELP7             NO
         LOAD,4   MX:PPUT,3         YES-GET FORWARD LINK
         STW,4    PP:UPPH           AND SET NEW HEAD
         BNEZ     %+2               THERE ARE MORE PGS IN THE CHAIN
RELP5    STW,4    PP:UPPT           RELEASING ONLY PAGE IN THE CHAIN
RELP6    BAL,2    T:FPP             RELEASE THE PAGE
         MTW,1    S:ACORE
         MTW,-1   PP:UPPC           # OF STOLEN PAGES
         MTW,-1   PGCNT             # OF PAGES THIS REQUEST
         BNEZ     RELPG             MORE TO RELEASE
         B        1,5               ALL RELEASED
*
RELP7    LOAD,6   MX:PPUT,3         FORWARD LINK
         STORE,6  MX:PPUT,4         LINKED TO BACKWARD LINK
         BNEZ     RELP6             NOT RELEASING TAIL
         B        RELP5             WE ARE RELEASING TAIL
         PAGE
*
* ROUTINE TO GET AS MUCH OF CORE AS POSSIBLE
*
*        BAL,6    GETDD             EXIT R7=LOWEST VP ACQUIRED
*                                        R8=NUMBER OF PAGES ACQUIRED
*
GETDD    EQU      %
         LCI      2
         LM,7     DDPGS
         LW,7     7                 DO I ALREADY HAVE DYNAMIC DATA
         BNEZ     FILLDD            YES-REPLACE ANY RELEASED PGS
         CAL1,8   GPFPT             M:GP 256
GETDD2   LW,8     8                 DID I GET ANY PAGES
         BNEZ     %+2
         BAL,15   GSTERR
         SLS,9    -9                LOWEST DD PAGE
         LW,7     9                 GET IT IN AN INDEX REGISTER
         LCI      2
         STM,7    DDPGS             REMEMBER HOW BIG WE ARE
         B        0,6
*
* FILL UP THE DYNAMIC DATA AREA
*
FILLDD   EQU      %
         LOAD,2   JX:CMAP,7
         CI,2     FPMC              DID WE STEAL THIS PAGE
         BE       FILLDD3
FILLDD2  AI,7     1                 LOOK AT NEXT PAGE
         BDR,8    %-4
         LCI      2
         LM,7     DDPGS
         B        0,6               DD AREA FULL
FILLDD3  LW,4     7                 PAGE TO GET
         SLS,4    9                 WORD ADDRESS
         LW,5     M17
         STS,4    VPFPT             SET UP THE FPT
         CAL1,8   VPFPT             REPLACE THE PAGE
         CI,8     0                 DID I GET THE PAGE
         BNE      FILLDD2           YES
         BAL,15   GSTERR            NO
         PAGE
*
* LOCK IN CORE
*
LOCK     EQU      %
         DO       NDEBUG
         LW,4     S:CUN
         DISABLE
         LH,2     UH:FLG2,4
         OR,2     RMABIT
         STH,2    UH:FLG2,4
         ENABLE
         FIN
         B        0,6
*
* UNLOCK IN CORE TO ALLOW SWAP
*
UNLOCK   EQU      %
         DO       NDEBUG
         LW,4     S:CUN
         DISABLE
         LH,2     UH:FLG2,4
         AND,2    RMABIT2
         STH,2    UH:FLG2,4
         ENABLE
         FIN
         B        0,6
         PAGE
*
* BAL,1 CVTHEX      TO GET DATA FROM OPERATOR AND CONVERT IT TO HEX
* ERROR RETURN
* NORMAL RETURN
*
* INPUT  R14 =0 CHARACTER INPUT
*            >0 HEX VALUE
*            <0 DECIMAL VALUE
*
*OUTPUT  R6 = # OF CHARACTERS
*        R2 = VALUE
*
CVTHEX   LI,2     0                 BUILD ANSWER IN R2
         LI,5     0                 BUILD DECIMAL ANSWER IN R5
         LI,6     0                 INITIALIZE # CHAR. COUNT
         LW,4     BUFPTR            CURRENT INDEX INTO REPLY
CVTHEX2  LB,3     REPLY,4           GET CHARACTER
         BEZ      CVTHEX4           NORMAL EXIT ON EOM
         AI,4     1                 BUMP INDEX INTO REPLY
         CI,3     C','              CHECK FOR DELIMITERS
         BE       CVTHEX4
         CI,3     C' '
         BE       CVTHEX4
         LW,14    14                WHAT TYPE OF INPUT
         BEZ      CVTHEX3           CHARACTER-DONT VALIDATE
         BLZ      %+3               DECIMAL  A-F IS ILLEGAL
         CLM,3    ALFA              VALIDATE HEX CHARACTER
         BCR,9    %+3               ITS A-F
         CLM,3    NUMR               OR 0-9
         BCS,9    0,1               ERROR
         AI,3     -X'F0'            CONVERT TO HEX
         LW,14    14                WHAT TYPE OF INPUT
         BLZ      CVTHEX5           DECIMAL
         CI,3     0
         BGE      %+2               0-9
         AI,3     X'39'             A-F
         SLS,3    28                TO BITS 0-2
         SLD,2    4                 BUILD ANSWER IN R2
CVTHEX3  AI,6     1                 COUNT # OF CHARACTERS
         B        CVTHEX2           GET NEXT CHARACTER
*
CVTHEX4  STW,4    BUFPTR            REMEMBER WHERE WE ARE
         B        1,1               NORMAL EXIT
*
CVTHEX5  MI,5     10                SHIFT PREVIOUS ANSWER
         AW,5     3                 SUM UP ANSWER
         LW,2     5                 ANSWER IN R2
         B        CVTHEX3           CONTINUE
         PAGE
*
* R1 = CHARACTERS TO CONVERT (LEFT JUSTIFIED)
* R2 = INDEX INTO MESSAGE
* R3 = # OF CHARACTERS TO CONVERT
* R4 = RETURN
* R15 = ADDRESS OF MESSAGE
*
CVTBCD   LI,0     0
         SLD,0    4                 GET CHARACTER
         AI,0     X'F0'             CONVERT
         CI,0     X'F9'
         BLE      %+2               0-9
         AI,0     -X'39'            A-F
         STB,0    *15,2             STORE IN MESSAGE
         AI,2     1                 BUMP INDEX INTO MESSAGE
         BDR,3    CVTBCD            GET NEXT CHARACTER
         B        0,4               EXIT
*
* R1 = VALUE TO CONVERT
* R2 = INDEX TO LAST CHARACTER OF MSG FIELD
* R3 = # OF CHARACTERS TO CONVERT
* R4 = RETURN
* R15 = ADDRESS OF MESSAGE
*
CVTDBCD  LI,0     0                 CLEAR ANSWER
         DW,0     TEN               R0=REMAINDER
         AI,0     X'F0'             CONVERT TO EBCDIC
         STB,0    *15,2             STORE IN MESSAGE
         AI,2     -1                BUMP INDEX
         BDR,3    CVTDBCD           GET NEXT DIGIT
         B        0,4               EXIT
         PAGE
*
* ROUTINE TO GET INPUT IN GET/FREE COMMAND
*
* OUTPUT          R0 = 1ST PAGE
*                 R1 = LAST PAGE
*                 R2 = WA(1ST PAGE)
*                 ENTRY = PPTABLE FORMAT
*                 PGCNT = # OF PAGES
*
GETFREE  EQU      %
         LI,14    -1                INDICATE DECIMAL VALUE
         LI,15    MSG3              = PGS IN DECIMAL 0-999
         BAL,1    CVTHEX            GET #PGS IN R2/R5
         B        TRYAGAIN          INPUT NOT DECIMAL
         CI,6     0                 ANY INPUT
         BNE      GF2               YES
         CI,11    RESDFX+1          IS THIS RESDF COMMAND
         BNE      TYPQUEST          NO-MUST SPECIFY # OF PAGES
         LW,2     CRESDF            YES-USE LATEST VALUE
GF2      CI,2     999               REASONABLE INPUT
         BG       TRYAGAIN          NO
         STW,2    PGCNT             SAVE # OF PAGES
         STW,2    PGCNT2
         LI,14    1                 INDICATE HEX INPUT
         LI,15    MSG4              =ADDR IN HEX 10000-XXXXX
         BAL,1    CVTHEX            GET 1ST PAGE ADDR
         B        TRYAGAIN          INVALID HEX ADDRESS
         CI,6     0                 ANY INPUT
         BNE      GF3               YES
         CI,11    RESDFX+1          IS THIS RESDF COMMAND
         BNE      TYPQUEST          NO-MUST SPECIFY FIRST PAGE
         LW,2     RESDFP            YES-USE LATEST VALUE
GF3      CI,2     X'1FF'            VALID PAGE ADDR
         BANZ     TRYAGAIN          NO
         LW,0     2
         SLS,0    -9                GET 1ST PAGE #
         CI,0     X'80'             VALID RT PAGE
         BL       TRYAGAIN          NO
         LW,1     PGCNT             LAST PAGE TO R1
         AW,1     0
         AI,1     -1
         CW,1     HIGH              VALID RT PAGE
         BG       TRYAGAIN          NO
         STD,0    CPAGES
         LW,7     0                 FISRT PAGE
         SLS,7    16
         OR,7     PGCNT             BUILD PPTABLE ENTRY
         STW,7    ENTRY             SAVE IT
         B        *11
*
         PAGE
*
GSTERR   EQU      %
         STW,15   SAVE15
         B        XCON2
XCON     MTW,0    XCONC             RE-ENTERED XIT CONTROL
         BNEZ     XCONR             YES
         MTW,1    XCONC
         LW,8     X'8C12'           J:RNST
         LB,8     8
         BEZ      XCONR             EXECUTING NORMALLY
XCON2    LCI      0
         STM,0    SAVEREGS
         LI,0     X'A000'
         LI,1     X'A1FF'
         BAL,14   SNAPIT            SNAP1=DATA
         LI,0    RESDF
         LI,1     RESDF+100
         BAL,14   SNAPIT            SNAP2 = :FRGD
         LI,0     MX:PPUT
         LI,1     MX:PPUT+256
         BAL,14   SNAPIT            SNAP3=MX:PPUT
         LI,0     X'8C00'
         LI,1     X'8DFF'
         BAL,14   SNAPIT            SNAP4=JIT
         BAL,11   FREERPP           GIVE BACK ANY UNUSED STOLEN PAGES
         LI,15    ERRMSG            =GST DETECTED ERR
         CAL1,2   TYPFPT
XCONR    CAL1,9   1
SNAPIT   CAL1,3   SNAPFPT
         MTW,1    SNAPFPT+4
         B        *14
         END      PPS

