*        704729   SIGMA 5/7         BPM M:ALLOCATE
         SYSTEM   SIG7FDP
MODE     EQU      1
MREF     EQU      1
BPMLIB   EQU      0                 1=BUILD BPM LIB UNDER CP-V
*BPMLIB=1 MUST BE USED ONLY WITH MODE=1 AND THEN JUST TO
*FORM A LOADER TO USE IN BUILDING BPM LIBRARIES UNDER CP-V.
         DO       MODE=0
NAMELIST EQU      1
         ELSE
NAMELIST  EQU     0
         FIN
         CSECT    1
         DEF      MCAL
MCAL     EQU      %
         REF      M2,M3,M4,M5,M6,M7,M8,M15,M16,M17,M20,M32,MN1,MN2,;
                  MN3,MN4,MN8,MN9,MN16,M826,MSKFTYPE,Y1,Y2,Y4,Y8,Y01,;
                  Y02,Y08,Y0C,Y0F,Y001,Y002,Y004,Y008,Y00C,;
                  Y001F,Y00FFFF,Y0001,Y0002,Y0003,Y0004,Y0005,Y0006,;
                  Y0007,Y0008,Y000B,;
                  Y0301,Y0303,Y0343,Y0304,Y0405,Y0502,;
                  Y00FF,YFF00FFFF,Y000F,YFFF0FFFF,TXF:,TXM:,;
                  TXLIB,TX6F4:,TXASTL,TXHEAD,;
                  HEADWD,TXTREE,STK2,RFDFSTK2,PASSCODE
         REF      Y000C
         REF      Y00F1
         REF      READBILI,2BNUM,3BNUM,12BNUM,4BNUM,GBYTE,GETSEG
         REF      DECLSTK,DECLSTK1,DECLBAS,RFDFBAS,RFDFSTK,;
                  RFDFSTK1,EXPRSTK,EXPRSTK1,EXPRBAS,BSEG1,BSEG2,;
                  CSEG1,CSEG2,CROM1,CROM2,CRFDF1,CRFDF2,CURBYTE,;
                  RCDSIZE,SEQNUM,SEVLEV,XSL,LASTCARD,BUF,BUF2,;
                  BFR,TEMPPTR,TREEPTR,FCOUNT,FTABLE,;
                  ERRTAB,ERRSTK,TCBSIZE,TCBPTR,FTAB,RSEG00,;
                  RSEG01,RSEG10,RREL00,RREL01,RREL10,CSEG00,;
                  CREL00,CREL01,CREL10,MAX00,;
                  MAX01,MAX10,DLOC,PLOC,SLOC,LOC,START,LOCCT,;
                  LOADBAS,MODBAS,RELDBAS,MBIAS,FBIAS,BIAS,;
                  RDIG,MODSIZ,NOTLLM,MAXRFDF,MAXEXPR,TOPOMEM,;
                  OPENEF
         REF      04LOC
         REF      RFLDMODS,RFLDTBSZ
         REF      LOCWD
         REF      TEMPSIZE,DECLSIZE,EXPRDIS,;
                  RFLOADIS,RFDFDIS,NXROMDIS,SBLNKDIS,ROM1DIS,;
                  TMPSZDIS,NUNSTDIS,00DIS,01DIS,10DIS,NRWACCT,;
                  TREESIZE,TREEDIS,BIASDIS,LOWLIMDS,FCOMDIS,;
                  ERRDIS,LMNDIS,USACTDIS,LMPASS,LMEXPDIS,;
                  RDACT1,ROMSIZE,TCBBLNK
         REF      BINTOHEX,BLANKER,PRINT
         REF      READLM,WRITELM,M:LM,M:LL,M:EF,M:DIC,CLOSE,READEF
         DO       MODE=1
         REF      J:JIT
         REF      CHKLM
         REF      SYMTOP,SYMBOLTB
         REF      MREFLAG,MREFTAB,NXTAVPG
         FIN
         DEF      ALLOCATE
         REF      CODE
         REF      PBUF
         PAGE
         REF      MESSAGE
