         SYSTEM   SIG7FDP
         TITLE    'PHASE 5.0'
*
* PHASE 5.0 DEFINITIONS
*
         DEF      ILFMAX                                                COBOL50
         DEF      COB50,PH51E,PH52E
         DEF      LABDCL,LABNAM
         DEF      GENORG,OD2,OD3
         DEF      DECLXD,DECLXR,DECLN
         DEF      DECLNN,END51,END52
         DEF      OBFOUT,CHEKSM,EMPSZ,BUFBEG
         DEF      BUFVAR,RECNT,OBJFB1,OBJFB2
         DEF      OBJFB3,OBJFB4
         DEF      MBO
         DEF      MGO
         DEF      INLTAB
         DEF      PRLTAB
         DEF      XRFTAB
         DEF      SYMTABZ
         DEF      OBJCSZ
         DEF      DECLTB
         DEF      NUMSEG
         DEF      ENDOUT
         DEF      LCB
         DEF      OBFLST
         DEF      DECLNO                                                COBOL50
         PAGE
*
* PHASE 5.0 REFERENCES
*
         REF      ABNERR
         REF      COBIOOOF,COBIOOIF
         REF      COBIOCOF,COBIOCIF
         REF      COBIODB
         REF      COB51,COB52
         REF      PH5E
         REF      M:OC
         REF      M:GO,PDBP
         REF      PDB,PDBT,PDBQ,PDBCC
         REF      PDBK
         REF      DIAG
         REF      WROLF
         REF      WROLFS
         REF      M:BO
         REF      TYPE
         REF      M:SI
         REF      M:LI
         REF      PDBZ
         REF      WRMPF,WRMPFS
         PAGE
*
* PHASE 5.0 EQUATES
*
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
LR       EQU       11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
END51    EQU      PH51E
END52    EQU      PH52E
         PAGE
