         SYSTEM   SIG7FDP
         PCC      0
         DEF      SYSMAK:
         CSECT    0
SYSMAK:  EQU      %
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         DEF      SYSMAK
         DEF      SYSMAK1
         DEF      SEEKCVT
         REF      TSTACK
         REF      M7
         REF      M16
         REF      M17
         REF      M:EI
         REF      PPROCS
         REF      P:AC
         REF      PB:DCBSZ
         REF      PB:DSZ
         REF      PB:HVA
         REF      PB:PSZ
         REF      PB:PVA
         REF      PH:DDA
         REF      PH:PDA
         REF      P:NAME
         REF      P:SA
         REF      P:TCB
         REF      PB:LNK
         REF      PNAMEND
         REF      J:DLL
         REF      GMB,RMB
         REF      NEWQ
         REF      MB:SDI
         REF      DSCCVT
         REF      M8
         REF      HGP
         REF      T:SGRNU,T:SGAJIT,MB:GAM4,M:SBAND
         REF      HIGH,BOOTSBAND,RCVRDSZ
         REF      S:DP
         REF      Y008
         SREF     S:CYLSZ,S:UCYL
         SREF     PB:C#,PB:DC#
         REF      MING
         SREF     UB:C#
         REF      SMUIS
         REF      MB:GPT
         REF      M24
         REF      UB:FL
         REF      SB:TQ
         REF      M19
         REF      JSPVP,JBUPVP,JOVVP
         REF      JEUPVP
         REF      SPSIZE
         REF      DCT22                                                 DISCB
         REF      PSA%END                                               DISCB
         REF      DISCLIMS
         REF      NSPT
         REF      NTPC
         REF      NCYL
         REF      CYL%SHFT
         REF      TRK%SHFT
         REF      SEC%SHFT
         REF      YFFFF
         REF      NSPC
         PAGE
************************************************************************
*                                                                      *
*                 PROCS                                                *
*                                                                      *
************************************************************************
         OPEN     CLOSE
         OPEN     OPEN
CLOSE    COM,12,20 X'041',CLOSE%FPT
OPEN     CNAME
         PROC
         LD,14    AF(1),AF(2)
         CD,14    DUMNAM
          LOCAL   OPEN1,OPENA
         BNE      OPEN1
         MTW,0    S:DP
         BEZ      OPENA
         LCW,8    S:CYLSZ
         CI,8     -SPSIZE
         BGE      %+2
         LI,8     -SPSIZE
         LW,15    #PGSLEFT
         AWM,8    #PGSLEFT
         BGEZ     OPENA
         AWM,15   SENSW
         AWM,15   SENSW
         AW,8     S:CYLSZ
         STW,8    #PGSLEFT
OPENA    EQU      %
         LW,8     SENSW
         BAL,11   DSCCVTS
         LH,11    8
         BEZ      %+2
         STB,11   PB:DC#,7
         STH,8    PH:DDA,7
         LI,8     SPSIZE            SIZE OF SLOTS
         AWM,8    SENSW
         AWM,8    SENSW
         B        BUMP
OPEN1    EQU      %
         STD,14   FILE%NAME
         CAL1,1   OPEN%FPT
         PEND
READ     CNAME
         PROC
         LOCAL   1A1
         DO       AF(3)>0
         LW,14    AF(3)
         ELSE
         LI,14    AF(2)
         DO       TCOR(AF(2),S:INT)
         AW,14    BUFFER
         FIN
         FIN
         DO       AF(1)>0
         LB,0     HEADER
         CI,0     X'85'
         BNE      %+2
         BAL,15   85KEY
         FIN
         LCI      3
         LM,14    *14
         STM,14   KEY
         DO       AF(1)>0
         MTB,1    KEY
         LB,2     KEY
         STB,13   KEY,2
         FIN
         DO       AFA(4)
         GEN,8,4,3,17 X'32',2,0,AF(4)
         ELSE
         LI,2     AF(4)
         DO       TCOR(AF(4),S:INT)
         AW,2     BUFFER
         FIN
         FIN
         DO       AF(1)>0
         LB,3     AF(5),AF(6)
         BEZ      1A1
         FIN
         DO       AF(1)=2
         LI,0     ERCK
         LI,1     X'1FFFF'
         STS,0    M:EI+3
         FIN
RDCAL    SET      %
         LW,14    BUFEND
         SW,14    2
         SLS,14   2
         AND,14   M19
RDCAL10  SET      %
         CAL1,1   READ%FPT
         DO       AF(1)>0
         LB,0     HEADER
         CI,0     X'85'
         BNE      1A1
RDCLDSP  SET      %-RDCAL10-1
         AND,2    M8X9
         AI,2     512
         MTW,1    KEY
         DO       AF(1)=2
         LW,0     KEY
         CB,0     PB:PVA,7
         BL       RDCAL
         ELSE
         BDR,3    RDCAL
         FIN
         FIN
1A1      SET      %
         DO       AF(1)=2
         LI,0     IOERR
         STS,0    M:EI+3
         FIN
         PEND
         PAGE
WRITE    CNAME
         PROC
         LI,0     AF(4)
         STW,0    PROCTAB
         LW,0     AF(5)
         LB,15    AF(2),AF(3)       # OF PG TO WRITE
         BEZ      %+3
         LI,9     AF(1)             GET ADR
         BAL,8    RADWRITE
         PEND
*
*
*
PAGES    CNAME
         PROC
         LI,1     AF(1)*2
         LH,14    *BUFFER,1
         AI,14    255
         SLS,14   -8
         PEND
         PAGE