BGEZ     EQU      X'681'
BE       EQU      X'683'
BNEZ     EQU      X'693'
BGE      EQU      X'681'
BL       EQU      X'691'
BG       EQU      X'692'
BAZ      EQU      X'684'
BCR8     EQU      X'688'
BCR10    EQU      X'68A'
BLE      EQU      X'682'
BEZ      EQU      X'683'
*       QUIT     ERROR, CONDITION,OUTPUT
QUIT     CNAME
         PROC
LF       EQU      %
         DO       NUM(AF)=3
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+4+MODE
         FIN
         STW,AF(3) CODE
         ELSE
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+3+MODE
         FIN
         FIN
         LI,R3    AF(1)
         DO       MODE=1
         LI,R4    AF(3)=SR3
         FIN
         B        MESSAGE
         PEND
*        SNAPIT   FROM,TO,TEXT1,TEXT2
SNAPIT   CNAME
         PROC
LF       CAL1,3   %+1
         DATA     0
         GEN,1,31 AFA(1),AF(1)
         GEN,1,31 AFA(2),AF(2)
         DATA     AF(3),AF(4),X'02000000'
         PEND
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 IMMEDIATE CONSTANTS FOR LOADER.
K0       EQU      0
K1       EQU      1
K2       EQU      2
K3       EQU      3
K4       EQU      4
K5       EQU      5
K6       EQU      6
K7       EQU      7
K8       EQU      8
K9       EQU      9
KA       EQU      X'A'
KB       EQU      X'B'
KC       EQU      X'C'
KD       EQU      X'D'
KE       EQU      X'E'
KF       EQU      X'F'
K10      EQU      X'10'
K11      EQU      X'11'
K12      EQU      X'12'
K16      EQU      X'16'
K17      EQU      X'17'
K19      EQU      X'19'
K1C      EQU      X'1C'
K1E      EQU      X'1E'
K1F      EQU      X'1F'
K20      EQU      X'20'
K22      EQU         X'22'
K24      EQU      X'24'
K26      EQU      X'26'
K39      EQU      X'39'
K3C      EQU      X'3C'
K3F      EQU      X'3F'
K40      EQU      X'40'
K43      EQU      X'43'
K6C      EQU      X'6C'
K78      EQU      X'78'
K80      EQU      X'80'
KF0      EQU      X'F0'
KF1      EQU      X'F1'
KF2      EQU      X'F2'
KFF      EQU      X'FF'
K100     EQU      X'100'
K120     EQU      X'120'
K1FF     EQU      X'1FF'
K200     EQU      X'200'
K202     EQU      X'202'
K256     EQU      X'256'
K800     EQU      X'800'
KC00     EQU      X'C00'
K2000    EQU      X'2000'
K3FFF    EQU      X'3FFF'
K7FFF    EQU      X'7FFF'
KFF00   EQU      X'FF00'
K8000    EQU      X'8000'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -1
KN2      EQU      -2
KN3      EQU      -3
KN4      EQU      -4
KN8      EQU      -8
KN16     EQU      -16
KN100    EQU      -100
KTE      EQU      'E'
KTR      EQU      'R'
         PAGE
