*****************
*M*      SYSMAK   SET UP SHARED PROCESSORS ON THE SWAPPER
*****************
         SYSTEM   SIG7FDP
         PCC      0
         DEF      SYSMAK:
         CSECT    1
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      MASKS,SMAKFLG
         SREF     RBUFSIZE
         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      DISCLIMS          PERMIT NEWQ TO READ ALT CYLS
         REF      DCT13             GET TDV STATUS FOR FLAWS
         REF      PSA%END           ALLOCATE USER CYLINDERS FOR SWAPPING
         REF      S:GUAIS           TYPE MEANINGFUL # USERS MESS
         REF      Y1                DO SKIP IO
         REF      DCN               SWAPPER DCTX
         REF      T:SGRNU,MB:GAM4
         REF      SNULL
         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:SPT
         REF      UB:FL
         REF      SB:TQ
         REF      JSPVP,JBUPVP,JOVVP
         REF      JEUPVP
         REF      SPSIZE
         REF      DCT22                                                 DISCB
         REF      NSPT
         REF      NCYL
         REF      CYL%SHFT
         REF      TRK%SHFT
         REF      SEC%SHFT
         REF      NSPC
         PAGE
************************************************************************
*                                                                      *
*                 PROCS                                                *
*                                                                      *
************************************************************************
WPAGE    CNAME    8,1
SRHDR    CNAME    0,12
RHDR     CNAME    4,12
         PROC
LF       BAL,8    NEWQS
         GEN,4,4,8,8,8 NAME(1),15,DCN,NAME(2),255
         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,R14  MASKS+19
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                                                 *
*                                                                      *
************************************************************************
*
TREE     EQU      0
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 #
*
DAMAX    RES      1                 UPPER LIMIT OF SPACE
BUFFER   RES      1
BUFEND   DATA     0
M8X9     DATA     X'1FE00'
         REF      RCVRAD,MAXOVLY
CYLSZS   DATA,2   0,200,400,404
#CYLSZS  EQU      HA(%)-HA(CYLSZS)
ALTCYLS  DATA     X'30607'
         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'
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
MONBUF   RES      1
NPG      RES      1
#PGSLEFT DATA     X'7FFFFFFF'       BIG# FOR RAD AND RMP
PROCTAB  DATA     0
D10      DATA     10
D11      DATA     11
Y00FE    DATA     X'00FE0000'
         BOUND    8
P:ACTEMP DATA     0,0
DCBBUF   DATA     0
         PAGE
************************************************************************
*                                                                      *
*                 FPT'S                                                *
*                                                                      *
************************************************************************
OPEN%FPT EQU      %
         GEN,8,24 X'14',M:EI
         DATA     X'C1000001'       ERR,ABN,FUN,FILE
         DATA     IOERR
         DATA     IOERR
         DATA     1                 INPUT
         DATA     X'02000202'
         TEXT     ':SYS '
         DO1      ABSVAL(%+1)&1     MAKE FILE%NAME ON DOUBLEWORD BOUNDARY
         DATA     X'2000000'
         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    'MAX OUM + BUM =    '
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,R9   MASKS+7           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
         CAL1,1   CLOSE%FPT         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      %
         BAL,11   SEEKCVT           DA TO RELATIVE SECT #
         SLS,5    1                 CALCULATE DAMAX
         AW,5     8
         STW,5    DAMAX
         STW,8    SENSW
         BAL,10   SETBUF            GET MON BUF FOR EA
*                                   & SET #PGSLEFT
         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
         BAL,10   SETBUF            GET A BUFFER
         LW,R9    SMAKFLG
         AND,R9   MASKS+31          TAKE OFF CRASH FLAG
         STW,R9   SENSW             RESTORE SENSW
         BNEZ     RCV1              SHARED PROCESORS NOT CLOBBERED
         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
         LW,9     BOOTSBAND         SET DAMAX
         STW,9    DAMAX
         LI,0     ENDMAK+X'1FF'
         AND,0    M8X9
         STW,0    BUFFER
         LW,0     RCVRAD            GET START OF AVAIL DISC
         AI,R0    RBUFSIZE+RBUFSIZE LEAVE ROOM FOR RECOVER BUFFER
         STW,0    SENSW             PUT IT AWAY
         BAL,11   SET#PGS