************************************************************************
*                                                                      *
*                 DATA                                                 *
*                                                                      *
************************************************************************
*
DATT     EQU      TREE+6            WORD IN HEADER FOR DATA INFO
*
DATA%AREA EQU     0
*
DCBS     EQU      TREE+10           WORD IN HEADER FOR DCB INFO
*
*
SENSW    DATA     0                 NEXT REL SECT #
*
BUFFER   RES      1
BUFEND   DATA     0
M8X9     DATA     X'1FE00'
         REF      RCVRAD,MAXOVLY
         GEN,12,20 7,0              MASK FOR ERROR CHECK
         BOUND    8
HEAD%NAME         ;
         TEXTC    'HEAD'            KEY NAME FOR THE HEADER RECORD
*
         BOUND    8
KEY      RES      3                 CONTAINS KEY FOR READING PRO-
*                                   CESSORS FROM D FILE DISC
*
ONE      GEN,8,24 1,0               CONSTANT
*
PRCD     EQU      TREE+8            WORD IN HEADER FOR PROCEDURE INFO
PROCEDURE         ;
         EQU      DATA%AREA+X'200'
SHARED%PROCS EQU  P:NAME
*
LINK     DATA     0
ROOTSZ   DATA     0                 EITHER ROOT SZ OR PARTIAL IN LAST PG
SEGBUF   DATA     0
         BOUND    8
TREENAME TEXTC    'TREE'
TREE     EQU      DATA%AREA
MNSEGPG  DATA     0                 MAX # OF PGS IN LONGEST SEG
DATABFAD RES      1                 BUFFER ADDRESS FOR DATA SEGMENT READ
         BOUND    8
DUMNAM   TEXTC    'M:DUMLM'
         BOUND    8
FG%MAXOV GEN,8,24 1,0
         GEN,8,24 1,MAXOVLY-1
MONBUF   RES      1
NPG      RES      1
Y01FF10  DATA     X'01FF1000'
#PGSLEFT DATA     9999999           MANY FOR RAD
PROCTAB  DATA     0
D100     DATA     100
D10      DATA     10
D11      DATA     11
Y00FE    DATA     X'00FE0000'
         BOUND    8
P:ACTEMP DATA     0,0
DCBBUF   DATA     0
CCI      TEXTC    'CCI'
         PAGE
************************************************************************
*                                                                      *
*                 FPT'S                                                *
*                                                                      *
************************************************************************
         RES      ABSVAL(%+1)&1     MAKE ODD WORD BOUND SO THAT FILE%NAME
*                                      IS ON A DBL WD BOUNDARY
OPEN%FPT EQU      %
         GEN,8,24 X'14',M:EI
         DATA     X'C2000009'
         DATA     IOERR
         DATA     IOERR
         DATA     2
         DATA     X'02000202'
         TEXT     ':SYS '
         DATA     X'01010202'
FILE%NAME         ;
         RES      2                 FILE NAME; DOUBLE WORD BOUNDARY
*
*  WARNING:
*      1.  LOCATION MESSAGE MUST BE AT FILE%NAME+2
*      2.  ALL MESSAGES IN THE FOLLOWING TABLE MUST BE 4 WORDS LONG.
*      3.  THE ORDER OF THE MESSAGES MUST NOT BE CHANGED.  DRSP
*          DOES NOT PRINT THESE MESSAGES DIRECTLY, BUT READS
*          ERRMSG.:SYS WITH A KEY OF
*               ((MESSAGE%ADDRESS-MESSAGE)/4)+X'060030'
*      4.  THE TEXTC COUNT MUST BE 1 > THAN ACTUAL MESSAGE.
*
MESSAGE  TEXT     '    '
         RES      4                 MESSAGE BUFFER
ABNMES   TEXTC    'I/O ERR XXXX '
NORAD    TEXTC    'OVERFLOWS RAD '
NONE     TEXTC    'NOT IN :SYS '
BADSWAP  TEXTC    'SWAP I/O ERROR '
NOOVLY   TEXTC    'CAN''T OVERLAY '
BADBIAS  TEXTC    'ILLEGAL LM '
         DATA     0
BADSIZE  TEXTC    'TOO LARGE'
*
*  END OF TABLE OF MESSAGES
*
CNVRT    TEXT     '0123456789ABCDEF'
DELUSR   TEXTC    'NUMBER OF USERS REDUCED TO     '
DELUS#   EQU      %-1
*
READ%FPT EQU      %
         GEN,8,24 X'10',M:EI
         GEN,8,24 X'F8',X'10'
         DATA     IOERR             ERROR
         DATA     IOERR             ABNORMAL
         GEN,1,31 1,2               BUFFER ADDRESS
         PZE      *14               BYTE COUNT
         GEN,32   KEY               KEY ADDRESS
*
TYPE%FPT EQU      %
         GEN,8,24 2,0
         PZE      *0
         DATA     FILE%NAME
*
T4USRFPT EQU      %
         GEN,8,24 2,0
         PZE      *0
         DATA     DELUSR
*
CLOSE%FPT         ;
         EQU      %
         GEN,8,24 X'15',M:EI
         DATA     0
*
PAGES%FPT EQU     %
         GEN,8,24 8,255
         PAGE
85KEY    CW,14    BUFFER            IF KEY ADDRESS IS LESS THAN
         BL       *15               BUFFER ITS HEAD OR TREE.
         LW,2     13                C(13) IS SEGMENT COMPONENT NUMBER
         SLS,2    2                 ITS USED TO COMPUTE A BYTE INDEX INTO THE
         AI,2     10                TREE TABLE TO GET PAGE NUMBERS OF
         LB,13    *14,2             THE DATA, PROCEDURE AND DCB SECTIONS.
         LW,3     14
         SW,3     BUFFER            CONVERT TREE TBL ADDRESS TO SEG
         AI,3     -1                NUMBER. (DISPLACEMENT)
         DW,3     D11               CONVERT TO TREE TBL INDEX
         SLS,3    16
         MTB,2    3                 BUILD KEY WITH CT AND SEG NR.
         LI,14    3                 IN REG 3.
         AI,15    1                 PAGE NR. SUPPLIED BY READ PROC
         LCI      1
         B        *15
         PAGE
