         SYSTEM   SIG7FDP
*
*COB52   PHASE 5.2  PROCESSING
         DEF      COB52
*
         REF      ILFMAX                                                COBOL52
         REF      END52
         REF      GENORG,OD2,OD3
         REF      DECLXD,DECLXR,DECLN
         REF      DECLNN
         REF      DECLNO                                                COBOL52
         REF      OBFOUT,CHEKSM,EMPSZ,BUFBEG
         REF      BUFVAR,RECNT,OBJFB1,OBJFB2
         REF      OBJFB3,OBJFB4
         REF      DECLTB
         REF      LABDCL,LABNAM
         REF      NUMSEG
         REF      RDILF
         REF      LCB
         REF      RDPOF
         REF      PDB
         REF      PDBJ                                                  COBOL52
         REF      PDBP
         REF      PDBPL,PDBPN
         REF      PDBDBG                                                COBOL52
         REF      PDBQ
         REF      PDBU
         REF      PDBZ
         REF      PDBV
         REF      PDBY
         REF      PDBX,CARDNO
         REF      DIAG
         REF      INLTAB
         REF      XRFTAB,SYMTABZ
         REF      MBO,MGO
         REF      PRLTAB
         REF      OBJCSZ
         REF      ENDOUT
         REF      OBFLST
         REF      SL                COMPILATION ERROR SEVERITY LEVEL
         REF      M:LI
         REF      M:GO              DCB CONTAINING PROGR. NAME
         REF      ABNERR
         REF      M:BO                                                  COBOL52
         REF      M:SI                                                  COBOL52
         REF      WSLOC
PDBVA    EQU      PDBV
PRNMAD   EQU      M:GO+23
BONMAD   EQU      M:BO+23                                               COBOL52
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
         TITLE    '*** INITIALIZE PROGRAM ***'
*INITIALIZE CONSTANTS AND TABLES
         PAGE
COB52    RES      0
         LI,R8    0
         STB,R8   OVRLBLN           CLEAR 1ST BYTE OF OVERLAY TABLE     COBOL52
         STW,R8   SETR1
         STW,R8   LCB
         STW,R8   RTDCL             ROOT DECL (0 = ROOT, N = OVERLAY)
         STW,R8   ORGY
         LI,R8    C'00'             BCD ZERO TO PRIO NUMBER
         STW,R8   BCDNM
         LI,R1    0                 ROOT SEGM OUTPUT FLAG
* STORE LOCATION COUNTER VALUES FOR DATA BASES IN ROOT SEGMENT
         LI,R2    0
         LI,R9    0
         STW,R9   BASLOC
STR2     LH,R8    PDBQ,R2           DATA AREA SIZES
         AND,R8   =X'FFFF'
         AI,R8    7                 ROUND TO D W SIZE
         SLS,R8   -3
         SLS,R8   1
         AW,R9    R8                SUM SO FAR
         STW,R9   BASLOC+1,R2       BASE LOC. TABLE
         AI,R2    1
         CI,R2    8                 DO FOR BASE NO.S 1-7
         BL       STR2
         LW,R3    BASLOC+1
         STW,R3   WSLOC             DMAP WS BASE
*        DECLARE WORKING-STORAGE AS EXTERNAL                            COBOL52
*        IF THIS IS THE MAIN PROGRAM                                    COBOL52
         LW,R2    PDB                                                   COBOL52
         CI,R2    X'0200'           CHECK FOR SUBCOMPILE                COBOL52
* NO DEF%WK IF LINKAGE SUB PROG 3-12-76 CW                              COBOL52
         BANZ     STR25             SET ON SWITCH                       COBOL52
         MTB,0    PDBPL             SEE IF LINKAGE CALLED PROG          COBOL52
         BNEZ     STR25             SET ON SWITCH                       COBOL52
         STW,R9   SVE8              SAVE R9                             COBOL52
         LI,R2     BA(WKNAM)                                            COBOL52
         BAL,LR    DECLXD          DECLARE NAME                         COBOL52
         LW,R8     DECLN           NAME DECLAR. NO.                     COBOL52
         LW,R9     WSLOC           OFFSET FROM ST. CONTR. SCTN.         COBOL52
         SLS,R9    2               IN BYTES                             COBOL52
         BAL,LR    EXTDEF          DEFINE NAME                          COBOL52
         LW,R9    SVE8              RESTORE R9                          COBOL52
         B        STR3                                                  COBOL52
STR25    RES      0                                                     COBOL52
         MTW,2    CALLEDSW          SET ON FOR LATER TEST               COBOL52
STR3     RES      0                                                     COBOL52
         LI,R2    3                 CHECK FOR BASE 1 (WORKING-STORAGE)
         LB,R8    PDBVA,R2              OVERFLOW
         BEZ      INL3               NO GO ON
         SLS,R8   14                YES MAKE IT WORDS
         AW,R9    R8                ADD IT TO LOCATION COUNTER
         LI,R2    6
INL2     AWM,R8   BASLOC+1,R2      ADD TO BASES 2-7
         BDR,R2   INL2                  LOCATIONS
INL3     RES      0
         STW,R9   LOCNTR            OBJ. CODE START
         LI,R3    0
         STW,R3   BASLOC+2
         STW,R3   BASLOC+3
         LW,R9    OBJCSZ
         STW,R9   BASLOC+8          LITERAL TABLE
         LI,R3    9
INL4     LW,R2    BASLOC-1,R3       WORD ADDR
         SLS,R2   2                 BYTE ADDR
         STW,R2   NEWADR-1,R3
         BDR,R3   INL4
         LW,R2    NEWADR+8          SAVE BYTE VALUE AS SEGM
         STW,R2   SECSZ             SIZE (IF NO LITERALS)
* OBTAIN PROGRAM NAME
         LW,R8    MGO               SEE IF GO SPECIFIED                 COBOL52
         BNEZ     INL41             YES                                 COBOL52
         LI,R8    WA(BONMAD)        NO--USE BO NAME                     COBOL52
         B        INL42                                                 COBOL52
INL41    RES      0                                                     COBOL52
         LI,R8    WA(PRNMAD)
INL42    RES      0                                                     COBOL52
         AND,R8   =X'01FFFF'        ADDR OF PROGRAM NAME
         SLS,R8   2                 BYTE ADDR
         STW,R8   R3
         LB,R10   0,R3
         CI,R10    29               ********MAX PROGRAM NAME SIZE  ********
         BLE       %+3
         LI,R10    29
         STB,R10   0,R3
         AI,R10   1                 ADD 1 FOR COUNT FIELD
         LI,R9    BA(PROGNM)        DESTINATION ADDR
         LI,R3    0
         STB,R10  R9,R3             INSERT COUNT FIELD FOR MOVE
         MBS,R8   0                 MOVE N,NAME TO PROGNM AREA
         LW,R8    MBO               WAS BO SPECIFIED                    COBOL52
         BEZ      INL5              NO                                  COBOL52
         LI,R8    WA(BONMAD)                                            COBOL52
         AND,R8   =X'01FFFF'        ADDRESS OF BO NAME                  COBOL52
         SLS,R8   2                 BYTE ADDR                           COBOL52
         STW,R8   R3                                                    COBOL52
         LB,R10   0,R3                                                  COBOL52
         CI,R10   29                MAX NAME SIZE                       COBOL52
         BLE      %+3                                                   COBOL52
         LI,R10   29                                                    COBOL52
         STB,R10  0,R3                                                  COBOL52
         AI,R10   1                 ADD 1 FOR COUNT FIELD               COBOL52
         LI,R9    BA(BONAM)         DEST ADDR                           COBOL52
         STB,R10  R9                                                    COBOL52
         MBS,R8   0                 MOVE N, NAME TO BO AREA             COBOL52
         TITLE    '*** DECLARE PROGRAM NAME ***'
         PAGE
*
* DECLARE PROGRAM NAME AS EXT.DEF. (STAND. CONTR. SECTION)
*
INL5     RES      0                                                     COBOL52
         MTW,0    PDBDBG                                                COBOL52
         BEZ      INL51                                                 COBOL52
         LW,R9    PDB                                                   COBOL52
         CI,R9    X'200'            IF SUB COMPILE DO NOT OUTPUT        COBOL52
         BANZ     INL51              DEF FOR 'NO%DBG'                   COBOL52
         LI,R2    BA(DBGSW)                                             COBOL52
         BAL,LR   DECLXD            DECLARE NAME                        COBOL52
         LW,R8    DECLN                                                 COBOL52
         LW,R9    LOCNTR            BEGINNING OF ST CTR SECTION         COBOL52
         SLS,R9   2                 IN BYTES                            COBOL52
         BAL,LR   EXTDEF            DEFINE NAME                         COBOL52
         MTW,1    LOCNTR            UP LOCATION FOR 'PROGRAM START'     COBOL52
INL51    RES      0                                                     COBOL52
         LI,R2    6                 SET SPECIAL LISTING
         STW,R2   LCB               CONTROL BYTE
         LI,R2    BA(PROGNM)
         BAL,LR   DECLXD            DECLARE NAME
         LW,R8    DECLN             NAME DECLAR. NO.
         LI,R9    0                 OFFSET FROM ST.CONTR. SCTN
         BAL,LR   EXTDEF            DEFINE NAME
*
*   GENERATE  ORG 0  OBJECT CODE ITEM FOR START OF ST. CONTR. SECT.
*
         LI,R12   0
         LI,R13   0
         BAL,LR   GENORG
*
* OUTPUT START DEF. ITEM FOR ROOT SEGMENT
*
INL52    RES      0                                                     COBOL52
         LI,R2    BA(PDBPN)-1
         LB,R8    0,R2
         STB,R8   LKDEF             LENGTH
         MTB,2    LKDEF
         LI,R3    BA(LKDEF)+3       X:- BYTE ADDRESS
         STB,R8   R3
         LI,R2    BA(PDBPN)
         MBS,R2   0                 MOVE PROGRAM-ID NAME
         LI,R2    BA(LKDEF)
         BAL,LR   DECLXD            DECLARE NAME
         LW,R8    DECLN
         LW,R9    LOCNTR            DISP OF LINKAGE ENTRY POINT
         LW,R2    CALLEDSW          IF NOT 0 CALLED PROG                COBOL52
         BEZ      INL520            NO SO SKIP THIS                     COBOL52
         MTW,-1   CALLEDSW          DO TWICE ONCE L: ONCE W:            COBOL52
         CI,R2    2                 IF A 2(1ST-TIME) DO L:              COBOL52
         BE       INL520            YES SO USE ADDR ALREADY IN 9        COBOL52
         LW,R9    WSLOC             USE OFFSET FROM BEG W/S W:          COBOL52