*
*  PREPARE FOR SHARED PROCESSOR LOOP
         LI,7     MAXOVLY+4         SKIP GHOST1,FIX, AND ALLOCAT
LOOP     EQU      %
         LD,14    P:NAME,7
         CD,14    DUMNAM
         BNE      OPEN1
         LI,8     -SPSIZE
         AWM,8    #PGSLEFT
         BGZ      %+3
         LW,8     S:CYLSZ
         B        %-3
         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
*        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
         AI,7     1                 BUMP INDEX
         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
         BAL,11   SEEKCVT           DA TO RELATIVE SECT #
         STW,8    SENSW
         LI,11    BUMP2
SET#PGS  EQU      %
         MTW,0    S:DP
         BEZ      *11
         INT,9    SENSW
         LI,8     0
         SLS,9    -1                REL PAGE #
         DW,8     S:CYLSZ
         LW,9     S:CYLSZ
         CI,9     6*19              IS IT AN RMP
         BE       *11               YES, INGOR CYL BOUNDARIES
         SW,9     8
         STW,9    #PGSLEFT
         B        *11
BUMP2    EQU      %
         LH,14    M:EI              IS DCB OPEN
         CI,14    X'20'
         BAZ      %+2
         CAL1,1   CLOSE%FPT         YES, CLOSE IT
         CI,7     PNAMEND           TEST FOR DONE
         BLE      LOOP              NOT YET
         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
         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,R7    RBUFSIZE+1        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
         LI,3     0                 FIND ALL THE FLAWED CYLINDERS
         LI,1     255               AND MAKE A BYTE MAP
         STD,3    ENDMAK-2,1        BYE NONZERO MEANS AT LEAST ONE FLAW
         BDR,1    %-1               ON THE CYLINDER
         LC       #PGSLEFT          IF RMP, USE ALL OFEM
         BNE      RCVA
         LW,8     SENSW             ELSE READ ALT HEADERS TO FIND FLAWS
         PSW,8    TSTACK            (MUST PRESERVE SENSW)
         LB,2     MB:SDI
         LB,5     DCT22,2
         LW,7     NCYL,5            CALCULATE FIRST ALT
         LI,6     #CYLSZS           AND NUMBER TO READ
         CH,7     CYLSZS,6
         BE       %+2
         BDR,6    %-2
         LB,6     ALTCYLS,6
         SLS,7    16                MAKE SEEK ADDRESS
         AI,5     DISCLIMS
         MTB,1    *5                MAKE THE DISC ADDRESS LEGAL
         MTB,1    DAMAX
RCVB     LW,8     7
         BAL,11   SEEKCVT           CONSTRUCT GDA
         STW,8    SENSW
         LI,9     512               READ HEADERS
         RHDR                       READ HEADERS OF CYL INTO BUFFER
         AW,9     BUFFER            BASE OF HEADERS
         LW,2     S:CYLSZ           # OF HEADERS READ
         SLS,2    1
RCVC     LD,0     *9,2
         SLD,0    16                PICK CYLINDER# OUT
         SLS,1    -31               OF BYTE5 AND BIT48
         STB,0    1
         SCS,1    8
         MTB,1    ENDMAK,1          SET FLAG
         BDR,2    RCVC
         AI,7     X'10000'
         BDR,6    RCVB              READ NEXT CYLINDER
         STB,6    *5                RESTORE DISCLIMS
         PLW,8    TSTACK
         STW,8    SENSW