*
BADPROC  EQU      %
         LI,14    BADBIAS
         B        TYPE
*
IOERR    EQU      %
         LB,0     HEADER
         CI,0     X'85'
         BNE      IOERR2            NOT PAGED LOAD MODULE
         LB,0     10                GET ERROR CODE
         CI,0     X'43'             OK IF KEY MISSING
         BE       *8                RETURN TO CAL+1
*
IOERR2   LI,14    NONE
         LB,0     10                GET ERROR CODE
         CI,0     3
         BE       TYPE              BR IF FILE DOESN'T EXIST
         SLS,0    8
         LH,9     10
         SLS,9    -1
         AND,9    M7                ISOLATE SUB-CODE
         OR,0     9                 COMBINE MAJOR AND SUB-CODE
         STH,0    3                 LEFT JUSTIFY
         LI,9     4                 CONVERT 4 CHARACTERS
         LI,4     BA(ABNMES)+9
*
CVRTLOOP EQU      %
         LI,2     0
         SLD,2    4                 SHIFT NEXT HEX CHAR INTO 2
         LB,2     CNVRT,2           CONVERT TO EBCDIC
         STB,2    0,4               PUT INTO MESSAGE
         AI,4     1
         BDR,9    CVRTLOOP
*
         LI,14    ABNMES            MESSAGE ADDRESS
         LH,9     M:EI
         CI,9     X'0020'
         BAZ      TYPE              BR IF DCB CLOSED
         CLOSE                      OTHERWISE, CLOSE IT
TYPE     EQU      %
         MTB,0    7
         BEZ      TYPE4
         LW,5     14
         AI,5     -MESSAGE
         SLS,5    -2
         AI,5     X'30'
         B        OUT1
TYPE4    EQU      %
         LB,3     *14
         STB,3    FILE%NAME
         MTB,7    FILE%NAME
         LB,15    *14,3
         STB,15   MESSAGE,3
         BDR,3    %-2               MOVE MESSAGE TO MESSAGE
         CAL1,2   TYPE%FPT
         B        BUMP1             TO NEXT, ZAP THIS NAME
         PAGE
*  I 6  = BEG OF BUFFER AREA
*  I 7  = PROCESSOR TO REPLACE
SYSMAK1  EQU      %
         PSW,11   TSTACK
         MTB,1    7                 SET SYSMAK1 FLAG
         STW,6    BUFFER
         STW,8    BUFEND
         LH,8     PH:DDA,7
         LW,14    S:DP
         BEZ      %+3
         LB,14    PB:DC#,7
         STH,14   8
         CI,8     0
         BNE      SM4
         LH,8     PH:PDA,7
         LW,14    S:DP
         BEZ      SM4
         LB,14    PB:C#,7
         STH,14   8
SM4      EQU      %
         LB,14    MB:SDI
         STB,14   8
         BAL,11   SEEKCVT           DA TO RELATIVE SECT #
         STH,14   8
         STW,8    SENSW
         BAL,10   SETBUF            GET MON BUF FOR EA
*                                   & SET #PGSLEFT
         LW,8     S:DP
         BEZ      LOOP1
         LI,9     X'FFFF'
         AND,9    SENSW
         BAL,11   SET#PGS
         B        LOOP1
OUT0     EQU      %
         LI,5     0
OUT1     EQU      %
         BAL,10   RELBUF
         PLW,11   TSTACK
         B        *11
         PAGE
SYSMAK   EQU      %
         PSW,11   TSTACK
         LD,6     J:DLL             FREE ALL GHOST1 DATA
         SW,7     6
         AI,7     1
         SLS,6    9
         MTB,5    6
         CAL1,8   6
         AI,6     512
         BDR,7    %-2
         CAL1,8   PAGES%FPT
         SLS,8    9
         AW,9     8                 END OF BUFFER
         STW,9    BUFEND
         LI,6     X'20000'
         LW,7     Y00FE
         STS,6    M:EI+1
         LI,0     ENDMAK+X'1FF'
         AND,0    M8X9
         STW,0    BUFFER
         BAL,10   SETBUF            MON BUF FOR EA,SET #PGSLEFT
         LW,0     RCVRAD            GET START OF AVAIL DISC
         MTW,0    S:DP              SEE IF DISC PACK SWAPPING
         BEZ      ON%CYL            YES IGNORE CYL CHECK
         INT,9    RCVRAD            CALCULATE #PGSLEFT
         BAL,11   SET#PGS
ON%CYL   EQU      %
         STW,0    SENSW
*
*  PREPARE FOR SHARED PROCESSOR LOOP
         LI,7     MAXOVLY           NO MONITOR OVERLAYS
LOOP     EQU      %
         OPEN     SHARED%PROCS,7
*        READ FILE HEADER RECORD
LOOP1    EQU      %
         READ     0,HEAD%NAME,,HEADER,ONE
         READ     0,TREENAME,,TREE,ONE
         BAL,11   SET%PROC%TAB      SET UP PROC TABLE ITEMS