INL520   RES      0                                                     COBOL52
         SLS,R9   2
         BAL,LR   EXTDEF            DEFINE NAME
         MTW,0    CALLEDSW          WILL THIS PROG BE CALLED            COBOL52
         BEZ      INL53             NO                                  COBOL52
         LI,R2    1                 INDEX                               COBOL52
         LI,R8    X'E6'             CHANGE L TO W                       COBOL52
         STB,R8   LKDEF,R2          AND GO DECLARE THIS NEW DEF         COBOL52
         B        INL52             SO DEBUGGER CAN USE IT              COBOL52
INL53    RES      0                                                     COBOL52
         MTB,0    PDBPL
         BNEZ     BTO               IN LINKAGE - CALLED PROGRAM
INL6     LW,R9    PDB               IF A SUB-PROGRAM
         CI,R9    X'200'             IS BEING COMPILED
         BANZ     BTO                 DO NOT OUTPUT 'PROGRAM START'
         LW,R9    LOCNTR
         SLS,R9   2
         MTW,0    PDBDBG            SEE IF DEBUG FLAG SET               COBOL52
         BEZ      %+2               NO                                  COBOL52
         MTW,-1   LOCNTR            RESET LOCNTR FOR PROPER ORG         COBOL52
         LI,R2    BA(STARTM)+2      START ADDR OF OUTPUT ITEM
         LW,R8    DECLN
         CI,R8    255
         BG       OTST1             USE 2 BYTE DECLN NO.
         LI,R3    9                 USE 1 BYTE, SET SIZE
         LW,R5    =X'20000200'
         B        OTST2
STARTM   DATA,2   0                 SPACER
         DATA,2   X'0D01'           CONTR BYTES
         DATA     0                 DISPL. OF START ADDR (BYTES)
         DATA     0                 END CONTR BYTES
LKDEF    DATA,1   0                 LINKAGE DEF NAME
         DATA,3   'L: '
         DATA,8   '        '
CALLEDSW DATA     0                 MAY BE 0,1,2                        COBOL52
OTST1    LI,R3    10                ITEM SIZE
         LW,R5    =X'20000002'      ADD DECL. NO. 0 VALUE
OTST2    STW,R9   STARTM+1          BYTE DISPL.
         STW,R5   STARTM+2          CONTR BYTES, DECL NO. 0
         BAL,LR   OBFOUT            OUTPUT 'START' ITEM
         TITLE    '*** INITIAL PRIO-SEGMENT PROCESSING ***'
         PAGE
*
* CHECK FOR BRANCH TABLE OUTPUT
*
BTO      RES      0
         LW,R8    NUMSEG            NUMBER OF PRIO SEGMENTS
         BEZ      BT22              NO OVERLAY SEGMENTS, NO B.T.               -
* GENERATE ORIGIN ITEM FOR BRANCH TABLE
         LW,R12   BASLOC+7          BASE LOC. CNTR VALUE OF BRANCH TABLE
         SLS,R12  2
         LI,R13   0                 DECL. NO. OF ROOT SEGM.
         BAL,LR   GENORG
* GENERATE AND OUTPUT 1ST. BR. TABLE ITEM
         LI,R8    X'44'             CONTR BYTE (LOAD ABSOL. 4 BYTES)
         STW,R8   CNTRL
         LI,R2    BA(CNTRL)
         AI,R2    3                 ADDR OF OUTPUT ITEM
         LI,R3    X'C1'
         STW,R3   LCB
         LI,R3    5                 SIZE OF ITEM
         BAL,LR   OBFOUT
         LW,R3    PDBJ              CHECK FOR CRS                       COBOL52
         CI,R3    3
         BAZ      BT2               NO CONTINUE                         COBOL52
         MTW,2    CRSF              SET FLAG                            COBOL52
*
BT2      RES      0
*
* GENERATE ! TREE CARD IMAGE FOR OVERLAY STRUCTURE
* AND REMAINDER OF BRANCH TABLE ITEMS
*
         LI,R3    19
         LW,R9    =C'    '
TRL1     STW,R9   TRBF,R3           SET TO BLANKS
         BDR,R3   TRL1
         LW,R8    NUMSEG            NO. OF PRIO SEGMENTS
         STW,R8   LPCNT
         LW,R8    TR1
         LW,R9    TR1+1
         STW,R8   TRBF
         STW,R9   TRBF+1
         LB,R2    PROGNM            CH. COUNT OF PROG. NAME
*
         LI,R4    BA(PROGNM)+1      SOURCE ADDR
         LI,R5    BA(TRBF)+6        DESTIN. ADDR
         STB,R2   R5                INSERT CHAR. COUNT
         MBS,R4   0                 MOVE PROGR. NAME TO BUFFR
         LW,R4    CRSF              IS SORT FLAG SET                    COBOL52

         BEZ      SRL1              NO                                  COBOL52

         LW,R4    PDBJ
         CI,R4    1
         BANZ     SRL00             SEQ  SORT
         LI,R4    BA(SR2)           RANDOM SORT
         LI,R8    39                                                    COBOL52
         B        SRL05
SRL00    RES      0
         LI,R4    BA(SR1)
         LI,R8    39
SRL05    RES      0
         STB,R8   R5                                                    COBOL52

         MBS,R4   0                 MOVE SORT ROOT SEGMENTS             COBOL52

         STW,R5   NXTCH                                                 COBOL52

         LW,R4    CRSF                                                  COBOL52

         CI,R4    1                                                     COBOL52

         BNE      SRL1              SEGMENTED                           COBOL52

         LI,LR    SRL3
         B        SRL2              NOT SEGMENTED                       COBOL52

*                                                                       COBOL52

SRL1     RES      0                                                     COBOL52

         LI,LR    TRLOOP                                                COBOL52

*
         LI,R4    BA(TR2)
         LI,R8    2
         STB,R8   R5
         MBS,R4   0                 MOVE -( CHARACTERS
         STW,R5   NXTCH             NEXT CHAR. ADDR
SRL2     RES      0                                                     COBOL52
*
         AI,R2    2                 CHAR. COUNT OF NEW NAME
         STB,R2   PROGNM
         LI,R8    C'0'
         STB,R8   PROGNM,R2         SET PROG-NAME00
         AI,R2    -1
         STB,R8   PROGNM,R2
*
         CAL1,1   PLSTOVR           ASSIGN PROG-NAME 00 TO SCRATCH
*
         LI,R6    BA(PROGNM)
         LI,R7    BA(FLNMO)
         LB,R8    PROGNM
         AI,R8    1                 +1 FOR COUNT CHAR.
         STB,R8   R7
         MBS,R6   0                 FILE-NAME TO OPEN PLSIST
         CAL1,1   OPOV              OPEN FILE
         B        *LR                                                   COBOL52
*
*
TRLOOP   RES      0
         LB,R2    PROGNM            UPDATE PRIO SEGMENT NAME
         LB,R8    PROGNM,R2         FROM 00 TO 01,02, ETC.
         CI,R8    C'9'
         BGE      TRL2
         AI,R8    1
         STB,R8   PROGNM,R2
         B        TRL3
TRL2     LI,R5    C'0'
         STB,R5   PROGNM,R2
         AI,R2    -1
         LB,R8    PROGNM,R2
         AI,R8    1
         STB,R8   PROGNM,R2
TRL3     RES      0
*
* DECLARE OVERL. SEGM. NAME AS XTRNL REF,
* AND OUTPUT A BRANCH TABLE ITEM
*
         LI,R2    BA(PROGNM)        OVERLAY SEGM NAME ADDR
         BAL,LR   DECLXR            DECLARE EXT. REF. ITEM
* SET UP CONTR. BYTES FOR LOAD RELOC. ITEM
         LW,R8    DECLN             LARGEST DECLAR. NO
         LI,R2     BA(OVRLBLN)      BUILD OVERLAY LBLN TABLE STARTING   COBOL52
         MTW,1     SEGCT            AT SECOND BYTE OF TABLE             COBOL52
         AW,R2     SEGCT                                                COBOL52
         STB,R8    0,R2             SAVE DECLAR NO (IN ROOT)            COBOL52
         LI,R2    BA(CNTRL)+3       ADDR OF LEAST SIGN PART OF
         CI,R8    256               DECL. NO.
         BL       BT                1 BYTE FOR DECL NO
         LI,R3    7                 ITEM SIZE
         OR,R8    =X'00520000'      LD RELAT. CONTRL BYTE
         BAL,LR   ST3CB             STORE 3 BYTES
         B        BT1
BT       LI,R3    6                 ITEM SIZE
         OR,R8    =X'00005A00'      CONTR BYTE
         BAL,LR   ST2CB             STORE 2 BYTES
BT1      LW,R2    BEGITM
         BAL,LR   OBFOUT
* RETURN TO TREE CARD PROCESSING
         LB,R2    PROGNM            NAME CHAR CNT
         LW,R3    LPCNT
         CI,R3    1
         BE       %+2               =1, LAST NAME ON TREE CARD
         AI,R2    1                 +1 FOR , CHARACTER
         LW,R5    NXTCH             NXT CHAR POS. IN BUFFR
         AW,R2    R5
         CI,R2    BA(TRBF)+71
         BG       TRL10             NO SPACE FOR WHOLE NAME
*
         LB,R2    PROGNM
         LI,R4    BA(PROGNM)+1
         STB,R2   R5                INSERT COUNT
         MBS,R4   0
         STW,R5   NXTCH
*
TRL4     LW,R8    LPCNT
         BDR,R8   TRL8
* END OF TREE CARD IMAGE
         LW,R8    TR2
         STB,R8   0,R5              INSERT ) IN IMAGE
SRL3     RES      0                                                     COBOL52
*
         CAL1,1   BCDOUT            OUTPUT BCD RECORD
         CAL1,1   CLSOV             CLOSE FILE
*
         LB,R8    PROGNM
         AI,R8    -2                RESET PROG-NAME SIZE
         STB,R8   PROGNM
         B        GETPOF                                                COBOL52
*
TRL8     STW,R8   LPCNT
         LI,R8    C','              INSERT , AFTER NAME
         STB,R8   0,R5
         AI,R5    1                 UPDATE NXT CHAR. POS.
         STW,R5   NXTCH
         B        TRLOOP
*
TRL10    RES      0
         LI,R4    BA(PROGNM)+1
         LB,R9    PROGNM            NO. OF CHAR. IN NAME
         CI,R5    BA(TRBF)+71
         BGE      TRL12             = ONLY LEGAL BR
*
         LI,R8    BA(TRBF)+71
         SW,R8    R5
         STB,R8   R5                NO. OF CHAR. TO MOVE
         LB,R9    PROGNM
         SW,R9    R8                R9 = NO. OF CHAR. LEFT
         MBS,R4   0                 MOVE PART OF NAME