RCVA     RES
         LW,8     PSA%END           CALCULATE LAST PSA CYLINDER
         LB,11    MB:SDI
         STH,11   8
         BAL,11   DSCCVT
         SLS,8    -16
         SW,8     S:UCYL
         STW,8    DAMAX
         LW,R8    SENSW
         BAL,11   DSCCVTS
*  SET UP USER CYL TABLE
         LI,7     MING+1
         INT,4    8
         CI,5     0                 ROUND UP TO NEXT CYL
         BE       %+2
RCVD     RES
         AI,4     1
         CW,4     DAMAX             ARE WE STILL OK
         BG       RCVE
         STB,4    UB:C#,7
         LW,6     S:UCYL            GET S:UCYL CONTIGUOUS
         MTB,0    ENDMAK,4          FLAWFREE CYLINDERS
         BNEZ     RCVD              NOT HERE
         AI,4     1
         BDR,6    %-3
         AI,7     1
         CI,7     SMUIS
         BG       RCV4              DONE WITH ALL USERS
         BDR,4    RCVD              TO NEXT USER
RCVE     RES
*  ALL USERS COULDN'T FIT   TAKE SOME OUT
         AI,7     -1
         LI,6     SNULL             GET NULL STATE #
         STB,7    SB:TQ,6           POINT TAIL TO LAST USER
         LI,9     0
         STB,9    UB:FL,7
*  INDICATE TO OPERATOR HOW MANY USERS IN SYSTEM NOW
         LI,6     3                 INDEX TO BUFFER
         LW,9     7
         SW,9     S:GUAIS           # NONGHOST LEFT
RCV30    RES
         LI,8     0                 CONVERT TO DECIMAL
         DW,8     D10
         AI,8     '0'
         STB,8    DELUS#,6
         AI,9     0
         BEZ      %+2
         BDR,6    RCV30
         CAL1,2   T4USRFPT
RCV4     EQU      %
         LI,2     0
         LB,7     MB:GAM4
         LB,10    MB:SPT
         LW,15    SENSW
         LW,R11   SENSW
         LW,R12   MASKS+31          M31
         STS,R11  SMAKFLG           INDICATE DUMP IN DUMPFILE
         BAL,11   GTS1
         STH,15   SENSW
         LW,15    BOOTSBAND
         AI,R15   -2
GTS1     EQU      %
         LI,14    0
         STH,14   15
         DW,14    10
         SLS,15   1,7
         AW,15    14
         BAL,11   *11
         STW,15   BUFFER
         BAL,11   T:SGRNU           RELEASE WHAT'S LEFT
         MTW,-2   BUFFER
         LW,15    BUFFER
         CH,15    SENSW             DOWN TO SENSW
         BG       T:SGRNU
         BAL,10   RELBUF            FREE MPOOL
         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            INDEX OF LAST OVERLAY SLOT
*  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
         BG       PS55              NO
         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      %
         LI,0     0                 RESET TCB ADDRESS IF NONEXISTANT
         LC       HEADER+1          GET TCB FLAG
         BCS,4    SPT001            NO TCB SPECIFIED
         LW,0     HEADER+2          GET TCB DWD ADDR
         SLS,0    -16
         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
         INT,13   HEADER+6          CHECK DCB BIAS=END OF DATA
         CW,13    1
         BNE      BADPROC
SPT000   EQU      %
         SLS,0    1                 FORM WORD ADR
SPT001   STW,0    P:TCB,7           SAVE IN PROC TABLE
         LI,1     X'1FFFF'
         LS,0     HEADER+1          GET START ADDRESS
         MTW,0    HEADER+9          CHECK FOR CORELIB REQUIREMENT
         BEZ      %+2               AND SET BIT8 IF THERE
         OR,0     Y008
         OR,1     Y008
         STS,0    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,R15  MASKS+8
         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
         AND,0    DCBACMSK          DFLT AC FOR 1ST PAGES IS 2
         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'