*                                   SET UP BUFFER ADDRESSES
         LW,13    BUFFER            BEGINNING OF TOTAL AREA
         AI,13    X'200'             + 1 PAGE FOR TREE
         STW,13   SEGBUF            BUFFER TO WRITE DATA/DCB RECORD
         AWM,13   DATABFAD          BUFFER TO READ DATA RECORD
         LB,15    PB:DSZ,7          DATA SIZE
         LB,14    PB:DCBSZ,7        DCB SIZE
         AW,14    15                TOTAL RECORD SIZE
         STB,14   SEGBUF            #PGS IN DATA/DCB RECORD
         SLS,15   9                 # WORDS OF DATA
         AW,13    15                 + DATA BUFFER
         STW,13   DCBBUF              = ADDRESS OF DCB BUFFER
*
         LI,13    7                 KEY FOR DCBS
         READ     1,TREE+1,,*DCBBUF,PB:DCBSZ,7
*
         LI,13    3                 KEY # FOR DATA CORE IMAGE
         CLM,7    FG%MAXOV
         BCR,9    RPSZ              DATA INTO PURE P
*
*  NOTE ON FOLLOWING READ PROC:
*  AF(1)=2 INDICATES A LOAD MODULE DATA SEGMENT READ
*  AF(2) IS THE ADDRESS OF THE KEY
*  AF(4) IS THE BUFFER ADDRESS TO BE USED IN DOING THE READ
*  AF(5) IS THE ADDRESS OF THE TABLE FROM WHICH THE SIZE OF
*     OF THE SEGMENT IS DETERMINED
*  AF(6) IS THE INDEX REGISTER USED WITH THE ABOVE TABLE
*
         READ     2,TREE+1,,*DATABFAD,PB:DSZ,7
         WRITE    DATA%AREA+X'200',SEGBUF,0,PH:DDA,7
         LI,13    5                 KEY # FOR PROCEDURE CORE IMAGE
RPSZ     EQU      %
         READ     1,TREE+1,,PROCEDURE,PB:PSZ,7
         WRITE    PROCEDURE,PB:PSZ,7,PH:PDA,7
*  IF TREE SIZE IS GREATER THAN C,  DO PROCESSOR OVERLAYS
         LW,5     *BUFFER
         CI,5     12
         BG       PS0               DO PROCESSOR SEGMENTS
BUMP     EQU      %
         MTB,0    7                 IS IT DRSP
         BNEZ     OUT0              YES
BUMP02   EQU      %
         AI,7     1                 BUMP INDEX
         CI,7     MAXOVLY+2
         BNE      BUMP2
         LW,8     SENSW
         BAL,11   DSCCVTS
         LH,14    8
         BEZ      %+2
         STB,14   PB:DC#,7
         STH,8    PH:DDA,7
         AI,7     2                 SKIP ALLOCAT TOO
         B        BUMP2
BUMP1    EQU      %
         LD,8     DUMNAM
         STD,8    P:NAME,7
         LH,8     PH:DDA,7          IF IO ERR RECLAIM DA IE INIT DA
         LW,14    S:DP
         BEZ      %+3
         LB,14    PB:DC#,7
         STH,14   8
         CI,8     0
         BEZ      BUMP2             STORE DDA; THEN INCR BY SPSIZE
         LB,14    MB:SDI
         STB,14   8
         BAL,11   SEEKCVT           DA TO RELATIVE SECT #
         LW,9     8
         STH,14   8
         STW,8    SENSW
         MTW,0    S:DP
         BEZ      BUMP2
         LI,11    BUMP2
SET#PGS  EQU      %
         LI,8     0
         SLS,9    -1                REL PAGE #
         DW,8     S:CYLSZ
         LW,9     S:CYLSZ
         SW,9     8
         STW,9    #PGSLEFT
         B        *11
BUMP2    EQU      %
         LH,14    M:EI              IS DCB OPEN
         CI,14    X'20'
         BAZ      %+2
         CLOSE                      YES. CLOSE IT
         CI,7     PNAMEND           TEST FOR DONE
         BL       LOOP              NOT DONE
         LW,8     SENSW
         BAL,11   DSCCVTS
         LH,14    8
         BEZ      %+2
         STB,14   PB:DC#
         STH,8    PH:DDA            END OF PROC DA
* GET RCVRDSZ AND RELEASE THE REST OF SWAP RAD
* FOR SWAPPING
         BAL,10   RELBUF            REL MON BUF
         LW,8     SENSW
         SW,8     RCVRAD
         SLS,8    -1
         STW,8    RCVRDSZ           HOW MUCH WE GOT
         LW,7     HIGH              HOW MUCH WE NEED FOR DUMP
         AI,7     3                  AND TABLES
         SW,7     8
         BLEZ     RCV1              ENUF
         LW,8     BOOTSBAND
         SW,8     SENSW             HOW MUCH MORE CAN WE GET HUH
         BLEZ     RCV1              NONE
         SLS,8    -1
         CW,7     8                 CAN WE GET ENUF
         BL       %+2               NO JUST WHAT WE CAN
         LW,7     8                 7=WHAT WE WANT
         AWM,7    RCVRDSZ
         AWM,7    SENSW
         AWM,7    SENSW
RCV1     EQU      %
         LW,8     S:DP
         BEZ      RCV4
*  MAKE RCVRDSZ A MULTIPLE OF CLYINDERS
         LI,8     0
         LW,9     RCVRDSZ
         DW,8     S:CYLSZ
         CI,8     0
         BE       %+2
         AI,9     1
         MW,9     S:CYLSZ
         STW,9    RCVRDSZ
         SLS,9    1
         AW,9     RCVRAD
         STW,9    SENSW
         LW,8     9
         BAL,11   DSCCVTS
*  SET UP USER CYL TABLE
         LH,10    8
         AI,10    1                 ROUND UP TO 1 CYL, ROUNDHEAD...
         LW,8     PSA%END           GET END OF PSA AREA                 DISCB
         AND,8    M16
         LB,9     MB:SDI
         STH,9    8
         BAL,11   DSCCVTS           REL TO DA
         LW,7     S:UCYL