TRL12    STW,R4   TRCCC             ADDR OF 1ST CHAR TO MOVE
         STW,R9   TRCC              NO. CHAR. LEFT TO MOVE
         LI,R8    C';'              SET CONTINUATION CHAR.
         STB,R8   0,R5
         CAL1,1   BCDOUT            OUTPUT CARD IMAGE
         LI,R1    19
         LW,R9    =C'    '
         STW,R9   TRBF,R1
         BDR,R1   %-1
         LI,R8    C'!'
         STB,R8   TRBF
         LI,R5    BA(TRBF)+1        DESTIN. ADDR
         LW,R9    TRCC              CHAR. COUNT
         LW,R4    TRCCC             SOURCE ADDR.
         STB,R9   R5                COUNT INTO DESTIN. WORD
         MBS,R4   0
         STW,R5   NXTCH
         B        TRL4
TRBF     RES      20                80 COL. CARD IMAGE
TR1      DATA     C'!TRE'
         DATA     C'E   '
TR2      DATA     C'-(,)'
BCDC     DATA     C'0000'
LPCNT    DATA     0
NXTCH    DATA     0
BCDOUT   GEN,8,24 X'11',M:LI
         DATA     X'70000000'
         DATA     ABNERR            ABN. RETURN
         DATA     TRBF
         DATA     80                80 COL. CARD IMAGE
TRCC     DATA     0
TRCCC    DATA     0
         DATA     0                 SPACER
         DATA     0