ALLOCATE PSW,SR4  *R0
*                                   ADJUST THE 01 LOCATION COUNTER
*                                   OVER THE LOADER-BUILT SECTIONS AND
*                                   ESTABLISH POINTERS TO THE ONES
*                                   NEEDED IN THE TCB. ALSO ALLOW FOR
*                                   REFERENCE LOADING TABLES IF
*                                   NECESSARY.
         LI,R7    K1
         BAL,SR4  SEGLOC
         LW,D3    RFDFBAS
         LW,D4    EXPRBAS
         LW,R4    CSEG1
         BAL,SR4  ESTSEG3                                               729
         LW,D1    CSEG1
         DO       MODE=0
         BNEZ     01DCSECT
         ELSE
         BNEZ     ALLCORELIB
         FIN
         LW,R4    LOCWD
         CI,R4    K10
         DO       MODE=0
         BAZ      %+2
         B        LOADF0
         ELSE
         DO       BPMLIB=1
         B        LOADF0            IF BUILDING BPM LIB UNDER CP-V
         FIN
         BAZ      %+2
         B        ALLCORELIB
         FIN
         DO NAMELIST=1
         MTW,2    PLOC
         FIN
         LW,R4    PLOC
         STW,R4   TREEPTR
         LW,R5    -1,R1
         SW,R5    R1
         DO       MODE=1
         AI,R5    2
         AND,R5   MN1
         FIN
         AW,R4    R5
         DO       MODE=0
         AI,R4    K1
         STW,R4   FTAB
         STW,R4   FTABLE
         AW,R4    FCOUNT
         AI,R4    2
         LW,R5    PLOC
         STW,R4   PLOC
         SW,R4    R5
         STW,R4   01SIZ
         ELSE
         STW,R4   PLOC
         STW,R5   01SIZ
         FIN
         REF      01SIZ
         LW,R4    CSEG1
RFLD     BAL,SR4  ESTSEG3
         LW,R4    LOCWD
         CW,R4    RFLDMODS          CHECK FOR EITHER BREF OR REF LOADING
         DO       MODE=0
         BAZ      LOADF0
         ELSE
         BANZ     %+3
         MTW,0    MREFLAG           OR FOR MREF LOADING
         BNEZ     ALLCORELIB
         FIN
         LW,R5    PLOC
         AI,R5    1                                                     729
         STW,R5   RFLOADIS,R1       START OF RFLD TABLE
         AW,R5    RFLDTBSZ          ADD SIZE OF RFLD TABLE
         STW,R5   RFLDTBSZ
         STW,R5   PLOC
         DO       MODE=0
         B        LOADF0
         ELSE
         B        ALLCORELIB
         FIN
         SPACE    10
*                                   THIS ROUTINE ESTABLISHES THE
*                                   SEGMENT ADDRESSES IN THE TREE.
*                                   R7 SAYS WHICH PROTECTION TYPE.
SEGLOC   EQU      %
         DO       MREF=1
         CI,R7    0
         BNE      SEGLOC2
         MTW,0    MREFLAG           THE CP-V MONITOR'S
         BEZ      SEGLOC2           SUBLINKS' 00LOCS
         LW,R6    CSEG1             HAVE ALREADY BEEN
         BEZ      SEGLOC2           INITIALIZED.
         LI,R7    X'8000'
         STW,R7   DLOC
         B        SEGLOC4
SEGLOC2  EQU      %
         FIN
         AI,R7    DLOC
         LI,R4    Y0                INITIALIZE FOR TM100
         PSW,SR4  *R0
         BAL,SR4  TM100
         PLW,SR4  *R0
         LW,R4    *R7
         LW,R6    CSEG1
         AI,R6    00DIS
         AI,R7    -DLOC             GET OFFSET (=PROTECTION TYPE)
         SLS,R7   1
         AW,R6    R7
         AI,R4    1                 BOUND TO DOUBLEWORD
         SLS,R4   -1
         LW,R5    M16
         STS,R4   *R6,R1
SEGLOC4  EQU      %
         B        *SR4
Y0       DATA     0
         SPACE    10
01DCSECT LW,R4    CSEG1
*                                   ALLOCATE 01 PROTECTION TYPE
*                                   SECTIONS.
         BAL,SR4  ESTRFDF3
01DCSECT1 EQU     %
         LW,D1    PLOC
         AI,D1    K1
         AND,D1   MN1
         STW,D1   PLOC
         LW,D1    Y004
         BAL,SR4  DCSECT
         B        NEXT01DC
*
         LI,R7    PLOC
         BAL,SR4  TM100
         LI,R7    PLOC
         BAL,SR4  PUTVALUE
*
NEXT01DC BAL,SR4  NEXT
         B        01DCSECT1
         DO       MODE+BPMLIB=1
         B        FIXLIB
         FIN
         PAGE