*        KNOCK OFF KEYIN CYL
         MTH,-1   8
*  8=CYL # OF END OF PSA AREA OR START OF PFA (S:UCYL=1)
         LI,9     MING-1            ALLOCATE MING CYLS
         SLS,7    16
         SW,8     7
         BDR,9    %-1
         LI,7     MING+1
RCV3     EQU      %
         STB,10   UB:C#,7
         AI,7     1
         CI,7     SMUIS
         BG       RCV4              DONE WITH ALL USERS
         AW,10    S:UCYL
         CH,10    8
         BLE      RCV3
*  ALL USERS COULDN'T FIT   TAKE SOME OUT
         AI,7     -1
         STB,7    SB:TQ
         LI,9     0
         STB,9    UB:FL,7
*  INDICATE TO OPERATOR HOW MANY USERS IN SYSTEM NOW
         LI,6     -1                INDEX TO BUF
         LW,9     7
         AI,9     -1                # IN SYS
         LI,8     0                 CONVERT TO DECIMAL
         DW,8     D100
         CI,9     0                 IS THERE HUNDS DIGIT
         BE       RCV32             NO
         AI,6     1
         AI,9     X'F0'
         STB,9    DELUS#,6
RCV32    EQU      %
         LW,9     8
         LI,8     0
         DW,8     D10
         CI,9     0                 IS THERE TENS DIGIT
         BNE      %+3               YES
         CI,6     -1
         BE       RCV34             NOT IF NO HUND EITHER
         AI,6     1
         AI,9     X'F0'
         STB,9    DELUS#,6
RCV34    EQU      %
         AI,6     1
         AI,8     X'F0'
         STB,8    DELUS#,6          UNITS
         CAL1,2   T4USRFPT
RCV4     EQU      %
         MTW,-2   BOOTSBAND
         LI,2     0
         LB,7     MB:GAM4
         LB,10    MB:GPT
         SLS,10   1                 NST
         LW,15    SENSW
         BAL,11   GTS1
         STH,15   SENSW
         LW,15    BOOTSBAND
GTS1     EQU      %
         LI,14    0
         STH,14   15
         DW,14    10
         SLS,15   1,7
         AW,15    14
         BAL,11   *11
         STH,15   BUFFER
         BAL,11   T:SGRNU           RELEASE WHAT'S LEFT
         MTH,-2   BUFFER
         LH,15    BUFFER
         CH,15    SENSW             DOWN TO SENSW
         BG       T:SGRNU
         MTB,1    PAGES%FPT         CHANGE TO FREE PAGE CAL
         CAL1,8   PAGES%FPT
         PLW,11   TSTACK
         B        *11
         PAGE
*************************************
*        PROCESSOR SEGMENTS         *
*************************************
*        SET UP TABLES & SET UP RAD *
PS0      EQU      %
         LI,6     PPROCS
*  MOVE LAST PARTIAL PG OF ROOT TO BEG OF BUF AREA, SINCE
*  IT WILL BE WRITTEN WITH EVERY SEGMENT
         LI,12    PROCEDURE
         AW,12    BUFFER
         STW,12   SEGBUF            INIT SEGBUF
         LW,13    ROOTSZ
         SLS,13   1
         LI,3     X'1FF'
         AND,3    13                ROOT SZ MOD PAGES
         STW,3    ROOTSZ
         BEZ      PS3               NONE OF ROOT IN SEG
         AWM,3    SEGBUF            START OF READ BUF
         AW,13    12                END OF ORIG ROOT
         SW,13    3                 BEG OF ROOT TO MOVE
         AI,12    -1
         AI,13    -1
         MTB,-1   PB:PSZ,7          TAKE OFF PART PG
         MTB,-1   PB:HVA,7
         MTW,-2   SENSW             REUSE GRAN AT END OF ROOT
         MTW,1    #PGSLEFT
PS2      EQU      %
         LW,8     *13,3             MOVE PART ROOT TO
         STW,8    *12,3             BEG OF SEG WRITE BUF
         BDR,3    PS2
PS3      EQU      %
         AW,5     BUFFER            END OF TREE+1
         LI,8     0
         STW,8    MNSEGPG           INIT FOR # OF PG OF LARGEST SEG
         STW,8    LINK              INIT FOR END OF LINK
PS5      EQU      %
*  LOOP FOR EACH OVERLAY
         AI,5     -12
         CW,5     BUFFER
         BLE      PS6
         LD,15    P:NAME,6
         BEZ      %+2
         BDR,6    %-2
         CI,6     PNAMEND           ARE SEGS GOING IN ROOT
         BGE      PS55
         LI,15    0                 ZAP THE SLOTS WEVE USED
         LI,6     BA(LINK)+3-BA(PB:LNK)
         LB,6     PB:LNK,6
         BEZ      %+3
         STD,15   P:NAME,6
         B        %-3
         LI,14    NOOVLY
         MTB,0    7
         BEZ      TYPE
         LI,5     X'39'
         B        OUT1
PS55     EQU      %
         AI,5     1
         LW,12    BLNKS
         LW,13    BLNKS
         LB,3     *5
         STB,3    12
         LB,15    *5,3
         STB,15   12,3
         BDR,3    %-2
         STD,12   P:NAME,6          NAME TO PROC TBL
         LW,15    7,5
         SLS,15   -15               WORD SIZE
         AW,15    ROOTSZ
         AI,15    510               ROUND TO NEXT PAGE
         SLS,15   -9
         STB,15   PB:PSZ,6          PURE P SZ IN PG TO PROC TBL
         CW,15    MNSEGPG           IS THIS SEGS # OF PG > ALL PREV SEGS
         BLE      %+2               NO
         STW,15   MNSEGPG           YES-SET MAX # OF PGS OF LARGEST SEG
         LW,14    LINK
         STB,14   PB:LNK,6          LINK TO PROC TBL
         STW,6    LINK              SET FOR NXT ONE
         LB,14    PB:HVA,7          HIGH VP FOR ROOT=
         STB,14   PB:PVA,6                           BEG VP FOR OFAYS
         LI,13    5
         READ     1,0,5,*SEGBUF,PB:PSZ,6
         WRITE    DATA%AREA+512,PB:PSZ,6,PH:PDA,6
         BDR,6    PS5