DCBACMSK GEN,2,2,2,26   2,2,2,-1    MASK FOR SP SHR PROCS
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,R14   MASKS+24
         AND,14   PROCTAB
         STB,8    PB:C#,4
         CI,14    PH:PDA
         BE       %+2
         STB,8    PB:DC#,4
         LC       #PGSLEFT          CHECK FOR FLAWS
         BNEZ     RADW6             UNLESS RMP
         SRHDR                      READSKIP HEADERS FOR FLAW CHECK
         BCR,4    RADW6             ALL IS HUNKY
         LB,4     MB:SDI            FLAW ENCOUNTERED
         LB,4     DCT22,4           TRY AGAIN AT NEXT TRACK
         INT,3    SENSW
         LI,2     0
         DW,2     NSPT,4
         LCW,2    2
         AW,2     NSPT,4
         CI,2     1                 THAT HAS AN EVEN SECTOR#
         BAZ      %+2
         AW,2     NSPT,4
         AWM,2    SENSW
         SLS,2    -1
         LCW,2    2
         AWM,2    #PGSLEFT
         LW,15    NPG               AND TRY AGAIN
         B        RADW2
RADW6    EQU      %
*
*  LOOP WRITES THRU IOQ ONE PG AT A TIME
*
         WPAGE                      WRITE A PAGE AT BUF + (9)
         BDR,3    RADW9             ERROR TYC
         AI,9     X'200'            INCR BUFF DISP
         MTW,2    SENSW             TO NEXT GRAN
         MTW,-1   #PGSLEFT
         MTW,-1   NPG
         BGZ      RADW6             MORE PGS
         LW,4     10
         PLW,8    TSTACK
         B        *8
RADW9    RES
*  NOT NORMAL COMPLETE  INDICATE ERR
         LI,14    BADSWAP
         B        RADW10
*
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
NEWQS    RES
         LW,15    SENSW             GET D.A.
         CW,15    DAMAX             IS IT OK TO USE
         BGE      RADOVF            NO
         LW,14    NPG               SIZE IF READSKIP HEADERS
         LW,13    Y1                FLAG TO DO SKIP IO
         INT,0    *8                GET INFO
         BCR,12   QS1               MOSTLY DONE
         LI,14    2048**-4          SIZE IF WRITE DATA
         BCR,4    %+2
         LW,14    S:CYLSZ           SIZE IF READ HEADERS
         LW,13    BUFFER            BUFFER FOR DATA TRANSFER
         AW,13    9                 DISP
         SLS,13   2
QS1      RES
         SLS,14   4                 8 BYTES/SECTOR
         STH,1    0                 SET UP FCN,PRIO,RETRIES,DCTX WORD
         LW,12    0
         LW,0     MONBUF            SET END ACTION
         LW,1     MONBUF            AND INFO
         BAL,11   NEWQ              DO THE IO
         B        RADW9             NEVER HAPPENS
         LW,1     MONBUF            GET END ACTION STATUS
         SLS,1    2
         LB,3     TYC,1
         AI,8     1                 SKIP DATA WORD
         LC       TDV,1
         B        *8
         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,2     14
         STW,12   TYC,2
         LD,12    DCT13,1           GT TDV STATUS
         STW,13   TDV,2
         B        *11
TYC      EQU      %-EARBEG
TDV      EQU      TYC+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,4     MB:SDI            DCTX
          LB,R4     DCT22,R4            R4=SUBTYPE TABLE INDEX
          LI,R7     0
          LW,R3     R8                  MOVE REAL DSK ADDRESS TO R3
          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
         LH,3     8
         LB,7     HIGHS,3
         AI,7     DCN
         STH,7    8                 CONVERT HIGH ODER BITS AND PUT DCTX
          LCI       6
          PLM,R2    TSTACK              RESTORE REGISTERS
          LCF       11                  RESTORE CONDITION CODES
          B         *11                 RETURN
HIGHS    DATA     X'8040C0'
*
HEADER   DATA     0,0,0
ENDMAK   EQU      %
         END