*                                   ALLOCATE CORE LIBRARY AT START
*                                   OF 00 TYPE.
*                                   ALLOCATE BLANK COMMON AFTER CORE
*                                   LIBRARY 00 AREA.
*                                   OF 00 TYPE.
ALLCORELIB EQU    %
         LW,R4    CSEG1
         BEZ      LOADCORELIB
         LI,R7    0
         BAL,SR4  SEGLOC
         B        00DCSECT
LOADCORELIB EQU %
         DO       MODE+BPMLIB=1
         REF      CORELIB
         LH,R4    CORELIB
         BLEZ     LOADCOMMON
         SLS,R4   1
         AWM,R4   DLOC
LOADCOMMON EQU    %
         FIN
         LW,D1    TX6F4:
         LW,R4    CSEG1
         BAL,SR4  ESTRFDF3
GETF4COM LW,R6    3,R4
         CW,R6    D1
         BNE      NEXTF4
         LI,R7    DLOC
         LW,SR4   LOCWD
         CI,SR4   X'80'
         BAZ      %+3
         LW,R7    LOCCT
         AI,R7    FCOMDIS
         BAL,SR4  PUTVALUE
         B        LOADTCB
NEXTF4   BAL,SR4  NEXT
         B        GETF4COM
         PAGE
*                                   ALLOCATE FOR THE TCB.
LOADTCB  LI,R7    K0
         BAL,SR4  SEGLOC
         LW,R4    LOCWD
         CI,R4    K2000
         BANZ     00DCSECT
         LW,R4    DLOC
         STW,R4   TCBPTR
         AW,R4    TCBSIZE
         AI,R4    1
         AND,R4   MN1
         STW,R4   DLOC
         LW,R5    LOCCT
         AI,R5    TMPSZDIS
         LH,R7    *R5
         AI,R7    K1
         SW,R4    R7
         STW,R4   TEMPPTR
         PAGE
*                                   ALLOCATE 00 SECTIONS.
00DCSECT LW,R4    CSEG1
         BAL,SR4  ESTRFDF3
00DC1    LI,D1    K0
         BAL,SR4  DCSECT
         B        NEXT00DC
         LI,R7    DLOC
         BAL,SR4  TM100
         LI,R7    DLOC
         BAL,SR4  PUTVALUE