PS6      EQU      %
         LW,8     LINK
         STB,8    PB:LNK,7          LINK ROOT TO 1ST SEG
         STW,6    LINK              SET AS INDEX FOR NXT PROC
         LB,8     PB:HVA,7          GET ROOT HIGH
         AW,8     MNSEGPG           # OF PGS OF LARGEST SEG
         STB,8    PB:HVA,7          SET HIGH TO ABOVE LONGEST OVLY
         B        BUMP
         PAGE
************************************************************************
*                                                                      *
*        SET UP ITEMS IN PROCESSOR TABLES                              *
*                                                                      *
************************************************************************
SET%PROC%TAB      ;
         EQU      %
* MAKE SURE PROCESSOR WASNT LOADED WITH PRE B00 LOADER
         LH,1     HEADER+6          DCB SIZE
         BEZ      SPT00             NO DCBS
         INT,1    HEADER+6
         CI,1     X'4800'           A00 DCB BIAS
         BE       BADPROC
SPT00    EQU      %
         LI,0     0                 RESET TCB ADDRESS IF NONEXISTANT
         LC       HEADER+1          GET TCB FLAG
         BCS,4    SPT001            NO TCB SPECIFIED
         LH,0     HEADER+2          GET TCB DOUBLEWORD ADR
         BEZ      SPT000
         LI,12    X'FFFF'
         AND,0    12
         INT,1    HEADER+3          DATA BIAS
         CW,0     1                 TCB : DATA LL
         BL       BADPROC
         LH,13    HEADER+3          DATA SIZE
         AW,1     13
         CW,0     1                 TCB : DATA UL
         BG       BADPROC
SPT000   EQU      %
         SLS,0    1                 FORM WORD ADR
SPT001   STW,0    P:TCB,7           SAVE IN PROC TABLE
         LW,12    HEADER+1
         LW,13    M17
         STS,12   P:SA,7
         LD,0     P:NAME,7          IF PROCESSOR  IS CCI
         CW,0     CCI                MAKE SURE CORELIB BIT IS SET
         BE       SPT0                SO RUNNER CAN BE ASSOCIATED
         LW,13    HEADER+9          SET BIT 8 IN P:SA IF
         BEZ      %+3               PROCESSOR NEEDS A CORE
SPT0     LW,13    Y008              LIB SPACE HELD BACK.
         STS,13   P:SA,7
*
*
*  COMPUTE THE NUMBER OF PAGES IN THE DATA SEGMENT CORE IMAGE.
*  NOTE THAT IF THE DATA SEGMENT CONTAINS BLANK FORTRAN COMMON
*  AND/OR WAS LOADED WITH A SHARED LIBRARY THE FIRST PART
*  OF THE DATA SEGMENT RECORD WILL BE MISSING.  THE SIZE
*  OF THE MISSING PART IS (DATA ORIGIN) - (BIAS).
*  BYTE 0 OF THE LOAD MODULE'S DATA SEGMENT RECORD, WHEN EVENTUALLY
*  READ INTO CORE FOR EXECUTION, SHOULD BE READ AT DATA ORIGIN.
*
         LI,1     6*2               L/HWD TO DATA SIZE IN TREE
         LH,14    *BUFFER,1         L/DATA SIZE
         LI,1     6                 L/WD TO DATA ORIGIN IN TREE
         INT,15   *BUFFER,1         L/DATA ORIGIN
         INT,1    HEADER+2          L/BIAS
         SW,15    1                 DATA ORIGIN - BIAS
         AW,14    15                DATA SIZE + (DATA ORIGIN - BIAS)
         SLS,15   1                 G/NUMBER OF MISSING WDS OF DATA
         STW,15   DATABFAD          S/BUFFER DISPLACEMENT
         AI,14    X'FF'             +X'FF'; ROUND UP SIZE TO PAGE BOUND
         SLS,14   -8                G/# OF PAGES OF DATA
         LI,15    JBUPVP-JOVVP
         LI,1     DATT
         CLM,7    FG%MAXOV
         BCR,9    SPT1              DATA INTO PURE P
         STB,14   PB:DSZ,7
         LCW,15   14