*
* PHASE 5.0 ENTRY
*
COB50    RES      0
         LI,R4    MESS50
         BAL,R11  TYPE
         LI,R2    1                 SET TO SAVE
         LI,R5    4
         BAL,R11  COBIOCOF          CLOSE POF
         LW,R5    PDB
         AND,R5   L(X'000040CA')
         BEZ      PH5E              NO -GOTO PHASE 6
         CAL1,8   PLIST2            M:SEGLD PHASE 5.1
         LI,R2    BA(POFBUF)
         LI,R4    1
         LI,R5    4
         BAL,R11  COBIOOIF          OPEN POF TO INPUT (CLUSTERED)
         LI,R2    BA(OLFBUF)
         LI,R5    1
         BAL,R11  COBIOOOF          OPEN OLF TO OUTPUT (CLUSTERED)
         LI,R2    5
         LI,R3    1
         LW,R4    L(C'OLF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(OLFSBUF)
         LI,R5    2
         BAL,R11  COBIOOOF          OPEN OLFS TO OUTPUT (CLUSTERED)
         LI,R2    5
         LI,R3    2
         LW,R4    L(C'OLFS')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    0
         LI,R5    3
         BAL,R11  COBIOOOF          OPEN ILF TO OUTPUT (NONCLUSTERED)
         LI,R2    10
         LI,R3    3
         LW,R4    L(C'ILF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(MPFBUF)
         LI,R5    5
         BAL,R11  COBIOOOF          OPEN MPF TO OUTPUT(CLUSTERED)
         LI,R2    26
         LI,R3    5
         LW,R4    L(C'MPF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(MPFSBUF)
         LI,R5    0
         BAL,R11  COBIOOOF          OPEN MPFS TO OUTPUT(CLUSTERED)
         LI,R2    26
         LI,R3    0
         LW,R4    L(C'MPFS')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    X'13'
         STB,R2   PDBCC
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS51
         BAL,R11  TYPE
*
         TITLE    '*** INITIALIZE FOR PHASE 5.1,5.2 ***'
         PAGE
* TEST FOR BINARY OUTPUT (IF ANY) TO M:BO, M:GO
         LW,R8    PDB
         AND,R8   =X'C0'            BO, GO BITS
         STW,R8   BINTST            0= NONE
         BEZ      TTB10
         CI,R8    X'80'             BO BIT
         BE       TTB2
         CI,R8    X'40'             GO BIT
         BE       TTB3
         LW,R8    PGO               BOTH GO & BO
         STW,R8   MGO
TTB2     LW,R8    PBO
         STW,R8   MBO
         B        TTB10
TTB3     LW,R8    PGO
         STW,R8   MGO
TTB10    RES      0
* OBTAIN BRANCH TABLE SIZE
         LW,R8    PDBT              NO. OF OVERLAY SEGS
         AND,R8   =X'FFFF'
         STW,R8   NUMSEG            SAVE NO. OF OVERL. SEGM.
         BEZ      P2P
         SLS,R8   2                 NO. OF BYTES FOR O.S. IN B.T.
         AI,R8    4                 4 BYTES FOR R.S. IN BR. TABLE
         LI,R2    1
         STH,R8   PDBT,R2           BRANCH TABEL SIZE TO PDB
         LW,R8    MBO               WAS BO & SEG SPECIFIED              COBOL50
         BEZ      P2P               NO                                  COBOL50
         LW,R8    PSI               YES                                 COBOL50
         STW,R8   MSI                                                   COBOL50
P2P      RES      0
* DEFINE LOCATIONS FOR INLTAB AND PRLTAB
         LW,R8    INLTAB            GET BASE OF SYMBOL TABLE AREA
         AH,R8    PDBK              NUMBER OF INTERNAL LABELS (PER PARA)
         AI,R8    1
         STW,R8   PRLTAB            SET PROCEDURE LABEL TABLE BASE
         LI,R2    1
         AH,R8    PDBK,R2           NUMBER OF PROCEDURE LABELS
         AI,R8    1
         STW,R8   XRFTAB            SET EXTERNAL SYMBOL TABLE BASE
         CI,R8    SYMTABZ           CHECK FOR SYMBOL TABLE OVERFLOW
         BGE      DELB               TOO BIG
         SLS,R8   2                 INITIALIZE
         AI,R8    4                  EXTERNAL SYMBOL
         STW,R8   *XRFTAB             TABLE
         B        DELC
DELB     RES      0
* NOT ENOUGH ROOM IN CORE FOR INLTAB, PRLTAB
         LI,R1    119               **** DIAGNOSTIC ****
         BAL,R11  DIAG
         LI,R8    X'4000'           SET ABORT FLAG
         OR,R8    PDBP
         STW,R8   PDBP
         B        PH51E
DELC     RES      0
         LI,R2    X'80'
         AND,R2   PDBCC             IS BINARY OUTPUT REQUIRED?
         BEZ      %+2                NO
         CAL1,1   PLIST4            M:DEVICE   M:BO,(BIN)
         B        COB51
         TITLE    'PHASE 5.0'
         PAGE
*
* RETURN FROM PHASE 5.1
*
PH51E    RES      0
         LW,R6    PDBP
         CI,R6    X'4000'           ABORT FLAG
         BANZ     PH52E
         CAL1,8   PLIST3            M:SEGLD PHASE 5.2
         LI,R2    1                 SET TO SAVE
         LI,R5    3
         BAL,R11  COBIOCOF          CLOSE ILF
         LI,R2    1                 SET TO SAVE
         LI,R5    4
         BAL,R11  COBIOCIF          CLOSE POF
         LI,R2    0
         LI,R4    1
         LW,R5    =X'80000003'                                          COBOL50
         BAL,R11  COBIOOIF          OPEN ILF TO INPUT (NONCLUSTERED)
         LI,R2    BA(POFBUF)
         LI,R4    1
         LI,R5    4
         BAL,R11  COBIOOIF          OPEN POF TO INPUT (CLUSTERED)
         LI,R2    X'14'
         STB,R2   PDBCC
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS52
         BAL,R11  TYPE
         B        COB52
         PAGE
*
* RETURN FROM PHASE 5.2
*
PH52E    RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    3
         BAL,R11  COBIOCIF          CLOSE ILF
         LW,R5    PDBP
         CI,R5    X'4000'           ABORT FLAG
         BANZ     PH52E2
         LI,R2    -1                SET TO RELEASE
         LI,R5    4
         BAL,R11  COBIOCIF          CLOSE POF
PH52E1   LI,R2    1                 SET TO SAVE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE OLF
         LI,R2    1                 SET TO SAVE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE OLFS
         LI,R2    1                 SET TO SAVE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE MPF
         LI,R2    1                 SET TO SAVE
         LI,R5    0
         BAL,R11  COBIOCOF          CLOSE MPFS
         B        PH5E              RETURN TO PHASE 0
PH52E2   LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE OLF
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE OLFS
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE MPF
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCOF          CLOSE MPFS
         B        PH5E
         PAGE
*
* PHASE 5.0 I/0 BUFFERS
         REF      POFBUF
OLFBUF   RES      75
OLFSBUF  RES      75
MPFBUF   RES      75
MPFSBUF  RES      75
* PHASE 5.0 PLISTS
*
*
MESS50   TEXTC    'COBOL50  
'
MESS51   TEXTC    'COBOL51  
'
MESS52   TEXTC    'COBOL52  
'
PLIST2   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH51
PLIST3   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH52
PLIST4   GEN,8,24 X'22',M:BO        M:DEVICE
         DATA     X'00000010'       BIN
PH51     TEXTC    'COBOL51'
PH52     TEXTC    'COBOL52'
ECB      DATA     0
         TITLE    '*** GENORG SUBROUTINE ***'
         PAGE
*
* GENORG, GENERATE AN ORIGIN OBJECT CODE ITEM
*
*                 DISPLACEMENT VALUE IN R12
*                 DECLARATION NUMBER OF BASE NAME IN R13
*        BAL,LR   GENORG
*
GENORG   RES      0
         STW,LR   BACK
         STW,R12  OD2               STORE DISPLACEMENT VALUE (NEW ORG)
         STW,R13  DECLNO            SAVE OLD DECL NUMBER                COBOL50
         LI,R3    9                 OUTPUT ITEM SIZE
         LI,R7    1
         LW,R2    DECLN,R1          MAX DECL NOS. IN MODULE
         CI,R2    256
         BL       OD1               USE 1 BYTE DECL NO FIELD
         STB,R13  OD3,R7                     SIGN BYTE OF NO.
         SLS,R13  -8
         AI,R7    1
         AI,R3    1                 SET OUTPUT ITEM SIZE TO 10
OD1      STB,R13  OD3,R7            1 BYTE OF DECL. NO
         AI,R7    1
         LI,R2    2                 END CONTR BYTE
         STB,R2   OD3,R7
         LI,R2    BA(ORGDEC)+2
         BAL,LR   OBFOUT            OUTPUT TO OBJ FILE BUFFR
         B        *BACK
* ORIGIN DECLARATION OBJECT CODE ITEM (**** ITEMS TO BE FILLED IN)
ORGDEC   DATA,2   0                 SPACER BYTES
         DATA,1   4                 ORIGIN CONTROL BYTE
         DATA,1   1                 ADD CONSTANT CONTR. BYTE
OD2      DATA     0                 CONSTANT (VALUE DISPLACEMENT) ****
OD3      DATA,1   X'20'             ADD VALUE OF DECLARATION CONTR. BYTE
         DATA,1   0                 DECLAR. NO. OR END CONTR ***
         DATA,1   0                 END CONTR BYTE ***
         DATA,1   0                 SPACER BYTE
*
BACK     DATA     0                 LR SAVE WORD
         TITLE    '*** DECLXD,DECLXR SUBROUTINE ***'
         PAGE
*
* DECLXD GENERATE EXTERNAL DECLARATION OBJ. CODE ITEM
*
DECLXD   RES      0
         LI,R8    3                 EXT.DEF.(ENTRYPOINT)DECL.CONTROL BYT
DECX1    LB,R3    0,R2              PICK UP N (UMBER OF BYTES IN NAME)
         AI,R3    2                 INCREM. BY 2 FOR CONTR., N BYTES
         AI,R2    -1                GET ADDR. OF CONTR. BYTE
         LW,R5    R2
         LB,R15   0,R5              SAVE 1 BYTE FROM POF ITEM
         STB,R8   0,R2              STORE CONTR. BYTE
         STW,LR   DECSAV
         BAL,LR   OBFOUT            OUTPUT DECLARATION ITEM TO OBJ FILE
         STB,R15  0,R5              RESTORE BYTE IN POF ITEM
         LI,R8    1
         AWM,R8   DECLN,R1          INCREM DECL NO FOR MODULE
         B        *DECSAV           RETURN
*
* DECLARE EXTERNAL REFERENCE
*
DECLXR   RES      0
         LI,R8    5                 EXT. REF. DECL. CONTROL BYTE
         B        DECX1             REST IS AME AS EXTRNL. DEF.
DECSAV   DATA     0                 LR SAVE WORD
DECLN    DATA     0                 DECLARAT. NO. ROOT SEGM
DECLNN   DATA     0                 DECL NO OVERLAY SEGM
DECLNO   DATA     0                 OLD DECLARATION NUMBER              COBOL50
         TITLE    '*** OBFOUT SUBROUTINE ***'
         PAGE
*
* OBFOUT, OUTPUT TO LISTING AND OBJECT FILE
*
*        R1=0 FOR ROOT SEGMENT,=1 FOR OVERLAY SEGM. MODULE
*        R2=BYTE ADDRESS OF BYTE STRING
*        R3=LENGTH OF BYTE STRING
*
OBFOUT   RES      0
         STW,LR   SVL
         BAL,LR   OBFLST
         LW,R11   BINTST            TEST FOR BIN. OUTPUT
         BEZ      *SVL              NONE
         LW,LR    SVL
MV3      CW,R3    EMPSZ,R1          COMPARE LENGTH WITH ROOM LEFT
         BG       MV20              NOT ENOUGH
         LW,R10   EMPSZ,R1          ENOUGH ROOM, REDUCE
         SW,R10   R3                BY LENGTH OF BYTE STRING
         STW,R10  EMPSZ,R1          SAVE ROOM SIZE
         LW,R9    R3                USE R9 AS BYTE COUNTER
         SW,R3    R3                SET LENGTH REMAINING TO ZERO
MV5      LW,R7    BUFVAR,R1         REC. ADDR
MV12     LB,R10   0,R2              PICK UP BYTE
         STB,R10  0,R7              TO  OBJ. FILE BUFR
         AWM,R10  CHEKSM,R1         UPDATE CHECKSUM
         AI,R2    1                 UPDATE SOURCE
         AI,R7    1                 AND RECEIV. ADDR
         BDR,R9   MV12              LOOP FOR R9 NO. OF BYTES
            LW,R3    R3                BYTES LEFT
            BNEZ     MV13              YES , CHANGE BUFFR
         STW,R7   BUFVAR,R1
         LW,LR    SVL
         B        *LR
* BUFFER FULL, SET UP FOR OUTPUT
MV13     RES      0
         STW,R2   SVE2
* INCREMENT RECORD NO.
         LW,R2    BUFBEG,R1         BEGIN ADDR OF BUFFR
         LW,R10   CHEKSM,R1         CHECK SUM
         AI,R10   X'A8'             ADD 1ST+4TH BYTE OF 1ST WORD
         AI,R2    1                 GET RECORD NO. FIELD ADDR.
         LW,R9    RECNT,R1          RECORD COUNT
         AI,R9    1
         STW,R9   RECNT,R1
         STB,R9   0,R2              STORE IN 1ST WRD OF REC.
         AW,R10   R9                ADD TO CHECKSUM
* STORE CHECKSUM
         AI,R2    1                 GET CHECKSUM FIELD ADDR.
         STB,R10  0,R2              STORE LEAST SIGN. BYTE ONLY
         LI,R10   0
         STW,R10  CHEKSM,R1         RESET CHECKSUM COUNTER
* RECORD SIZE IS FIXED
*
*OUTPUT RECORD TO OBJECT FILE
*
         LW,R2    BUFBEG,R1         BUFFER ADDRESS
         LI,R10   108               RECORD SIZE BYTES
         BAL,LR   BINOUT
* SWITCH BUFFERS
         LW,R10   BB1,R1            OBJFB1 OR 3 BYTE ADDR, CHECK
         CW,R10   BUFBEG,R1         IF WAS USED LAST,
         BNE      MV16              IF NOT, USE BUFFER 1
         LW,R10   BB2,R1            IF SO, USE BUFFER 2 OR 4
MV16     STW,R10  BUFBEG,R1         SAVE AS BEGIN ADDR
         AI,R10   4                 ADD 4 TO GET DATA ADDR. IN BUFFR
         STW,R10  BUFVAR,R1
         LI,R10   104               RESET EMPTY SOTRAGE SIZE
         STW,R10  EMPSZ,R1          TO 104
         LW,R2    SVE2
            B        MV3
MV20        LW,R9    EMPSZ,R1          ROOM LEFT IN BUFFR
            BEZ      MV13              FULL , GO OUTPUT
            SW,R3    EMPSZ,R1          ITEM SIZE - EMPTY SIZE
         B        MV5
SVE2     DATA     0
LCB      DATA     0                 LISTING CONTROL BYTE
SVL      DATA     0
CHEKSM   DATA     0
         DATA     0                 OVERLAY SEGMENT DATA
BUFBEG   DATA     0
         DATA     0                 OVERLAY SEGMENT DATA
EMPSZ    DATA     0
         DATA     0                 OVERLAY SEGMENT DATA
BUFVAR   DATA     0
         DATA     0                 OVERLAY SEGMENT DATA
RECNT    DATA     0
         DATA     0                 OVERLAY SEGMENT DATA
OBJFB1   DATA,1   0                 REC. TYPE, MODE, FORMAT
         DATA,1   0                 SEQ. NO.
         DATA,1   0                 CHECKSUM
         DATA,1   0                 REC. SIZE
         RES      26                DATA AREA
OBJFB2   RES      27                BUFFR 2 FOR ROOT SEGM DATA
OBJFB3   RES      27                BUFFR 1 FOR OVERLAY DATA
OBJFB4   RES      27                BUFFR 2
BB1      DATA     BA(OBJFB1)
         DATA     BA(OBJFB3)
BB2      DATA     BA(OBJFB2)
         DATA     BA(OBJFB4)
         TITLE    '*** OBFLST SUBROUTINE ***'
         PAGE
*
* OBFLST OBJECT CODE LISTING ROUTINE
*
OBFLST   RES      0
* TEST FOR LISTING OUTPUT
         LW,R10   PDB               COMPILER CONTROL WORD
         AND,R10  L(X'0000400A')
         BEZ      *LR               =0, NO OBJECT LISTING
*
* OUTPUT TO LISTING FILE
*
         LCI      15
         STM,R1   SAVRG
         LW,R6    LCB               LISTING ITEM CONTR. BYTE
         BEZ      LST10
* CONTROL BYTE FOR INITIAL VALUE OR ADDR CONST.
         AI,R2    -1                SAVE 2 BYTES
         LB,R5    0,R2              IN FRONT OF
         STW,R5   SVB1              OBJ. FILE ITEM
         AI,R2    -1
         LB,R5    0,R2
         STW,R5   SVB2
         STW,R2   R4                BYTE ADDR OF CLUSTER
         AI,R3    4                 SIZE + 1 FOR C.B, + 3 FOR S.B.
         SLS,R3   -1                GET 1/2 W SIZE
         STB,R3   0,R2              SIZE OF CLUSTER
         AI,R2    1
         STB,R6   0,R2              NEW CONTROL BYTE
         CI,R10   X'4000'
         BL       %+2               NO LISTING
         EXU       WOLFB,R1
         BAL,9    MAPF
         LW,R5     SVB1             RESTORE 2 BYTES
         LW,R6    SVB2              IN FRONT OF
         STB,R6   0,R4              OBJECT ITEM
         AI,R4    1
         STB,R5   0,R4
LST5     LI,R5    0
         STW,R5   LCB
         LCI      15
         LM,R1    SAVRG
         B        *LR
* NO ADDITIONAL CONTROL BYTE REQ.
LST10    RES      0
         AI,R2    -1                SAVE 1 BYTE IN FRONT
         LB,R5    0,R2              OF ITEM
         STW,R5   SVB1
         STW,R2   R4                BYTE ADDR OF CLUSTER
         AI,R3    3                 SIZE +3 FOR SIZE BYTES
         SLS,R3   -1                1/2 W VALUE
         STB,R3   0,R2              SIZE OF CLUSTER
         CI,R10   X'4000'
         BL       %+2               NO LISTING
         EXU       WOLFB,R1
         BAL,9    MAPF
         LW,R5     SVB1             RESTORE 2 BYTES
         STB,R5   0,R4              RESTORE BYTE IN FRONT OF ITEM
         B        LST5
SAVRG    RES      15
SVB1     RES      1
SVB2     RES      1
WOLFB    BAL,LR    WROLF            WRITE LISTING FILE
         BAL,LR    WROLFS
WMAP     BAL,LR   WRMPF
         BAL,LR   WRMPFS
         TITLE  '***  MPF OUTPUT SUBROUTINE  ***'
         PAGE
CONBYTE  DATA     X'040EC1CA'       CONTROL BYTE
BCNTRL   B        MAP04             BRANCH TABLE
         B        MAP0E
         B        MAPC1
         B        MAPCA
*
* PROCEDURE MAP FILE OUTPUT ROUTINE
*
MAPF     LCI      15
         STM,R1   SAVRM
         LI,R2    10
         AND,R2   PDB
         BEZ      PMAPFE
         AI,R4    1
         LB,R5    0,R4
         CI,R5    X'40'
         BL       MAPB              CONTROL BYTE < X'40'                COBOL50
         CI,R5    X'90'
         BG       MAPB              CONTROL BYTE > X'90'
MAPC1    LW,R6    SURCEN,R1         INSTRUCTION
         BEZ      MAPC4
         LW,R4    COUNTA,R1
         BNEZ     MAPC0
         LW,R4    SETCF,R1
         STW,R4   COUNTA,R1
MAPC0    LW,R4    FIRSTF,R1
         BNEZ     MAPC3
         LW,R5    COUNTA,R1
         OR,R5    L(X'05000000')
         STW,R5   MPFCL             A, B OF MPF
MAPC2    STW,R6   MPFCL+1           C, D OF MPF
         MTW,1    FIRSTF,R1
         MTW,1    COUNTA,R1         BUMP COUNTA BY 1
         LI,R4    BA(MPFCL)
         EXU      WMAP,R1
PMAPFE   LCI      15
         LM,R1    SAVRM
         B        *R9
MAPC3    MTW,1    COUNTA,R1
         B        PMAPFE
MAPC4    MTW,1    SETCF,R1
         B        PMAPFE
MAPB     LI,R6    4                 FIND CONTROL BYTE
         LI,R7    3
MAPB1    CB,R5    CONBYTE,R7
         BNE      %+2
         B        BCNTRL,R7
         AI,R7    -1
         BDR,R6   MAPB1
         B        PMAPFE
MAP04    LW,R5    COUNTA,R1         ORIGIN
         BNEZ     PMAPFE
         AI,R4    1
         LB,R5    0,R4
         CI,R5    1
         BNE      PMAPFE
         LI,R7    16                ADD CONSTANT
         LI,R6    4
         STB,R6   R7
         LW,R6    R4
         MBS,R6   1                 GET 4 BYTES
         SLD,R4   -2
         STW,R4   SETCF,R1
         B        PMAPFE
MAP0E    LI,R5    0                 CLEAR SOURCE LINE NO
         STW,R5   SURCEN,R1
         STW,R5   COUNTA,R1
         B        PMAPFE
MAPCA    LW,R5    L(X'04000018')
         MBS,R4   1                 GET SOURCE LINE NO
         CW,R6    SURCEN,R1
         BE       PMAPFE
         STW,R6   SURCEN,R1         SAVE SOURCE LINE NO
         LI,R4    0
         STW,R4   FIRSTF,R1         CLEAR FIRST INST FLAG
         B        PMAPFE
SAVRM    RES      15
FIRSTF   DATA     0
         DATA     0
SURCEN   DATA     0                 SOURCE LINE NO
         DATA     0
COUNTA   DATA     0                 DISP COUNT
         DATA     0
SETCF    DATA     0
         DATA     0
MPFCL    RES      3                 MPF CLUSTER BUFFER
         TITLE    '***  BINOUT SUBROUTINE  ***'
         PAGE
*
* BINOUT  OUTPUT BINARY RECORD
*        R2  BUFFER ADDRESS  BYTES
*        R10   RECORD SIZE  BYTES
*        NOTE FOR SEGMENTED PROGRAMS THE FOLLOWING DCB'S ARE USED       COBOL50
*        M:GO     ROOT GO OUTPUT                                        COBOL50
*        M:BO     ROOT BO OUTPUT                                        COBOL50
*        M:LI     OVERLAY GO OUTPUT                                     COBOL50
*        M:SI     OVERLAY BO OUTPUT                                     COBOL50
*
BINOUT   RES      0
         SLS,R2   -2
         STW,R2   PL2
         STW,R10  PL3
         CI,R1    0                                                     COBOL50
         BNEZ     BIN2              OVERLAY SEGMENT OUTPUT              COBOL50
         LW,R10   MGO                                                   COBOL50
         BEZ      %+3               NO GO OUTPUT                        COBOL50
         STW,R10  PLSTBIN
         CAL1,1   PLSTBIN
         LW,R10   MBO                                                   COBOL50
         BEZ      *LR               NO BO OUTPUT                        COBOL50
         STW,R10  PLSTBIN
         CAL1,1   PLSTBIN
         B        *LR
PLSTBIN  DATA     0                 GEN,8,24 X'11', M:BO OR M:GO
         DATA     X'70000000'
         DATA     ABNERR
PL2      DATA     0
PL3      DATA     0
BIN2     STW,R2   PL22
         STW,R10  PL32
         CAL1,1   PLSTB2
         LW,R10   MSI               WAS BO ASKED FOR                    COBOL50
         BEZ      *LR               NO                                  COBOL50
         STW,R10  PLSTBIN                                               COBOL50
         CAL1,1   PLSTBIN                                               COBOL50
         B        *LR                                                   COBOL50
PLSTB2   GEN,8,24 X'11',M:LI        BIN. OUTPUT FOR PRIO. SEGMENT
         DATA     X'70000000'
         DATA     ABNERR
PL22     DATA     0
PL32     DATA     0
BINTST   DATA     0
MBO      DATA     0                 USED IN 5.0 AND 5.2
MGO      DATA     0                 USED IN 5.0 AND 5.2
MSI      DATA     0                 USED FOR BO WITH SEGMENTED PROGS    COBOL50
PSI      GEN,8,24 X'11',M:SI                                            COBOL50
PBO      GEN,8,24 X'11',M:BO
PGO      GEN,8,24 X'11',M:GO
         TITLE    '*** ENDOUT SUBROUTINE ***'
         PAGE
*
*ENDOUT TERMINATE MODULE OUTPUT TO OBJ. FILE
*
ENDOUT   RES      0
         STW,LR   ENOT
         LW,R2    BUFBEG,R1
         LW,R9    CHEKSM,R1
         LI,R8    X'1C'
         STB,R8   0,R2              SET 'LAST REC' BITS TO 0
         AW,R9    R8
         AI,R2    1
         LW,R8    RECNT,R1          RECORD COUNT
         AI,R8    1
         STB,R8   0,R2
         AW,R9    R8
         AI,R2    2                 REC SIZE BYTE ADDR
         LW,R8    BUFVAR,R1
         SW,R8    BUFBEG,R1
         STB,R8   0,R2              REC SIZE
         STW,R8   R10               RECORD SIZE BYTES
         AW,R9    R8
         AI,R2    -1                CHECKSUM BYTE ADDR
         STB,R9   0,R2              FINAL CHECKSUM
*** OUTPUT RECORD TO OBJ. FILE ***
         LW,R2    BUFBEG,R1         BUFFER ADDRESS
         BAL,LR   BINOUT
         B        *ENOT             EXIT
ILFMAX   DATA     0                 MAXIMUM SIZE OF ILF RECORD          COBOL50
NUMSEG   DATA     0                 NUMBER OF OVERLAY SEGMENTS
ENOT     DATA     0
         TITLE    '*** TABLES COMMON TO PHASES 5.1,5.2 ***'
         PAGE
LABNAM   DATA,1   6              USER HEADER LABEL AREA NAME
         DATA,6   'C:TLBL'
         BOUND    4
LABDCL   DATA     0                 LABEL AREA NAME DECAR. NO.
         DATA     0                 FOR ROOT AND OVERLAY SEGMENTS
*
DECLTB   RES      51                DECLARATION NO. TABLE FOR FILES
* OBJ. CODE SIZE TABLE (SAME NO. ENTRIES AS BRANCH TABLE)
OBJCSZ   RES      100               OBJECT CODE SIZE  TABLE
INLTAB   DATA     SYMTAB            INTERNAL LABEL TABLE ADDRESS
PRLTAB   DATA     0                 PROCEDURE LABEL TABLE ADDRESS
XRFTAB   DATA     0                 EXTERNAL SYMBOL TABLE ADDRESS
         TITLE    'SYMBOL TABLE AREA'
*
SYMTAB   RES      6000
SYMTABZ  RES      1
         END