NEXT00DC BAL,SR4  NEXT
         B        00DC1
         PAGE
         DO       MODE=0[BPMLIB=1
         LI,R7    K2
         BAL,SR4  SEGLOC
         B        LOAD10
         SPACE    10
*                                   ALLOCATE M: DCBS.
LOADF0   LW,D1    PLOC
         AI,D1    1
         AND,D1   MN1
         STW,D1   PLOC
         ELSE
LOADF0   LI,R7    2
         BAL,SR4  SEGLOC
         LW,D1    CSEG1
         BNEZ     01DCSECT
         SLS,R4   1
         STW,R4   FTAB
         STW,R4   FTABLE
         AW,R4    FCOUNT
         MTW,0    FCOUNT
         BEZ      %+2
         AI,4 2
         AI,4     1
         AND,4    MN1
         STW,R4   SLOC
         FIN
         LW,R4    CSEG1
         BAL,SR4  ESTRFDF3
LOADM    LW,D1    TXM:
         BAL,SR3  LOADFMSS
         SPACE    10
*                                   ALLOCATE F: DCBS.
LOADF    LW,R4    CSEG1
         BAL,SR4  ESTRFDF3
LOADF1   LW,D1    TXF:
         DO       MODE+BPMLIB=1
         BAL,SR3  LOADFMSS
*                                   IF ROUNDING HAS OCCURRED TO PREVENT
*                                   DCBS OVERLAPPING PAGE BOUNDARIES,
*                                   THE UNUSED SPACE MUST BE ACCOUNTED FOR
*                                   IN THE TREE. ALSO, THE CORE IMAGE
*                                   AND REL DICT BUFFERS MUST BE MOVED
*                                   DOWN TO REFLECT THE INCREASE IN SIZE
*                                   OF THE RSEG10 BUFFER.
         LW,R5    *R7
         INT,R3   10DIS,R1
         SLS,R3   1
         SW,R5    R3                SIZE OF DCB AREA IN R5
         LW,R7    RSEG10
         SLS,R7   -2
         LW,R3    TOPOMEM
         SW,R3    R7                SIZE OF RSEG10 BUFFER IN R3
         SW,R5    R3
         BLEZ     01DCSECT          B IF RSEG10 BUFFER LARGE ENOUGH
         AI,R5    K1FF              SIZE INCREASE ROUNDED TO
         AND,R5   MN9                 WDS IN PAGE(S)
         AWM,R5   BUF+2             UPDATE 10 SIZE & 01 LOC FOR
         AWM,R5   BUF+4             ALLOCATION SUMMARY
         AWM,R5   PLOC
         AWM,R5   TREEPTR           UPDATE PTR TO TREE TABLE
         AWM,R5   NXTAVPG           FOR WRITING HEAD--SEE WRT.
         AWM,R5   RFLDTBSZ          REF/BREF TAB END
         AWM,R5   RFLOADIS,R1         & BEGINNING POINTERS.
         SLS,R5   -1                CONVERT TO DOUBLEWORDS
         AWM,R5   01DIS,R1          ADD TO 01 LOC IN ROOT'S TREE.
*                                   INCREASE MUST ALSO BE ADDED TO
*                                   01 LOC OF ALL FORWARD LINKS.
         LW,R7    R1
SUBLNK   EQU      %
         INT,SR1  SBLNKDIS,R7
         CI,SR1   K0                IS THERE A SUBLINK
         BEZ      LOADM3
         LW,R7    R1
         AW,R7    SR1
         AWM,R5   01DIS,R7          YES. ADD TO 01 LOC OF SUBLINK
         B        SUBLNK
LOADM3   EQU      %
         SLS,R5   16
         AWM,R5   10DIS,R1          ADD TO DCB SIZE IN ROOT'S TREE
         SLS,R5   -13               BYTE RESOLUTION
         LCW,R5   R5
         LI,R7    RSEG00-1
         LW,D1    LOCWD
         BAL,SR4  MOVDWN            MOVE ROOT BUFFERS DOWN
         CI,D1    X'100'
         BANZ     NOREL10           B IF ABSOLUTE
         LCW,R3   R5                RELOCATABLE - COMPUTE NEW  SIZE
         AI,R3    X'1C'             OF RREL10 BUFFER.
         SLS,R3   -3
         SLS,R3   2
         LCW,R3   R3
         AW,R5    R3                INCLUDE BOTH SIZES IN AMOUNT TO
         LI,R7    RREL00-1          SHIFT LOWER BUFFERS DOWN
         BAL,SR4  MOVDWN
NOREL10  LI,R7    CSEG00-1          MOVE CSEG BUFFERS DOWN
         BAL,SR4  MOVDWN
         CI,D1    X'100'
         BANZ     %+3               B IF ABSOLUTE
         LI,R7    CREL00-1          ELSE MOVE CREL BUFFERS DOWN
         BAL,SR4  MOVDWN
         CI,D1    X'4000'
         BANZ     01DCSECT          DONE IF XMEM
         AWM,R5   SYMTOP            ELSE ADJUST IST WORK AREA
         AWM,R5   SYMBOLTB
         AWM,R5   BSEG2
         LW,R3    1,R7              GET VALUE OF LAST BUFFER SHIFTED
         SLS,R3   2
         CW,R3    EXPRSTK
         QUIT     X'13',BG,R5       QUIT IF BUFFER OVERLAPS EXPR STACK
         B        01DCSECT
MOVDWN   LI,R3    3
         AWM,R5   *R7,R3
         BDR,R3   %-1
         B        *SR4
         ELSE
         LI,SR3   01DCSECT
         B        LOADFMSS
         FIN
         SPACE    10
*                                   ALLOCATE |0 PROTECTION TYPE SECTIONS
         DO       MODE=0[BPMLIB=1
LOAD10   LW,R4    CSEG1
         BAL,SR4  ESTRFDF3
10DC     LW,D1    Y008
         BAL,SR4  DCSECT
         B        NEXT10DC
         LI,R7    SLOC
         BAL,SR4  TM100
         LI,R7    SLOC
         BAL,SR4  PUTVALUE
NEXT10DC BAL,SR4  NEXT
         B        10DC
         ELSE
FIXLIB   EQU      %
         FIN
         LW,R4    CSEG1
*                                   GO BACK AND PUT VALUES IN THE
*                                   CONTROL SECTIONS WHICH CAME IN
*                                   FROM LIBRARIES. THEY HAVE TYPE 06
*                                   AND HENCE HAVE NOT BEEN ALLOCATED.
*                                   ONLY THE DUMMY CSEC IN FROM THE
*                                   LOAD MODULE HAS.
         BAL,SR4  ESTRFDF3
FIXLIB2  LW,R5    *R4
         AND,R5   Y0007             GET TYPE OF ENTRY
         CW,R5    Y0004
         BNE      %+4
         LW,R6    1,R4              TYPE 04, PICK UP NEW VALUE
         LW,R7    2,4
         B        NEXTLIB           AND GO TO NEXT ITEM
         CW,R5    Y0006             NOT 04, IS IT A CSECT (TYPE 06)
         BE       USUALFIX           YES, GO UPDATE THIS ENTRY
         CW,R5    Y0003             IS IT A DSECT
         BNE      NEXTLIB           OTHERS ARE NOT OF INTEREST
         MTW,K0   1,R4              THE DSECT HAS ALREADY BEEN ALLOCATED
         BNEZ     NEXTLIB           IF IT'S VALUE FIELD IS NON-ZERO
USUALFIX LW,R5    Y001              UPDATE THIS ENTRY
         STS,R5   *R4               SET DEFINED BIT
         CI,7     0
         BE       NEXTLIB
         STW,R6   1,R4              SET VALUE FIELD OF THIS ENTRY
         LI,R5    K100
         STW,R5   2,R4              SET RESOLUTION FIELD TO 'WORD'
         LW,R5    *R4
         AND,R5   M16               GET INCREMENTAL VALUE OF THIS ENTRY
         SLS,R5   K1                IN WORDS
         AW,R6    R5                UPDATE CURRENT VALUE WITH INCREMENT
NEXTLIB  BAL,SR4  NEXT
         B        FIXLIB2
         PAGE
ENDAL    LW,R4    CSEG1
         BNEZ     EXITALL
*  PRINT ALLOCATION SUMMARY AFTER ROOT HAS BEEN ALLOCATED
*  CP-V 10 AREA INCLUDES ROUNDING TO PREVENT DCBS' CROSSING
*  A PAGE BOUNDARY.
         DO       MODE=1
         MTW,0    MREFLAG
         BEZ      ENDAL2
         LW,R5    MREFTAB
         AW,R5    RFDFBAS
         LW,R5    *R5               INITIALIZE POINTERS
         QUIT     X'33',BNEZ        ABORT IF MREF TABLE
*                                   NOT ALLOCATED
         STW,R5   RFLOADIS,R1       TO CURRENT POSITION IN &
         AW,R5    RFLDTBSZ          END OF MREF TABLE.
         STW,R5   RFLDTBSZ
ENDAL2   EQU      %
         FIN
         LCI      14
         PSM,R1   *R0
         BAL,SR4  BLANKER
         LI,R5    PBUF
         CAL1,2   PRINT             SPACE TWICE ON SAME
         CAL1,2   PRINT             PAGE AS LOAD COMMAND.
         LI,R5    ALSUMES
         CAL1,2   PRINT
         LI,R5    PBUF
         CAL1,2   PRINT
         LI,R5    LOCPAGS
         CAL1,2   PRINT
         LI,R5    PBUF
         CAL1,2   PRINT
         LI,R3    -3
ALLSUM   LW,R7    BUF+3,R3          RESTORE SIZE
         SLS,R7   -9
         CI,R7    0                 DON'T PRINT IF ZERO.
         BEZ      SUPRESS
         BAL,SR4  BINTOHEX
         STD,D3   PBUF+6
         LW,R7    BUF+6,R3
         BAL,SR4  BINTOHEX
         STD,D3   PBUF+4            LOCATION
         SLS,R3   2
         LCI      4
         LM,SR1   TXTDFS+12,R3
         STM,SR1  PBUF
         SAS,R3   -2
         LI,R5    PBUF
         CAL1,2   PRINT
         BAL,SR4  BLANKER
SUPRESS  BIR,R3   ALLSUM
         LCI      14
         PLM,R1   *R0
* END ALLOCATION SUMMARY
EXITALL  PLW,SR4  *R0
         B        *SR4
         PAGE
*                                   THESE ROUTINES ARE USED FOR INITIAL-
*                                   IZING AND SEARCHING THROUGH A
*                                   SEGMENT REF/DEF STACK.
ESTSEG3  STW,R4   CSEG1
         STW,R4   BSEG1
ESTRFDF3 AI,R4    RFDFDIS
         LW,R5    *R4,R1
         LW,R4    R5
         SLS,R4   -16
         INT,R5   R5
         SLS,R5   1
         AW,R4    R5
         STW,R5   CRFDF1
         STW,R4   CRFDF2
         LW,R4    R5
         B        *SR4
NEXT     LW,R4    CRFDF1
         LW,R5    *R4
         LB,R4    R5
         AW,R4    CRFDF1
         STW,R4   CRFDF1
         CW,R4    CRFDF2
         BL       *SR4
         AI,SR4   K1
         B        *SR4
*                                   THIS ROUTINE CHECKS FOR DSECT'S WITH
*                                   A SPECIAL NAME  (F: OR M:) IN THE
*                                   01 PROTECTION TYPE AND ALLOCATES
*                                   THEM.
LOADFMSS EQU      %
         DO       MODE=0[BPMLIB=1
         LI,R7    PLOC
         ELSE
         LI,R7    SLOC
         FIN
         LW,SR1   Y001
         DO       MODE=0[BPMLIB=1
         LW,SR2   Y004
         ELSE
         LW,SR2   Y008
         FIN
FMSS01   BAL,SR4  SPECDSEC          CHECK FOR SPECIAL DSECT'S
         B        NEXTFMSS           NOT OF INTEREST , GET NEXT ENTRY
         CW,SR2   *R4
         BAZ      NEXTFMSS
         DO       MODE=0
         BAL,SR4  TM100
         FIN
         DO       MODE+BPMLIB=1
         LW,R5    *R4
         AND,R5   M16
         SLS,R5   1
*                                   INSURE DCB CANNOT OVERLAP
*                                   PAGE BOUNDARIES.
         LW,R6    SLOC
         AW,R5    R6
         AI,R5    -1
         AND,R5   MN9
         AND,R6   MN9
         CW,R5    R6
         BE       %+2
         STW,R5   SLOC
         FIN
         CW,SR1   *R4               IS THE ITEM IN A LIBRARY
         BAZ      NOTLIBFM           NO
         DO       MODE=0[BPMLIB=1
         LW,R5    04LOC             LIBRARY F: - M: ITEM, UPDATE VALUE
         STW,R6   1,R5              FIELD OF LAST TYPE 04 ENCOUNTERED
         FIN
         BAL,SR4  PUTVALUE+3
         DO       MODE+BPMLIB=1
         LW,R5    04LOC
         LW,R6    1,R4
         STW,R6   1,R5
         FIN
         B        NEXTFMSS
NOTLIBFM BAL,SR4  PUTVALUE
NEXTFMSS BAL,SR4  NEXT              GET NEXT REF/DEF ENTRY
         B        FMSS01            AND PROCESS
         B        *SR3              HERE IF ALL ITEMS HAVE BEEN SEARCHED
         PAGE
*                                   THIS ROUTINE TESTS A REF/DEF STACK
*                                   ENTRY TO SEE IF IT IS  NON-ALLOCATED
*                                   CONTROL OR DUMMY SECTION OF A GIVEN
*                                   PROTECTION TYPE. R4 POINTS TO THE
*                                   ENTRY.
DCSECT   LW,R5    *R4
         AND,R5   Y000F
         CW,R5    Y000C             PSECT
         BE       DSECT1            YES
         AND,R5   Y0007
         CW,R5    Y0003
         BE       DCSECT2
         CW,R5    Y0004
         BNE      *SR4
DSECT1   EQU      %
         MTW,K0   1,R4              TYPE 04, IF VALUE FIELD IS NON-ZERO,
         BNEZ     *SR4              ALLOCATION HAS ALREADY BEEN MADE
*
DCSECT2  LW,R5    *R4
         CW,R5    Y001
         BAZ      %+4
         LB,R5    *R4
         CI,R5    3
         BNE      *SR4
         LW,R5    *R4
         AND,R5   Y00C
         CW,R5    D1
         BNE      *SR4
         AI,SR4   K1
         B        *SR4
         PAGE
SPECDSEC LW,R5    *R4
*                                   THIS ROUTINE CHECKS A GIVEN ENTRY
*                                   IN THE REF/DEF STACK FOR A DUMMY
*                                   SECTION WITH A GIVEN NAME.
          AND,R5  Y0007
         CW,R5    Y0003
         BE       SPCDSEC3          DSECT ENTRY, GO SEE IF ITS SPECIAL
         CW,R5    Y0004             NOT A DSECT, IS ENTRY TYPE 04
         BNE      *SR4
         STW,R4   04LOC             TYPE 04 ENTRY, RECORD IT'S LOCATION
         B        *SR4
SPCDSEC3 EQU      %
         LW,R5    3,R4
         AND,R5   Y00FFFF
         CW,R5    D1
         BNE      *SR4
         AI,SR4   K1
         B        *SR4
         PAGE
*                                   THIS ROUTINE INCREASES A LOCATION
*                                   COUNTER(R7) TO THE NEXT X '|0' OR
*                                   X'100' ACCORDING TO THE M10 OR M100
*                                   OPTIONS.
*
TM100    LW,R6    *R7
         LW,R5    *R4
         AND,R5   Y000F
         CW,R5    Y000C             PSECT
         BE       TM200
         CW,R5    Y000E
         BNE      %+4               NO
TM200    EQU      %
         AI,R6    K1FF
         AND,R6   MN9
         B        TM1
         LW,R5    LOCWD
         CI,R5    K40
         BAZ      TM10
         AI,R6    KFF
         AND,R6   MN8
TM10     CI,R5    K20
         BAZ      TM1
         AI,R6    KF
         AND,R6   MN4
TM1      STW,R6   *R7
         B        *SR4
Y000E    DATA     X'000E0000'
         PAGE
*                                   THIS ROUTINE PUTS THE VALUE OF A
*                                   LOCATION COUNTER (R7) IN THE
*                                   APPROPRIATE WORD OF A REF/DEF
*                                   ENTRY (R4), MARKS THE ENTRY
*                                   ALLOCATED AND SETS THE RESOLUTION
*                                   TO WORD.
PUTVALUE LW,R5    0,R4                                                  729
         CW,R5    Y001                                                  729
         BANZ     %+3                                                   729
         LI,R5    K100                                                  729
         STW,R5   2,R4                                                  729
         LW,R5    Y001                                                  729
         STS,R5   *R4
         LW,R5    *R7
         STW,R5   1,R4                                                  729
         LW,R5    *R4
         AND,R5   M16
         SLS,R5   1
         AWM,R5   *R7
         B        *SR4
         PAGE
ALSUMES  TEXTC    ' * * ALLOCATION SUMMARY * *'
LOCPAGS  TEXTC    '   PROTECTION     LOCATION   PAGES               '
TXTDFS   TEXT     '  DATA (00)     '
         TEXT     '  PROCEDURE (01)'
         DO       MODE=0
         TEXT     '  STATIC (10)   '
         ELSE
         TEXT     '  DCB (10)      '
         FIN
         END