*
         PAGES    DCBS              # OF PAGES OF DCBS
         STB,14   PB:DCBSZ,7
         LCW,14   14
         AW,15    14                -(# PGS DATA + # PGS DCBS)
*
         PAGES    PRCD              # PAGES OF PROCEDURE
*
         LI,1     PRCD
SPT1     EQU      %
         STB,14   PB:PSZ,7
         LW,13    *BUFFER,1         START ADR OF PURE P
         SLS,13   -8
         STB,13   PB:PVA,7
         AW,15    13                NOW AT BEG OF DATA
         AND,15   M8
          LD,0    P:NAME,7
          AH,1    7
          CD,0     DUMNAM
          BE      *11
         LW,1     13
*
         AW,13    14                COMPUTE NEXT AVAILABLE PAGE
         STB,13   PB:HVA,7
*
         SLS,13   -8
         STW,13   ROOTSZ
         LI,0     -1
         LI,1     -1
         STD,0    P:AC,7            FOR STD SHARED PROCESSORS
         STD,0    P:ACTEMP          INITIALIZE FOR SPEC SHARED PROCS.
         LW,0     P:SA,7
         SLS,0    1
         LC       0                 SPEC SHARED PROC, HUH
         CI,15    JBUPVP            IS FIRST DATA PAGE BUP
         BCR,9    *11               NOT SPECIAL AND NOT < BUPVP
         BCR,8    BADPROC           FORMAT BAD SINCE NOT SPEC
         CI,15    JSPVP             FIRST PAGE OF DATA
         BL       BADPROC
*                                   GEN P:AC FOR SPECIAL PROCESSORS
SETPROC  LI,4     1                 AC FOR PROCEDURE
         LB,5     PB:PVA,7          FIRST PROCEDURE PAGE
         LB,6     PB:HVA,7           -LAST PROCEDURE PAGE
         SW,6     5                   = # PGS OF PROCEDURE
         BAL,2    SETAC
SETDCB   LI,4     2                 AC FOR DCBS
         LB,5     PB:PVA,7          FIRST PROCEDURE PAGE
         LB,6     PB:DCBSZ,7         -DCB SIZE
         BEZ      SETDATA
         SW,5     6                   = FIRST DCB PAGE
         BAL,2    SETAC
SETDATA  LI,4     0                 AC FOR DATA
         LB,5     PB:PVA,7          FIRST PROCEDURE PAGE
         LB,6     PB:DCBSZ,7         -DCB SIZE
         SW,5     6
         LB,6     PB:DSZ,7           -DATA SIZE
         BEZ      CHKCL
         SW,5     6                   = FIRST DATA PAGE
         BAL,2    SETAC
CHKCL    INT,5    P:SA,7
         BCR,1    SETPAC            NOT A CORE LIBRARY
         LI,4     1                 SET AC ON DELTAS DATA PAGE
         LI,5     JEUPVP+1
         LI,6     1
         BAL,2    SETAC
SETPAC   LD,0     P:ACTEMP
         STD,0    P:AC,7
         B        *11               RETURN
*
* BAL,2 SETAC     R4 = ACCESS CODE
*                 R5 = VIRTUAL PAGE
*                 R6 = # OF PAGES
SETAC    AI,5     -X'E0'            VIRTUAL PAGE RELATIVE TO E0
SETAC2   LI,3     3
         AND,3    5                 DOUBLE BIT POSITION IN BYTE
         LB,13    SACBP,3           MASK FOR DOUBLE BIT POSITION
         LW,3     5
         SLS,3    -2                BYTE DISPLACEMENT
         LB,15    P:ACTEMP,3        GET CURRENT SETTING
         LB,12    SACACC,4          GET AC IN ALL DOUBLE BIT POSITIONS OF BYTE
         STS,12   15                RESET BYTE
         STB,15   P:ACTEMP,3        RESTORE UPDATED SETTING
         AI,5     1                 NEXT VIRTUAL PAGE
         BDR,6    SETAC2
         B        0,2
*
SACBP    DATA     X'C0300C03'
SACACC   DATA     X'0055AAFF'
WAIT     GEN,8,24 X'F',4
BLNKS    TEXT     '    '
         PAGE
*
*  8  = RETURN ADR
*  9  = DISP FROM BEG OF BUFFER
*  15 = # OF PAGES TO WRITE
*
RADWRITE EQU      %
         PSW,8    TSTACK
         STB,0    PROCTAB           SAVE PROC INDEX
         LW,10    4                 SAVE 4 DESTROYED BY IOQ
         STW,15   NPG
RADW2    EQU      %
         CW,15    #PGSLEFT          DOES IT FIT
         BLE      RADW4             OK
*  DOESN'T FIT ON THIS CYL  INCR SENSW & SET #PGSLEFT
         LI,14    BADSIZE
         CW,15    S:CYLSZ           IS PROC TOO LARGE FOR FULL CYL
         BG       RADW10            YES - ERROR
         LW,8     S:CYLSZ           NO
         XW,8     #PGSLEFT
         SLS,8    1
         AWM,8    SENSW             INCR SENSW TO NEXT CYL
RADW4    EQU      %
         LW,8     SENSW
*  SET PROCESSOR DA INTO TABLE
         BAL,11   DSCCVTS           REL TO DA
         LB,4     PROCTAB
         STH,8    *PROCTAB,4
         LH,8     8                 IS IT DP
         BEZ      RADW6             NO
*  IF DP SET UP PURE P CYL # WHICH IS DONE LAST
*  IF NOT PURE P  SET UP DATA CYL
         LW,14    M24
         AND,14   PROCTAB
         STB,8    PB:C#,4
         CI,14    PH:PDA
         BE       %+2
         STB,8    PB:DC#,4
RADW6    EQU      %
*
*  LOOP WRITES THRU IOQ ONE PG AT A TIME
*
         LW,15    SENSW             RELATIVE SECT #
         CW,15    BOOTSBAND           ARE WE OUT OF RAD
         BGE      RADOVF              YES
         LI,14    X'800'            R14= SIZE IN BYTES
         LW,13    BUFFER
         AW,13    9
         SLS,13   2                 R13= BYTE ADR OF BUF
         LB,12    MB:SDI              DCTX
         OR,12    Y01FF10           R12= FC,PRI,NRT,DCT
         LW,0     MONBUF            R0 = END ACTION ROUTINE
         LW,1     MONBUF            R1 = EAI
*
         BAL,11   NEWQ
         B        RADW9             DEV NOT THERE
*
         LI,1     (TYC-EARBEG)*4
         LB,3     *MONBUF,1         TYPE OF COMPLETE
         CI,3     1
         BG       RADW9             BAD IO
         AI,9     X'200'            INCR BUFF DISP
         MTW,2    SENSW             TO NEXT GRAN
         MTW,-1   #PGSLEFT
         MTW,-1   NPG
         BGZ      RADW6             MORE PGS
RADW9    EQU      %
         LW,4     10
         PLW,8    TSTACK
         MTW,0    NPG
         BEZ      *8
*  NOT NORMAL COMPLETE  INDICATE ERR
         LI,14    BADSWAP
         B        TYPE
*
RADOVF   EQU      %
         LI,14    NORAD
RADW10   EQU      %
         PLW,8    TSTACK
         LW,4     10
         B        TYPE
DSCCVTS  RES      0
         LCI      3
         PSM,9    TSTACK
         LCI      4
         PSM,4    TSTACK
         BAL,11   DSCCVT
         MTW,0    S:DP              IF DP SWAPPER, DONT RIGHT ADJUST
         BNEZ     %+2
         SLS,8    -16
         LCI      4
         PLM,4    TSTACK
         LCI      3
         PLM,9    TSTACK
         B        *11
         PAGE
*  SET UP MON END ACTION BUF & #PGSLEFT
SETBUF   EQU      %
         BAL,11   GMB
         BNEZ     SB2
         CAL1,8   WAIT
         B        SETBUF
SB2      EQU      %
         STW,14   MONBUF
         AI,14    EARSZ
         LI,1     -EARSZ
         LW,2     EAREND,1
         STW,2    *14,1             EA ROUTINE TO BUF
         BIR,1    %-2
         B        *10
RELBUF   EQU      %
         LW,14    MONBUF
         BAL,11   RMB
         B        *10
EARBEG   EQU      %
         LW,1     14
         STW,12   TYC-EARBEG,1
         B        *11
TYC      RES      1
EAREND   EQU      %
EARSZ    EQU      EAREND-EARBEG
*
         PAGE
ERCK     LB,0     10                L/ERROR CODE
         CI,0     X'43'             C/ERR CODE W/X'43'
         BNE      IOERR             BR IF NOT MISSING KEY
         AND,8    1                 &(CAL1+1) W/X'1FFFF'
         AI,8     RDCLDSP           +DISP FROM CAL1+1 TO NEXT DESIRED INST
         B        *8                RETURN
         PAGE
*
*        CONVERT DISC ADR TO RELATIVE SECTOR NUMBER
*  I 8  = DCT INDEX IN BYTE0  DISC ADR IN REST
*  O 8  = RELATIVE SECTOR NUMBER
*
*
*   REAL SEEK ADR. TO RELATIVE SECTOR
*
*         (**=DOUBLE REGISTER SHIFT) REAL SEEK=CYL.TRK.SEC
*   DISK PACK:|(CYL.TRK.SEC)**(32-CYL%SHFT)~*NSPC
*         + |(TRK.SEC)**(CYL%SHFT-TRK%SHFT)~*NSPT
*                   + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*   RAD: |(TRK.SEC)**(48-TRK%SHFT)~*NSPT
*         + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*
SEEKCVT  EQU      %
          LCI       6
          PSM,R2    TSTACK              SAVE REGS R2-R7
          LB,R4     R8                  R4=DCT INDEX
          BEZ       SEEK%CVT%ERR        ZERO=NO DCT INDEX=ERROR
          LB,R4     DCT22,R4            R4=SUBTYPE TABLE INDEX
          BEZ       SEEK%CVT%ERR        ZERO=NO TYPE GIVEN=ERROR
          LI,R7     0
          LW,R3     R8                  MOVE REAL DSK ADDRESS TO R3
          AND,R3    M24                 CYL# RESTRICTED TO 0-255
          LI,R2     0
          LI,R5     32                  R5=SHIFT OFFSET FOR DISK PACK
          MTW,0     NCYL,R4             CK CYL ALLOCATED DEV.
          BNEZ      CYL%CVT             YES PACK SPECIFIED
          LI,R6     48                  R6=SHIFT OFFSET FOR RAD
          B         TRK%SEEK%CVT
CYL%CVT   EQU       %
          LI,R6     X'7F'
          AND,R6    CYL%SHFT,R4         GET CYL SHIFT FACTOR IN R6
          SW,R5     R6                  R5=CYL SIZE
          SLD,R2    0,R5                R2=CYL # RIGHT JUSTIFIED
          LW,R7     R2                  MOVE CYL # TO R7
          MW,R7     NSPC,R4             CYL # * NSPC
TRK%SEEK%CVT EQU    %
          LI,R2     0
          LI,R5     X'7F'
          AND,R5    TRK%SHFT,R4         GET TRK SHFT FACTOR
          SW,R6     R5
          SLD,R2    0,R6                R2=TRACK ADDR.
          LI,R6     X'7F'
          AND,R6    SEC%SHFT,R4         GET SECTOR SHIFT FACTOR
          SW,R5     R6
          SCS,R3    0,R5                MOVE SECTOR TO R3
          AW,R7     R3                  CYL*NSPC+SEC
          LW,R3     R2
          MW,R3     NSPT,R4             TRK*NSPT
          AW,R7     R3                  R7=RELATIVE SECTOR #
          LW,R8     R7                  MOVE REL.SEC.# TO R8
          LCI       3
SEEK%CVT%EXIT EQU   %
          STCF      11
          LCI       6
          PLM,R2    TSTACK              RESTORE REGISTERS
          LCF       11                  RESTORE CONDITION CODES
          B         *11                 RETURN
SEEK%CVT%ERR EQU    %
          LCI       0                   SET CC FOR ERROR RETURN
          B         SEEK%CVT%EXIT
*
HEADER   DATA     0,0,0
ENDMAK   EQU      %
         END