CRSF     DATA     0                                                     COBOL52
SR1      TEXT     '-S:SRT-S:DCB1-SSP-(SSP0,SSP1,SSP2,SSP3)'
SR2      TEXT     '-S:SRT-S:DCB1-SRP-(SRP0,SRP1,SRP2,SRP3)'
PROGNM   RES      10                PROGRAM NAME
BONAM    RES      8                                                     COBOL52
WKNAM    TEXTC     'DEF%WK'        NAME WORKING-STORAGE                 COBOL52
DBGSW    TEXTC    'NO%DBG'                                              COBOL52
OVRLBLN  RES       26               OVERLAY LBLN TABLE (FROM ROOT REF'S)COBOL52
SEGCT    DATA      0                SEGMENT COUNTER                     COBOL52
CNTRL    RES      1                 SPACE FOR CONTR. BYTES
INSTR    BAL,11   0,1               BRANCH TABLE ENTRY FORMAT
BT22     RES      0
         TITLE    '***  OBTAIN POF CLUSTER ITEMS ***'
         LW,R3    PDBJ              CHECK FOR CRS                       COBOL52
         CI,R3    3
         BAZ      GETPOF            NO. CONTINUE                        COBOL52
         MTW,1    CRSF              SET FLAG                            COBOL52
         B        BT2               GO BUILD TREE CARD                  COBOL52
         PAGE
* OBTAIN POF CLUSTER ITEMS
GETPOF   RES      0
         BAL,LR   RDPOF             GET POF CLUSTER
         LW,R1    SETR1             0 FOR ROOT, 1 FOR OVERLAY
         AI,R2    1                 GET CONTR BYTE ADDR
         LB,R6    0,R2              GET CONTROL BYTE
         STW,R6   SVR6
         CI,R6    X'4F'
         BG       POFERR            UNKNOWN CONTROL BYTE
         CI,R6    X'21'             TEST FOR INSTR. ITEMS
         BGE      G2                NOT INSTR.
         LW,R12   LOCNTR            INSTR. LOC. CNTR
         SLS,R12  2                 BYTE VALUE
         CW,R12   ORGY,R1           COMP. WITH CURRENT ORIGIN
         BE       G2                NO INTERRUPT IN INSTR. SEQUENCE
         STW,R12  ORGY,R1
         STW,R2   SAVR2
         LI,R13   0                 DECLAR. RELAT. TO STND. CNTRL SCT
         BAL,LR   GENORG            GENERATE ORIGIN ITEM
         LW,R2    SAVR2
         LB,R6    0,R2
G2       RES      0
         EXU      JUMP,R6           JUMP ON CONTR BYTE
JUMP     B        POFERR            UNKNOWN CONTROL BYTE
         B        CONSPR            1   CONSTANT  INSTR
         B        INLPR1            2   INTERNL  LABEL,COMPLETE
         B        INLPR2            3   INTERNL  LABEL,OFFSET
         B        PRLPR1            4   PROCEDURE LABEL,COMPLETE
         B        PRLPR2            5   PROCEDURE LABEL,OFFSET
         B        LOCPR1            6   LOCATION COUNTER,COMPL
         B        LOCPR2            7   LOCATION COUNTER OFFSET
         B        EXTRPR            8   EXTERNAL  REFERENCE
         B        DATRPR            9   DATA  REFERENCE (LONG FORM)
         B        SET1
         B        POFERR
         B        POFERR            0C
         B        POFERR            0D
         B        SET2              0E
         B        SET3              0F
         B        DATPR2            10  MISC. DATA (DATA REFS,SHORT)
         B        DATPR2            11  WORKING  STORAGE
         B        DATPR2            12  REPORT SECTION
         B        DATPR2            13  REPORT REGION
         B        DATPR2            14  COND NAME,EDITING MASKS
         B        DATPR2            15  EXIT  TABLE
         B        DATPR2            16  TEMP  STORAGE
         B        DATPR2            17 BRANCH TABLE
         B        DATPR4            18 LITERAL TABLE
         B        DATPR3            19 COMMON
         B        DATPR5            1A  FILE LABEL AREA
         DO       6
         B        POFERR            CONTROL BYTE ERROR
         FIN
         B        INVAP1            21 BINARY INITIAL VALUES
         B        INVAP2            22 ADCON, INTRNL LABEL COMPL
         B        INVAP3            23 AC, INTRNL LABEL OFFSET
         B        INVAP4            24 AC, PROC LABEL COMPL
         B        INVAP5            25 AC, PROC LABEL OFFSET
         B        INVAP6            26 AC, LOC CNTR COMPL
         B        INVAP7            27 AC, LOC CNTR OFFSET
         B        INVAP8            28 AC, EXTRNL REF
         B        INVAP9            29 AC, DATA REF
         B        INVAP1A           2A FL.PNT(1W)
         B        INVAP1B           2B FL.PNT(2W)
         B        INVAP10           2C DECIMAL
         B        INVAP11           2D ALPHANUM.
         B        INVAP12           2E NUMERIC
         DO       18
         B        POFERR            CONTROL BYTE ERROR
         FIN
         B        GETPOF            41 INT.LABEL
         B        GETPOF            42 PROC. LABEL (SECTION)
         B        PARGPR            43 PROC. LABEL (PARAGR)
         B        ENTRPR            44 ENTRY POINT (SECTION)
         B        ENTRPR            45 ENTRY POINT (PARAGR)
         B        PRISPR            46 PRIO SEGM
         B        LINEPR            47  LINE COUNT
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        POFERR            CONTROL BYTE ERROR
         B        ENDPR             4F  END OF POF
* POF ITEM ERROR, CONTINUE ASSEMBLY
POFERR   RES      0
         LI,R1    515
         BAL,LR   DIAG              COMPILER ERROR 15
         B        GETPOF
BADCB    DATA     0
*  SET SPECIAL LISTING CONTROL BYTE FOR OLF,OLFS
SET1     LI,R8    PRLPR1
         B        SET4
SET2     LI,R8    EXTRPR
         B        SET4
SET3     LI,R8    DATRPR
SET4     LI,R9    X'40'
         STW,R9   LCB2
         B        *R8               GO TO NORMAL PROCESSING
LCB2     DATA     0                 SPECIAL LISTING CONTROL BYTE
         TITLE    '*** INSTRUCTION ITEM PROCESSORS ***'
         PAGE
*
*CONSPR  CONSTANT  INSTRUCTION  PROCESSOR
*        R2=ADDR  OF CONTR  BYTE  IN   POF  ITEM
CONSPR   RES      0
         LB,R8    CB1               GET LOAD ABSOLUTE CONTR BYTE
         STB,R8   0,R2              STORE IN FRONT OF INSTRUCTION
         LI,R3    X'C1'
         STW,R3   LCB
         LI,R3    5                 PICK  UP  COUNT  (5  BYTES)
         BAL,LR   OBFOUT            OUTPUT  5  BYTES  TO  OBJ  FILE
         B        LOCINC            GO  INCREM.  LOC. COUNTER
*
*INLPR1  INTERNAL LABEL REFERENCE PROCESSOR (RELOCATABLE)
*
INLPR1   RES      0
         LI,R7    0                 LABEL REF. REGISTER
         LB,R8    CB2               RELOC. CONTR. BYTE
         LW,R9    INLTAB            INT. LABEL TABLE ADDR
         B        ADRF
*
*INLPR2  INTERNAL LABEL REFERENCE (OFFSET)
*
INLPR2   RES      0
         LI,R7    0                 LABEL  REF
         LB,R8    CB1               ABSOLUTE
         LW,R9    INLTAB            INT. LABEL TABLE ADDR
         LI,R15   X'C1'
         STW,R15  LCB
         B        ADRF
*
* PRLPR1 PROCEDURE LABEL REFERENCE PROCESSOR (RELOCATABLE)
*
PRLPR1   RES      0
         LW,R7    LCB2
         STW,R7   LCB               LISTING CONTROL BYTE
         LI,R7    0                 LABEL REF. FLAG
         STW,R7   LCB2
         LW,R9    PRLTAB            PROC. LABEL TABLE ADDR
         CI,R1    0                 CHECK FOR ROOT OR OVERLAY SEG
         BE       PRL2              ROOT SEGMENT
* OVERLAY SEGMENT PROCESSING
         LW,R4    R2                POF ITEM ADDR
         AI,R4    3                 GET ADDR OF LABEL NO. FIELD
         SLS,R4   -1                1/2 W
         LH,R5    0,R4              LABEL NO
         AND,R5   =X'FFFF'          NO SIGN
         AW,R5    PRLTAB            PROC. LABEL TABLE ADDR
         LB,R15   *R5               PRIO SEGM NO. OF LABEL
         CW,R15   SEGN              CURRENT SEGMENT NO.
         BE       PRL2              SAME AS CURRENT SEGM.
* REFER. TO ROOT SEGMENT
         LW,R8    RTDCL             ROOT SEGM DECL. NO.
         LW,R15   DECLNN            MOST RECENT DECL NO. IN OVERLAY
         CI,R15   256
         BL       PRL1              1 BYTE DECL. NO. FIELD
         OR,R8    =X'00520000'      USE 2 BYTE NO. FIELD
         LI,R3    7                 SIZE OF OUTPUT ITEM
         BAL,LR   ST3CB             STORE 3 CONTR BYTES
         B        ADDR
PRL1     OR,R8    =X'00005A00'      CONTR BYTE
         LI,R3    6                 ITEM SIZE
         BAL,LR   ST2CB             STORE 2 CONTR BYTES
         B        ADDR
PRL2     LB,R8    CB2               CONTR BYTE,RELOC TO ST.CNTR SCT
         B        ADRF
*
*PRLPR2  PROCEDURE LABEL REFERENCE PROCESSOR (OFFSET)
*
PRLPR2   RES      0
         LI,R7    0                 LABEL REF
         LB,R8    CB1               CONTR. BYTE (ABSOLUTE)
         LW,R9    PRLTAB            PROC. LABEL TABLE ADDR
         LI,R15   X'C1'
         STW,R15  LCB
         B        ADRF
*
*LOCPR1  LOCATION COUNTER REFERENCE (RELOCATABLE)
*
LOCPR1   RES      0
         LI,R7    1                 LOC. CNTR REF
         LB,R8    CB2               RELOC.  CONTROL  BYTE
         B        ADRF
*
*LOCPR2  LOCATION COUNTER REFERENCE (OFFSET)
*
LOCPR2   RES      0
         LI,R7    1                 LOC  COUNTER  REF
         LB,R8    CB1               ABSOLUTE  CONTR  BYTE
         LI,R15   X'C1'
         STW,R15  LCB
         B        ADRF
*
*EXTRPR  EXTERNAL REFERENCE PROCESSOR
*
EXTRPR   RES      0
         STW,R2   SVR2
         AI,R2    5                 GET ADDR OF N FIELD IN POF ITEM
         BAL,LR   XSYMR             PROCESS EXTERNAL SYMBOL
         LW,R2    SVR2              GET POF ITEM ADDR
         LW,R7    DECLN,R1          LARGEST DECLAR. NO. ASSIGNED
         CI,R7    256               COMPARE WITH 256
         BL       EX2               LESS, USE 1 BYTE FOR NO.
         LI,R3    7                 GR, USE 2 BYTES, SET SIZE TO 7
         OR,R8    =X'00520000'      ADD CONTR BYTE TO DECL. NO.
         BAL,LR   ST3CB             STORE 3 BYTES
         B        EX3
EX2      OR,R8    =X'00005A00'      ADD CONTR BYTE TO DECL NO
         LI,R3    6                 ITEM SIZE
         BAL,LR   ST2CB             STORE 2 BYTES
EX3      LW,R2    BEGITM            ITEM BEGIN ADDR.
         LW,R11   LCB2
         STW,R11  LCB               LISTING CONTROL BYTE
         LI,R11   0
         STW,R11  LCB2
         BAL,LR   OBFOUT            OUTPUT ITEM TO OBJ. FILE
         B        LOCINC
*
*DATRPR  DATA REFERENCE INSTRUCTION PROCESSOR
*
DATRPR   RES      0                 ENTRY  FOR  LONG  INSTR  FORM AT
         BAL,LR   DATREF
*  FIX ADDR. FIELD OF INSTRUCTION
* R4= H.W. ADDR. OF RIGHT HALF OF INSTR.
* R5= ADDR. VALUE
         STH,R5   0,R4
         SLS,R5   -16
         AI,R4    -1
         LH,R8    0,R4
         OR,R8    R5
         STH,R8   0,R4
         LW,R11   LCB2
         STW,R11  LCB               LISTING CONTROL BYTE
         LI,R11   0
         STW,R11  LCB2
         BAL,LR   OBFOUT
         B        LOCINC            INCREM LOC CNTR
*
*DATPR2    ENTRY FOR SHORT INSTRUCTION FORMAT (WORD REFER.)
*
DATPR2   RES      0
         LW,R8    RTDCL             DECL NO OF ROOT SEGM ST. CNTRL SECTN
         OR,R8    =X'80'
DP       SW,R6    =X'10'            REDUCE CONTR BYTE TO 0-9
         LI,R7    2                 FLAG FOR DATA REF
         B        ADRF
DATPR3   RES      0
         LI,R8    X'81'
         B        DP
DATPR4   RES      0
         LI,R8    X'80'             LITERAL REFS ALWAYS TO
         B        DP                ST. CONTR. SECTION OF CUR. MODUL
DATPR5   RES      0
         LW,R8    LABDCL,R1
         OR,R8    =X'80'
         B        DP
*BASE LOCATION COUNTER VALUES (WORD ADDR.)
BASLOC   DATA     0                 MISC. DATA
         DATA     0                 WORKING STORAGE
         DATA     0                 REPORT SECTION
         DATA     0                 REPORT REGION
         DATA     0                 CONDIT. NAMES, EDITING MASKS
         DATA     0                 EXIT TABLE
         DATA     0                 TEMP. STORAGE
         DATA     0                 BRANCH TABLE
         DATA     0                 LITERAL TABLE
         DATA     0                 COMMON BASE, MUST BE LEFT AT ZERO
         DATA     0
CB1      DATA     X'44000000'       CONTR BYTE CONST. LOAD (4 BYTES)
CB2      DATA     X'80000080'       RELOC LOAD RELAT TO STANDARD
SVR2     DATA     0                 R2 SAVE CELL
         TITLE    '***  INITIAL VALUE PROCESSING  ***'
         PAGE
*
* 4 BYTE INITIAL VALUE, LOAD ABSOLUTE
*
INVAP1   LI,R3    4                 ITEM SIZE
         LI,R8    X'C2'
         STW,R8   LCBS
         LI,R8    X'44'             LOAD ABSOL. CONTR BYTE
         B        INVAPR
*
* FL. POINT (1W)
*
INVAP1A  LI,R8    X'C4'
         STW,R8   LCBS
         LI,R3    4                 SIZE
         LI,R8    X'44'             LOAD ABSOL
         B        INVAPR
*
INVAP1B  LI,R3    8                 DOUBLE WORD INITL VALUE
         LI,R8    X'C5'
         STW,R8   LCBS
         LI,R8    X'48'
         B        INVAPR
*
* ADDR. CONSTANT, INTERNAL LABEL
*
INVAP2   LI,R8    X'80'             LOAD RELOC. RELAT. TO STAND. C.S.
         LI,R15   X'C9'
         B        IN1
INVAP3   LI,R8    X'44'             LOAD 4 BYTES ABSOLUTE
         LI,R15   X'C3'
IN1      LW,R7    INLTAB            INLTAB TABLE ADDR
         STW,R15  LCBS
         B        IN3
*
* ADDR. CONSTANT, PROCEDURE LABEL
*
INVAP4   LI,R8    X'80'             RELOC.
         LI,R15   X'C9'
         B        IN2
INVAP5   LI,R8    X'44'             ABSOLUTE
         LI,R15   X'C3'
IN2      LW,R7    PRLTAB            PRLTAB TABLE ADDR
         STW,R15  LCBS
IN3      AI,R2    7                 BYTE ADDR OF LABEL FIELD IN POF
         SLS,R2   -1                1/2 W ADDR
         LH,R9    0,R2              LABEL REF. NO.
         AND,R9   =X'FFFF'          NO SIGN
         AW,R7    R9                ADDR OF LABEL VALUE
         LW,R9    0,R7              LABEL VALUE
* MOVE 3 BYTES TO OBJECT FILE ITEM
IN4      STH,R9   0,R2
         SLS,R9   -16
         SLS,R2   1
         AI,R2    -1
         LB,R7    0,R2
         OR,R7    R9
         STB,R7   0,R2
         AI,R2    -5                ADDR OF BASE NO. IN POF
         LI,R3    4                 ITEM SIZE
         LI,R1    0                 ADCONS ALWAYS TO ROOT SEGM
         B        INV
*
* ADDR. CONSTANT, LOCATION COUNTER
*
INVAP6   LI,R8    X'80'             RELOC
         LI,R15   X'C9'
         B        IN5
INVAP7   LI,R8    X'44'             ABSOLUTE
         LI,R15   X'C3'
IN5      AI,R2    7                 BYTE ADDR OF INCR,DECR FIELD
         STW,R15  LCBS
         SLS,R2   -1                IN POF ITEM
         LH,R9    0,R2
         AW,R9    LOCNTR
         B        IN4
*
* ADDR. CONSTANT, EXTERNAL REFERENCE
*
INVAP8   STW,R2   SVE2
         AI,R2    9
         LI,R1    0                 ADCON ALWAYS IN ROOT SEGMENT
         BAL,LR   XSYMR             PROCESS EXTERNAL SYMBOL
         STW,R8   DECLR             DECLAR. NO.
         LW,R2    SVE2
*
* ADDR. CONSTANT, DATA REFERENCE
*
INVAP9   RES      0
         LI,R15   X'C9'
         STW,R15  LCBS
         AI,R2    1
         LB,R4    2,R2
         STW,R4   SVR4
         B        INV
*
* DECIMAL INTL VALUE
*
INVAP10  LI,R4    X'C6'
         STW,R4   LCBS
         B        INVAPR
*
* ALPHANUMERIC
*
INVAP11  LI,R4    X'C7'
         STW,R4   LCBS
         B        INVAPR
*
* NUMERIC
*
INVAP12  LI,R4    X'C8'
         STW,R4   LCBS
         B        INVAPR
SAVBD    DATA     0
*
* INITIAL VALUE PROCESSOR
*
INVAPR   RES      0
         AI,R2    1
INV1     RES      0
INV      LI,R4    0
         STW,R4   DECLNU            0 FOR ROOT SEGM. DECLAR.
         LB,R4    0,R2
         STW,R2   SVE2
         CI,R4    9                 COMPARE WITH COMMON BASE NO
         BE       GETPOF            NO COMMON PROCESSING IN 5.2
         CI,R4    10
         BG       FILINV            INITIAL VALUES FOR FILE AREAS
         CI,R4    8                 LITERAL TABLE BASE NO.
         BE       %+2               SEGMENT R1 SET O.K.
INFB     LI,R1    0                 SET R1 FOR ROOT SEGM. OUTPUT
         STW,R3   SVE3
         LI,R12   0
         STW,R12  BYTRM
         LI,R3    48                BA(R12)
         AW,R3    =X'03000001'
         MBS,R2   1                 MOVE DISPLACEM. TO R12
         LW,R13   DECLNU            DECL NO (ST. CONT. SECT, OR FILE)   COBOL52
         AW,R12   NEWADR,R4         GET ORIGIN VALUE OF ITEM
         CW,R12   ORGY,R1
         BNE      INFB1             NOT CONTINUOUS DATA                 COBOL52
         CW,R13   DECLNO            COMPARE WITH LAST DECL NUMBER       COBOL52
         BE       INV2              CONTINUOUS DATA                     COBOL52
INFB1    RES      0                                                     COBOL52
         STW,R12  ORGY,R1           NEW ORIGIN FOR DATA ITEM
* HOLE IN STORAGE AREA, GENERATE ORIGIN DECLARATION
         STW,R8   SVE8
         STW,R4   SVE4
         BAL,LR   GENORG            GENERATE ORIGIN DECLAR.
         LW,R4    SVE4
         LW,R8    SVE8              CONTROL BYTE
INV2     LW,R2    SVE2              ADDR OF BASE NO. IN POF
         AI,R2    -1                ADDR OF CONTR BYTE
         LB,R6    0,R2
         CI,R6    X'2B'
         BG       INV11             VARIABLE LENGTH ITEM
         CI,R6    X'28'
         BE       INV17             EXTERNAL REFER.
         CI,R6    X'29'
         BE       INV20             AD CON, DATA REFER.
         CI,R6    X'24'             AC, PROC LABEL COMPL                COBOL52
         BNE      INV3                                                  COBOL52
         CI,R4    5                 SEE IF PROC EXIT TABLE              COBOL52
         BNE      INV3              NO                                  COBOL52
         LW,R3    SEGN              SEGMENT NO                          COBOL52
         AI,R3    BA(OVRLBLN)       PICK UP DECL NO FOR                 COBOL52
         LB,R8    0,R3              CURRENT SEGMENT                     COBOL52
         B        INV17A            PROCESS AS EXTERNAL                 COBOL52
INV3     RES      0                                                     COBOL52
         LW,R3    SVE3
         AI,R2    4                 ADDR OF CONTR. BYTE FIELD
INV4     AWM,R3   ORGY,R1           UPDATE ORIGIN
         AI,R3    1                 INCREM. SIZE FOR CONTR BYTE
INV5     STB,R8   0,R2              STORE CONTROL BYTE
INV6     RES      0
         CI,R4    8                 TEST FOR LITERAL BASE NO.
         BNE      INV8              NOT LITERAL ITEM
         LW,R6    ORGY,R1           SAVE ORIGIN (BYTES)
         STW,R6   SECSZ,R1          AS ST. CONTR. SECTION SIZE
INV8     RES      0
*  OUTPUT INITIAL VALUE TO OBJ FILE BUFFR
         LW,R15   LCBS              CONTROL BYTE FOR
         STW,R15  LCB               LISTING FILE
         BAL,LR   OBFOUT
         LW,R3    BYTRM             BYTES REMAINING
         BEZ      GETPOF            NONE, GET NEXT POF ITEM
         LW,R2    BAD               BYTE ADDR OF PREV STRING
         AI,R2    16                NEXT ADDR OF ITEM IN POF
         B        INV13
INV11    AI,R2    5                 ADDR OF LENGTH FIELD
         LB,R3    0,R2              LENGTH OF VALUE
INV13    CI,R3    16
         BL       INV16             LESS THAN 16
         BG       INV15             GREATER, DO IN SETS OF 16 BYTES
         LI,R8    X'40'             =16, LOAD CONTR BYTE FOR 16
         B        INV16A
INV15    AI,R3    -16               REDUCE BY 16
         STW,R3   BYTRM             SAVE AS BYTES REMAINING
         LI,R3    16                ITEM SIZE
         LI,R8    X'40'             CONTR BYTE FOR 16 BYTES
         STW,R2   BAD               SAVE POF ITEM ADDR
         B        INV4
INV16    LI,R8    X'40'             CONTR BYTE
         AW,R8    R3                SET COUNT BITS
INV16A   LI,R13   0
         STW,R13  BYTRM
         B        INV4
INV17    RES      0
         LW,R8    DECLR             DECLAR NO FOR EXT. REF
INV17A   RES      0                                                     COBOL52
         AI,R2    4                 ADDR FOR LEAST SIGN. NO. FIELD
* STORE CONTR. BYTE, DECLAR. NO. IN FRONT OF ADDR. CONST. DATA
         LW,R9    DECLN             LARGEST DECLN IN ROOT SEGM
         CI,R9    256
         BL       INV19             USE 1 BYTE NO. FIELD
         LI,R3    7                 ITEM SIZE (3 CONTR + 4 DATA)
         OR,R8    =X'00520000'      CONTROL BYTE (WORD RESOLUTION)
         BAL,LR   ST3CB             STORE CONTR BYTES
         B        INV22
INV19    OR,R8    =X'00005A00'      CONTR BYTE
         LI,R3    6                 ITEM SIZE (2 CONTR + 4 DATA)
         BAL,LR   ST2CB             STORE CONTR BYTES
         B        INV22
INV20    AI,R2    4
         BAL,LR   DATREF            PROCESS DATA REFER.
         STH,R5   0,R4              STORE 2 BYTES OF ADDR VALUE
         SLS,R5   -16
         AI,R4    -1
         LH,R8    0,R4
         OR,R8    R5
         STH,R8   0,R4
INV22    LI,R8    4                 DATA LENGTH
         AWM,R8   ORGY,R1           UPDATE ORIG.
         LW,R2    BEGITM            BEGIN ADDR OF OUTPUT ITEM
         B        INV8
NEWADR   RES      9                 BASE ADDR (BYTES) OF DATA AREAS
         DATA     0                 COMMON
         DATA     0                 LABEL AREA
ORGY     RES      2
BYTRM    DATA     0
BAD      DATA     0
DECLR    DATA     0
SECSZ    RES      2                 STAND. CONTR.SECT SIZE (ROOT,OVRL)
SVE2     DATA     0
SVE3     DATA     0
SVE8     DATA     0
SVE4     DATA     0
LCBS     DATA     0
*
* INITIAL VALUE FOR FILE AREA (USUALLY REPORT, R:REPORT
* DUMMY CONTROL SECTION).
*
FILINV   RES      0
         CI,R4    61                TEST BASE NO. OF INIT. VALUE
         BL       FV1               BASE 11-60
         CI,R4    111
         BL       FV2               BASE 61-110
         AI,R4    -110              BASE 111-160 (N.G. FOR REPORTS)
         B        FV3
FV1      AI,R4    -10               B.N. 1-50
         LI,R2    1                 SET FOR A FIELD IN DECLTB
         LI,R5    2
         B        FV3
FV2      AI,R4    -60
         LI,R2    2                 B FIELD IN DECLTB
         LI,R5    3
FV3      SLS,R4   2                 FILE NO. TO BYTE OFFSET
         AW,R2    R4                + OFFSET FOR A,B,C FIELD
         LB,R15   DECLTB,R2         DECL. NO. OF FILE AREA
         STW,R15  DECLNU            SAVE FOR ORIGIN ITEM
         LW,R4    R5
         LW,R2    SVE2
         B        INFB
DECLNU   DATA     0
         TITLE    '*** BEGINNING OF PARAGRAPH ***'
         PAGE
*
*PARGPR  PARAGRAPH
*
PARGPR   RES      0
*****    INPUT RECORD FROM ILF TO INLTAB ******
         LW,R2    INLTAB            INLTAB TABLE ADDR
         SLS,R2   2                 B.A.
         LW,R3    ILFMAX                                                COBOL52
         BAL,LR   RDILF             INPUT INLTAB RECORD
         B        GETPOF
         TITLE    '*** ENTRY POINT DECLARATIONS ***'
         PAGE
*
* ENTRY POINT DECLARATION
*
ENTRPR   RES      0
         STW,R2   SVE2
         AI,R2    3                 E FIELD ADDR
         SLS,R2   -1                1/2 W ADDR
         LH,R8    0,R2              PICK UP E
         LI,R3    1                 AND
         STH,R8   SAVE,R3           SAVE E IN SAVE
         LW,R2    SVE2
         AI,R2    5                 ADDR OF N,NAME IN POF
         BAL,LR   DECLXD            DECL. EXT. DEF NAME
         LW,R8    DECLN,R1          DECL. NO. OF NAME
         LW,R9    LOCNTR            LOC. CNTR. VALUE
         SLS,R9   2                 GET BYTE OFFSET
         BAL,LR   EXTDEF            DEFINE EXT. NAME
         LW,R2    SVE2
         AI,R2    5
         LB,R8    0,R2              PRECEDE NAME WITH N,X:
         LI,R9    C':'              AS EXTERNAL NAME
         STB,R9   0,R2              OF EXIT TABLE ENTRY
         AI,R2    -1
         LI,R9    C'X'
         STB,R9   0,R2
         AI,R2    -1
         AI,R8    2                 INCR. COUNT FOR X: CHAR.
         STB,R8   0,R2              STORE IN FRONT OF X: NAME
         LI,R1    0                 FORCE OUTPUT TO ROOT SEGM MODULE
         BAL,LR   DECLXD            DECL X: NAME AS EXT. DEF IN ROOT
         LW,R9    SAVE
         AI,R9    -1
         SLS,R9   2
         AW,R9    NEWADR+5
         LW,R8    DECLN             DECLAR. NO. OF X: NAME
         BAL,LR   EXTDEF            DEFINE EXT. NAME
         LW,R2    SVE2
         LB,R8    0,R2              CONTR BYTE OF POF ITEM
         CI,R8    X'45'
         BE       PARGPR            ALSO BEGINNING OF PARAGRAPH
         B        GETPOF
SAVE     DATA     0                 SAVE E FIELD
         TITLE    '*** PRIORITY SEGMENTS ***'
         PAGE
*
*PRISPR PRIORITY SEGMENTATION PROCESSING
*
PRISPR   RES      0
         LW,R1    SETR1
         BEZ      PR1               SETR1=0,BEGINNIG OF 1ST. PRIO SEGM
         BAL,LR   ENDMOD            =1,END OF PREV. PRIO. MODULE
*  CLOSE SCRATCH FILE FOR OVERLAY SEGMENT
         LW,R15   MGO                                                   COBOL52
         BEZ      PR1               NO GO OUTPUT                         COBOL52
         CAL1,1   CLSOV
PR1      RES      0                                                     COBOL52
         LW,R15   MBO               WAS BO SPECIFIED                    COBOL52
         BEZ      %+4               NO                                  COBOL52
         LW,R15   CLSOVBO           BO FOR SEGMENTED PROGS              COBOL52
         STW,R15  CLSROOT                                               COBOL52
         CAL1,1   CLSROOT           CLOSE BO                            COBOL52
         LI,R1    1                                                     COBOL52
         STW,R1   SETR1             R1=0 FOR ROOT,=1 FOR OVERL MODULE
         LI,R8    0
         STW,R8   DECLNN            DECL. NO FOR OVERLAY SEGM.
         STW,R8   LOCNTR
         STW,R8   ORGY+1
         LI,R3    50
PR2      STW,R8   DECLTB2,R3        0 TO FILE DECL.TABLE (OVERL. SEGS)
         BDR,R3   PR2
* ZERO OUT DECL. NO. FIELDS IN XTRNL REF TABLE (OVERLAYS)
         LW,R3    XRFTAB            XTRNL REF. TABLE ADDR
         SLS,R3   2                 B.A.
         AI,R3    4                 FIRST ENTRY
         CW,R3    *XRFTAB           CONTROL WORD
         BE       PR6               EMPTY TABLE
PR4      AI,R3    2                 DECL NO FIELD FOR OVERLAY MOD
         STB,R8   0,R3
         AI,R3    1
         STB,R8   0,R3
         AI,R3    1
         LB,R9    0,R3
         AW,R3    R9                ADDR OF NEXT ENTRY
         AI,R3    1
         CW,R3    *XRFTAB
         BL       PR4               LOOP TRU TABLE
PR6      RES      0
         LW,R2    SEGN
         AI,R2    1
         STW,R2   SEGN
* SET ADDR FOR LITERALS IN NEW MODULE
         LW,R8    OBJCSZ,R2         NEW SEGM CODE SIZE
         STW,R8   BASLOC+8          W.A. OF LITERAL TABLE
         SLS,R8   2
         STW,R8   NEWADR+8          NEW LITERAL TABLE BEGIN ADDR
         STW,R8   SECSZ+1
* UPDATE BCD PRIO NUMBER
         LI,R2    3
         LB,R8    BCDNM,R2
         CI,R8    C'9'
         BGE      PR7
         AI,R8    1
         STB,R8   BCDNM,R2
         B        PR8
PR7      LI,R5    C'0'
         STB,R5   BCDNM,R2
         AI,R2    -1
         LB,R8    BCDNM,R2
         AI,R8    1
         STB,R8   BCDNM,R2
PR8      RES      0
* RE-INITIALIZE OBFOUT PARAMETERS
         LI,R8    -1
         STW,R8   RECNT,R1
         LI,R2    BA(OBJFB3)
         STW,R2   BUFBEG,R1
         AI,R2    4
         STW,R2   BUFVAR,R1
         LI,R8    104
         STW,R8   EMPSZ,R1
         LI,R8    0
         STW,R8   CHEKSM,R1
         LW,R8    =X'3C00006C'
         STW,R8   OBJFB3
         STW,R8   OBJFB4
*CHECK FOR COMMON STORAGE
         LW,R8    PDBU              COMMON SIZE
         AND,R8   =X'FFFF'
         LI,R2    2                 GET BASE 9 (COMMON-STORAGE)
         LB,R2    PDBVA,R2              OVERFLOW
         SLS,R2   14                    IN WORDS
         AW,R8    R2                  ADD TO COMMON SIZE
         BEZ      PR10              NO COMMON
         LI,R2    BA(PDBY)          N,COMMON-NAME ADDR
         BAL,LR   DECLXR            DECL. EXT. REF (DEC. NO. 1)
PR10     RES      0                 IN OVERLAY MODULE
* DECLARE ROOT SEGMENT NAME AS EXTERNAL REFERENCE
         LI,R2    BA(PROGNM)        ADDR OF N,PROGR.-NAME
         BAL,LR   DECLXR            DECLARE EXT. REF.
         LW,R8    DECLNN            SAVE DECLAR. NO. AS ROOT
         STW,R8   RTDCL             SEGM. ST. CONTR. SECTION DECL. NO.
*
*  ASSIGN SCRATCH FILE FOR OVERLAY SEGMENT BINARY OUTPUT
* DECLARE OVERLAY SEGMENT NAME AS EXTERNAL
*
         LW,R2    MBO               WAS BO SPECIFIED                    COBOL52
         BEZ      PR11              NO                                  COBOL52
         LB,R2    BONAM             NAME CHAR COUNT (BO NAME)           COBOL52
         AI,R2    2                                                     COBOL52
         STB,R2   BONAM                                                 COBOL52
         STB,R2   PROGNM                                                COBOL52
         LI,R8    BA(BONAM)                                             COBOL52
         LI,R9    BA(BONAMFPT)                                          COBOL52
         AI,R2    1                 +1 FOR COUNT CHAR                   COBOL52
         STB,R2   R9                                                    COBOL52
         AI,R2    -1                                                    COBOL52
         LW,R3    BCDNM             BCD PRIO NO.                        COBOL52
         STB,R3   BONAM,R2                                              COBOL52
         STB,R3   PROGNM,R2                                             COBOL52
         AI,R2    -1                SOTRE AT END OF NAME                COBOL52
         SLS,R3   -8                                                    COBOL52
         STB,R3   BONAM,R2                                              COBOL52
         STB,R3   PROGNM,R2                                             COBOL52
         MBS,R8   0                                                     COBOL52
         CAL1,1   OPOVBO            OPEN BO FILE FOR OVERLAY            COBOL52
         B        PR12              BYPASS GO OPTION                    COBOL52
PR11     RES      0                                                     COBOL52
         LB,R2    PROGNM            NAME CHAR. COUNT (PROG. NAME)
         AI,R2    2                 ADD FOR 2 CHAR. PRIO NO.
         STB,R2   PROGNM
         LI,R8    BA(PROGNM)
         LI,R9    BA(FLNMO)
         AI,R2    1                 +1 FOR COUNT CHAR.
         STB,R2   R9
         AI,R2    -1
         LW,R3    BCDNM             BCD PRIO NO.
         STB,R3   PROGNM,R2
         AI,R2    -1                STORE AT END OF NAME
         SLS,R3   -8
         STB,R3   PROGNM,R2
*  ASSIGN FILE FOR OVERLAY
         MBS,R8   0                 MOVE FILE NAME TO PLIST
         CAL1,1   PLSTOVR
*  OPEN FILE FOR OVERLAY
         CAL1,1   OPOV
* DECLARE SEGMENT NAME AS EXTERNAL DEF.
PR12     RES      0                                                     COBOL52
         LI,R2    6                 SET SPECIAL LISTING
         STW,R2   LCB               CONTROL BYTE
         LI,R2    BA(PROGNM)
         BAL,LR   DECLXD            DECLARE NAME
         LW,R8    DECLNN            DECLAR. NO.
         LI,R9    0                 OFFSET
         BAL,LR   EXTDEF            DEFINE EXT.
         LB,R2    PROGNM            RESET TO ORIGINAL LENGTH
         AI,R2    -2
         STB,R2   PROGNM
         LB,R2    BONAM             RESET TO ORIGINAL LENGTH            COBOL52
         AI,R2    -2                                                    COBOL52
         STB,R2   BONAM                                                 COBOL52
*
*   GENERATE  ORG 0  OBJECT CODE ITEM FOR START OF ST. CONTR. SECT.
*
         LI,R12   0
         LI,R13   0
         BAL,LR   GENORG
*
PR15     RES      0
         B        GETPOF
BUFCW    DATA     X'3900006C'       OBJ FILE BUFFER CONTR WORD
SETR1    DATA     0
SEGN     DATA     0                 PRIO SEGMENT NO (0-50)
RTDCL    DATA     0                 ROOT SEGM ST. CONTR SECT DECL NO
BCDNM    DATA     0                 BCD PRIO. NO.
PLSTOVR  GEN,8,24 X'0F',M:LI
         DATA     X'58000050'
         DATA     ABNERR
         DATA     0
         GEN,32   PROGNM
OPOV     GEN,8,24 X'14',M:LI
         DATA     X'5F400001'
         DATA     ABNERR
         DATA     200               MAX REC SIZE
         DATA     10
         DATA     1
         DATA     1
         DATA     8
         DATA     2                 SAVE OPTION
         DATA     X'01010808'
FLNMO    RES       8                FILE NAME FOR OVERLAY
OPOVBO   GEN,8,24 X'14',M:SI                                            COBOL52
         DATA     X'5F400001'                                           COBOL52
         DATA     ABNERR                                                COBOL52
         DATA     200                                                   COBOL52
         DATA     10                                                    COBOL52
         DATA     1                                                     COBOL52
         DATA     1                                                     COBOL52
         DATA     8                                                     COBOL52
         DATA     2                                                     COBOL52
         DATA     X'03000000'       REMOVE  PASSWORD
         DATA     X'02000000'       REMOVE  ACCOUNT
         DATA     X'07000000'       REMOVE ANY SERIAL NUMBERS           COBOL52
         DATA     X'01010808'                                           COBOL52
BONAMFPT RES      8                                                     COBOL52
CLSOVBO  GEN,8,24 X'15',M:SI                                            COBOL52
CLSOV    GEN,8,24 X'15',M:LI
         DATA     X'80000000'
         DATA     2
         TITLE    '*** END OF PHASE 5.2 ***'
         PAGE
*
* ENDPR END OF POF PROCESSING
*
ENDPR    RES      0
         LI,R1    0                 PROCESS FOR ROOT SEGM MODULE
         BAL,LR   ENDMOD            END OF MODULE PROCESSING
*  CLOSE ROOT SEGM. OUTPUT FILE
* TEST TYPE OF OUTPUT (M:BO OR M:GO)
         LW,R15   MBO
         BEZ      %+4
         AW,R15   =X'04000000'
         STW,R15  CLSROOT
         CAL1,1   CLSROOT
         LW,R15   MGO
         BEZ      %+4
         AW,R15   =X'04000000'
         STW,R15  CLSROOT
         CAL1,1   CLSROOT
         LW,R1    SETR1
         BEZ      END52             =0, NO OVERLAY MODULE
         BAL,LR   ENDMOD            =1, END OF OVERLAY MODULE
*  CLOSE SCRATCH FILE FOR OVERLAY SEGMENT
         LW,R15   MGO               SEE IF GO REQUESTED                 COBOL52
         BEZ      %+2               NO                                  COBOL52
         CAL1,1   CLSOV
         LW,R15   MBO               WAS BO & SEG SPECIFIED              COBOL52
         BEZ      END52             NO                                  COBOL52
         LW,R15   CLSOVBO                                               COBOL52
         STW,R15  CLSROOT                                               COBOL52
         CAL1,1   CLSROOT           CLOSE M:SI (BO FOR SEGMENTED)       COBOL52
         B        END52
CLSROOT  DATA     0                 GEN,8,24 X'15', M:BO OR M:GO
         DATA     X'80000000'
         DATA     2
         TITLE    '*** SOURCE LINE COUNT PROCESSING ***'
         PAGE
*
* LINEPR OUTPUT LINE COUNT TO LISTING FILE
*
LINEPR   RES      0
         LI,R8    X'CA'             CONTROL BYTE
         STW,R8   LCB
         AI,R2    1
         LI,R3    4                 SIZE OF ITEM
         BAL,LR   OBFLST
         B        GETPOF
         TITLE    '***  ADRF - ADDR. FIELD PROCESSING  ***'
         PAGE
*
*ADRF    INSTRUCTION ADDRESS FIELD PROCESSOR
*        FOR WORD ADDRESSING
*
ADRF     RES      0
         STB,R8   0,R2              STORE CONTR. BYTE BY INSTRUCTION
         LI,R3    5                 SIZE OF ITEM
         STW,R2   BEGITM            SAVE BEGIN ADDR OF ITEM
* ENTRY FOR ITEMS WITH MORE THAN ONE CONTROL BYTE
ADDR     RES      0
         AI,R2    3
         SLS,R2   -1
         LH,R5    0,R2
         EXU      REF1,R7
         STH,R5   0,R2
         AND,R5   =X'010000'
         BEZ      ST2
         AI,R2    -1
         LH,R9    0,R2
         OR,R9    =1
         STH,R9   0,R2
ST2      LW,R2    BEGITM
         BAL,LR   OBFOUT
         B        LOCINC
REF1     LW,R5    *R9,R5            PICK UP LABEL ADDR (INTRNL,PROCED.)
REF2     AW,R5    LOCNTR            ADD LOCATION COUNTR VALUE
REF3     AW,R5    BASLOC,R6         ADD VALUE OF DATA BASE
         TITLE    '***  LOCINC - INCREM. LOCATION COUNTER  ***'
         PAGE
*
*LOCINC   INCREMENT LOCATION COUNTER
*
LOCINC   RES      0
         LI,R8    1
         AWM,R8   LOCNTR
         LI,R8    4
         AWM,R8   ORGY,R1           UPDATE ORIGIN
         B        GETPOF            GET NEXT POF ITEM
LOCNTR   DATA     0                 LOCATION COUNTER
         TITLE    '*** XSYMR SUBROUTINE ***'
         PAGE
*
* XSYMR   EXTERNAL SYMBOL (REFERENCE) PROCESSOR
*        IN-R2=ADDR OF N FIELD OF POF ITEM
*        R1=0, ROOT SEGMENT, R1=1 OVERLAY SEGMENT
*        OUT-R8=DECLARATION NO. (2 BYTES)
*
XSYMR    RES      0
         STW,LR   XSYBK
         STW,R2   SAVR2             SAVE ADDR OF (N,SYMBOL) STRING
         LW,R7    XRFTAB            XTRNL REF TABLE ADDR
         SLS,R7   2
         AI,R7    4                 ADDR. OF FIRST ENTRY IN TABLE
         STW,R7   ENTAD             SAVE ENTRY ADDR
         LB,R9    0,R2              N FIELD OF POF ITEM
         AI,R9    1                 ADD 1 FOR N BYTE, GIVES COUNT
XSY2     RES      0
         CW,R7    *XRFTAB           NEW ADDR: TABLE CONTR. WORD
         BGE      XSY3              BRANCH IF END OF ENTRIES REACHED
         LW,R6    R2                ADDR OF N,SYMBOL STRING (POF)
         AI,R7    4                 ADDR OF N,SYMBOL STRING (TABLE)
         STB,R9   R7                INSERT COUNT BYTE
         CBS,R6   0                 COMPARE POF, TABLE ENTRY
         BE       XSY4              EQUAL, FOUND NAME IN TABLE
         LW,R7    ENTAD             NOT EQUAL, GET ENTRY ADDR
         AI,R7    4                 ADD FOR DECLAR. BYTES
         LB,R8    0,R7              SIZE OF ENTRY IN TABLE              COBOL52
         AW,R7    R8                ADD SIZE TO ADDRESS                 COBOL52
         AI,R7    1                 ADD 1 FOR SIZE OF N BYTE            COBOL52
         STW,R7   ENTAD             SAVE AS NEW ENTRY ADDR
         B        XSY2
* INSERT N,SYMBOL INTO XRFTAB
XSY3     RES      0
         AI,R7    4                 DESTIN. ADDR IN TABLE
         STB,R9   R7                INSERT COUNT OF (N,SYMBOL)
         LW,R6    SAVR2             ADDR OF N,SYMBOL IN POF
         MBS,R6   0                 MOVE N,SYMBOL TO XRFTAB
         STW,R7   *XRFTAB           SAVE ADDR OF NEXT ENTRY
         AI,R7    3                 ROUND TO NEXT WHOLE WORD
         SLS,R7   -2                W.A.
         CI,R7    SYMTABZ           END OF SYMBOL TABLE SPACE
         BL       XSY5
* TABLE OVERFLOWS CORE SPACE
         LI,R1    119               **** DIAGNOSTIC ****
         LW,11    PDBX              LINE COUNT
         STW,11   CARDNO
         BAL,LR   DIAG
         LI,R8    X'4000'           SET ABORT FLAG
         OR,R8    PDBP
         STW,R8   PDBP
         B        END52
* DECLARE NAME AS EXTERN. REF,
* INSERT DECLARATION NO INTO XRFTAB
XSY5     RES      0
         BAL,LR   DECLXR            DECLARE XTRNL REF
         LW,R7    ENTAD             ADDR OF ENTRY IN XRFTAB
*        FOLLOWING CORRECTIONS ENSURE THAT ONLY ONE HALF-WORD           COBOL52
*        IS SET FOR A NEW EXTERNAL NAME  , AND THAT THE OTHER IS ZERO   COBOL52
*        PREVIOUSLY ONE HALF-WORD CONTAINED GARBAGE                     COBOL52
         LW,R8    DECLN,R1           DECLAR NUMBER                      COBOL52
         CI,R1    1                  TEST IF OVERLAY                    COBOL52
         BE       %+2                YES, D1=0, D2=DEC                  COBOL52
         SLS,R8   16                 NO, D1=DEC, D2=0                   COBOL52
         LI,R6    4                  MOVE SIZE                          COBOL52
         STB,R6   R7                 DESTINATION                        COBOL52
         LI,R6    32                 SOURCE  BYTE ADDRESS OF R8         COBOL52
         MBS,R6   0                  MOVE IN DECLARATION NUMBERS        COBOL52
         LW,R8    DECLN,R1          RESTORE R8                          COBOL52
         B        *XSYBK            RETURN
XSY4     RES      0
         LW,R4    ENTAD             ENTRY ADDR
         AW,R4    OFFST,R1          + 0 OR 2 FOR DECLAR NO. ADDR
         LB,R15   0,R4              BYTE 1 OF DECL. NO.
         AI,R4    1
         LB,R8    0,R4              BYTE 2 OF DECL NO
         LI,R4    2
         STB,R15  R8,R4             BOTH BYTES IN R8 NOW
         LW,R8    R8
         BNEZ     *XSYBK
* NO DECLARATION NO. IN THIS MODULE (ROOT OR OVERLAY)
         B        XSY5              DECLARE XTRNL REFER
XSYBK    DATA     0
SAVR2    DATA     0
ENTAD    DATA     0
OFFST    DATA     0                 ROOT SEGM OFFSET FOR DECLAR. FLD
         DATA     2                 OVERLAY SEGM OFFSET
         TITLE    '*** EXTDEF SUBROUTINE ***'
         PAGE
*
* EXTDEF EXTERNAL DEFINITION ROUTINE
*        R8 = EXTERNAL NAME DECLARATION NO.
*        R9 = OFFSET (BYTES) FROM ST. CONTR. SECTION BASE
*
EXTDEF   RES      0
         STW,LR   EXTND
         SLS,R8   8
         LW,R13   DECLN,R1          LARGEST DECL NO IN MODULE
         CI,R13   255
         BG       ENT               2 BYTE FIELD REQ.
         OR,R8    =X'000A0001'      ADD CONTROL BYTES
         LW,R13   =X'20000200'      END CONTROL BYTES
         LI,R2    BA(EXOUT)+1
         LI,R3    10                OUTPUT ITEM LENGTH
         B        ENT2
ENT      OR,R8    =X'0A000001'
         LW,R13   =X'20000002'
         LI,R2    BA(EXOUT)         ITEM START ADDR
         LI,R3    12                ITEM SIZE
ENT2     STW,R8   EXOUT
         STW,R9   EXOUT+1
         STW,R13  EXOUT+2
         BAL,LR   OBFOUT            OUTPUT ITEM
         B        *EXTND
EXTND    DATA     0
EXOUT    RES      3
         TITLE    '*** DATREF SUBROUTINE ***'
         PAGE
*
*DATREF DATA REFERENCE POF ITEM PROCESSING
*        R2 IN = BYTE ADDR-1 OF ITEM
*        R2 OUT = DITTO
*        R3 = SIZE OF OUTPUT ITEM
*        R4 = 1/2 W. ADDR OF ADDR FIELD OF POF ITEM
*        R5 = ADDR VALUE (BYTES, 1/2 W., WORD, D.W. RESOLUTION)
*
DATREF   RES      0
         STW,LR   DATND
         STW,R2   BEGITM            SAVE CONTR BYTE ADDR
         LI,R6    0
         STW,R6   SS3
         AI,R2    4                 GET ADDR OF RESOL. CODE
         LB,R9    0,R2              RESOLUTION CODE (0,1,2,3)
         SW,R6    R9                SET TO 0,-1,-2,-3
         AND,R6   =X'7F'
         LI,R4    3
         STB,R6   DAT5,R4           STORE SHIFT COUNT
         SLS,R9   8                 RESOL. BITS TO 3RD BYTE
         AI,R2    2                 ADDR OF DISPL FIELD
         STW,R2   SS
         LI,R5    0
         LW,R6    R2                SOURCE ADDR    (DISPL. FIELD)
         LW,R7    =X'03000015'       COUNT,BA R5+1
         MBS,R6   0                 GET  DISPL. VALUE  IN R9
         AI,R2    -1                GET ADDR OF BASE NO.
         LB,R7    0,R2              GET BASE NO.
         CB,R7    =X'09000000'      COMPARE BASE NO WITH 9
         BE       DAT10             =9, COMMON DATA REF
         CI,R7    10
         BE       DAT15             BASE NO. = 10 (LABEL, TALLY AREA)
         BG       DAT20             GR,RECORD,INDEX OR DCB AREA
         LW,R8    NEWADR,R7
         AW,R5    R8
         CI,R7    8
         BE       DAT12             LITERAL REF.
* SET UP CONTROL BYTES (2 OR 3 BYTES)
         LW,R8    RTDCL             ROOT SEGM NAME DECLAR. NO.
DAT      LW,R7    DECLN,R1          MOST RECENT DECL. NO
         LW,R6    SVR6
         CI,R6    X'29'
         BNE       DAT0                                                 COBOL52
         LW,R6    SVR4
         CI,R6    8
         BG       DAT0                                                  COBOL52
         BL       DAT00                                                 COBOL52
         LI,R2     BA(OVRLBLN)      PICK UP DECL NO FOR                 COBOL52
         AW,R2     SEGN             CURRENT SEGMENT                     COBOL52
         LB,R8     0,R2                                                 COBOL52
         B        DAT0                                                  COBOL52
DAT00    LI,R8    0                                                     COBOL52
DAT0     RES       0                                                    COBOL52
         LW,R2    BEGITM
         CI,R7    256
         BL       DAT1
         OR,R8    =X'00500000'
         SLS,R9   8
         OR,R8    R9                ADD RESOLUTION BITS
         LI,R3    7                 ITEM SIZE
         BAL,LR   ST3CB             STORE 3 CONTR. BYTES
         B        DAT2
DAT1     OR,R8    =X'00005800'
         OR,R8    R9                ADD RESOLUTION BITS
         LI,R3    6                 ITEM SIZE
         BAL,LR   ST2CB
DAT2     RES      0
DAT5     SLS,R5   0                 ADDR VALUE (BYTE,1/2W,W,DW)
         LW,R4    SS
         AI,R4    -3
         SLS,R4   -1                1/2 WORD ADDR
         LW,R2    BEGITM            SET R2 TO BEGIN ADDR OF INSTR ITEM
         B        *DATND
DAT10    RES      0                 COMMON DATA REFERENCE
         LI,R8    1                 DECLAR. NO. OF COMMON
         B        DAT
DAT12    RES      0                 LITERAL REF.
         LI,R8    0                 DECL. NO OF ST. CONTR SECTN
         B        DAT               OF CURRENT MODULE
DAT15    LW,R8    LABDCL            LABEL AREA NAME DECL. NO.
         B        DAT
DAT20    CB,R7    =X'3D000000'      COMPARE BASE NO. WITH 61
         BL       DAT22             FILE REC. AREA (11-60)
         CB,R7    =X'6F000000'      WITH 111
         BL       DAT21             FILE INDEX AREA (61-110)
         AI,R7    -110              DCB AREA (111-160)
         LI,R15   3
         B        DAT23
DAT21    AI,R7    -60
         LI,R15   2
         B        DAT23
DAT22    AI,R7    -10               R7=DDB NO. (1-50)
         LI,R15   1
DAT23    STW,R7   R2                SAVE FILE NO.
         SLS,R7   2                 BYTE DISPL.
         AW,R7    R15               TO ENTRY IN DECLLTB
         CI,R1    0                 TEST FOR ROOT OR OVERLAY
         BE       DAT50             ROOT SEGMENT
* OVERLAY SEGMENT PROCESSING
         LH,R14   *PDBZ+4,R2        RELATIVE ADDR OF DDB
         AW,R14   PDBZ+3            DDB AREA ADDR
         SLS,R14  -2                R14= W.A. OF DESCR. BLOCK
         LB,R6    *R14              GET DB A FIELD
         CI,R6    5                 TEST FOR RDB
         BE       REPORT            REPORT DESCR. BLOCK
         CI,R15   1                 TEST IF REC. AREA
         BG       DAT32             NOT REC., NO 'SAME' PROCESSING
         AND,R6   =X'80'            TEST 1ST BIT IN DDB A FIELD
         BEZ      DAT32             =0, NOT IN SAME CHAIN
* GET 'SAME' DDB NO. FROM DDB W FIELD
         LI,R6    6                 BYTE ADDR OF W FIELD IN DDB
         LB,R4    *R14,R6           DDB NO. OF 'SAME' FILE
         AND,R4   =X'FC'
         LW,R7    R4
         BAL,LR    DAT35          SEE IF R14 HAS TO BE CHANGED          COBOL52
DAT31    AW,R7    R15               GET BYTE ADDR OF DECLAR. NO.
DAT32    LB,R8    DECLTB2,R7        IN DECL. TABLE (FOR OVERLAYS)
         BNEZ     DAT               NAME HAS BEEN DECLARED
* DECLARE FILE RECORD, INDEX OR DCB AREA NAME AS EXTERNAL
         CI,R15   2
         BG       DAT38             3,DCB AREA 'F:NAME'
         BL       DAT36             1,RECORD AREA 'NAME'
         LI,R8    C'I'              2, INDEX AREA 'I:NAME'
         B        DAT40
*        THIS ROUTINE IS USED TO SET R14 TO THE DDB ADDR OF THE         COBOL52
*        FIRST FILE IN THE SAME AREA CHAIN---THIS IS NECESSARY IN       COBOL52
*        SEGMENTED PROGRAMS       SIDR 5347                             COBOL52
DAT35    RES       0                                                    COBOL52
         CI,R15    1              1=RECORD AREA 'NAME'                  COBOL52
         BNE       *LR            DO NOT CHANGE R14                     COBOL52
         SLS,R4   -2                DDB NO OF FIRST DDB IN CHAIN        COBOL52
         LH,R14    *PDBZ+4,R4     RELATIVE ADDR OF DDB                  COBOL52
         AW,R14    PDBZ+3         DDB AREA ADDR                         COBOL52
         SLS,R14  -2                W.A. OF DDB                         COBOL52
         B         *LR            RETURN                                COBOL52
DAT36    LI,R6    41                ADDR OF N,NAME IN DDB
         B        DAT42
DAT38    LI,R8    C'F'
DAT40    LI,R6    41                ADDR OF FILE NAME LENGTH FIELD
            LB,R10   *R14,R6           N
         STW,R10  SS3               SAVE OLD SIZE OF NAME
         AI,R10   2                 ADD 2 FOR F: OR I: CHAR.
         LI,R6    40
         STB,R8   *R14,R6           STORE F OR I CHARACTER
         LI,R6    41
         LI,R8    C':'
         STB,R8   *R14,R6           STORE :
         LI,R6    39
         STB,R10  *R14,R6           STORE NEW N
DAT42    SLS,R14  2                 BYTE ADDR OF DDB
         AW,R14   R6                OFFSET TO N,NAME FIELD IN DDB
         LW,R2    R14
         STW,R5   SS1               SAVE ADDR VALUE
         STW,R7   SS4               SAVE INDEX TO DECLTB2 ENTRY
         STW,R9   SS2               SAVE RESOLUTION CODE
         BAL,LR   DECLXR            DECLARE EXT. REF.
         LW,R5    SS3               PREV. SIZE OF FILE NAME
         BEZ      DAT44             NOT CHANGED
         AI,R14   2                 B.A. OF OLD N POSITION
         STW,R14  R2
         STB,R5   0,R2
DAT44    LW,R5    SS1
         LW,R7    SS4
         LW,R9    SS2
         LW,R8    DECLNN            DECLAR. NO. IN OVERLAY SEGM
         STB,R8   DECLTB2,R7        TO SEGM DECLAR. TABLE
         B        DAT
DAT50    RES      0
         LB,R8    DECLTB,R7         GET DECLARATION NO. OF DATA AREA
         B        DAT
DATND    DATA     0
BEGITM   DATA     0                 BEGIN ADDR OF INSTR ITEM
SS       DATA     0
SS1      DATA     0
SS2      DATA     0
SS3      DATA     0
SS4      DATA     0
SVR4     RES      1                 SAVE BASE NUMBER OF REFERENCE
SVR6     RES       1                                                    COBOL52
DECLTB2  RES      51                OVERLAY SEGM FILE DECL. TABLE
*
* REPORT FILE PROCESSING IN OVERLAY SEGMENT
*
REPORT   RES      0
         LB,R8    DECLTB2,R7
         BNEZ     DAT               NAME HAS BEEN DECLARED
* DECLARE REPORT-NAME, R: REPORT-NAME AS XTRNL. REF.
         LI,R6    13
         CI,R15   1
         BE       DAT42             REPORT-NAME
         LI,R8    C'R'
         LB,R10   *R14,R6           N
         STW,R10  SS3
         AI,R10   2                 +2 FOR R: CHARACTERS
         LI,R6    12
         STB,R8   *R14,R6           R
         LI,R6    13
         LI,R8    C':'
         STB,R8   *R14,R6           :
         LI,R6    11
         STB,R10  *R14,R6           NEW N
         B        DAT42
         TITLE    '*** STNCB SUBROUTINE ***'
         PAGE
*
*STNCB, STORE N CONTROL BYTES N = 2 OR 3
*        R8 = CONTROL BYTES
ST3CB    RES      0                 STORE 3 BYTES
         LW,R4    R2
         STB,R8   0,R4              1 BYTE OF DECLR. NO
         SLS,R8   -8
         AI,R4    -1
STN      STB,R8   0,R4              DECL. NO BYTE
         SLS,R8   -8
         AI,R4    -1
         STB,R8   0,R4              CONTROL BYTE
         STW,R4   BEGITM            SAVE BEGIN ADDR OF ITEM
         B        *LR
ST2CB    LW,R4    R2                STORE 2 BYTES
         B        STN
         TITLE    '*** ENDMOD SUBROUTINE ***'
         PAGE
*
* ENDMOD END OF MODULE PROCESSING
*
ENDMOD   RES      0
         STW,LR   ENLR
*
* DECLARE STANDARD CONTROL SECTION
*
         LW,R9    SECSZ,R1          STAND. CONTR. SECTION SIZE
         AND,R9   =X'0FFFFF'
         OR,R9    COACC             CONTR BYTE, ACCESS CODE BITS        COBOL52
         STW,R9   ENOT
         LI,R2    BA(ENOT)
         LI,R3    4                 ITEM SIZE
         BAL,LR   OBFOUT
*
* DECLARE END OF MODULE
*
         LW,R9    SL                GET COMPILATION ERROR SEVERITY LEVEL
         OR,R9    =X'0E00'           END MODULE CONTROL BYTE
         STW,R9   ENOT
         LI,R2    BA(ENOT)+2
         LI,R3    2                 ITEM SIZE
         BAL,LR   OBFOUT
*  EMPTY BUFFER TO OBJECT FILE
         BAL,LR   ENDOUT
         B        *ENLR
ENLR     DATA     0
ENOT     DATA     0
COACC    DATA     X'0B000000'       0B = CONTROL, 00 = ACCESS CODE
*        DATA    X'0B400000' IS  USED FOR ACCES CODE =1                 COBOL52
         END
