         SYSTEM   SIG7FDP
         TITLE    'PHASE 3.0'
*
* PHASE 3.0 REFERENCES
*
         REF      COBIODB
         REF      COBIOOOF,COBIOOIF
         REF      COBIOCOF,COBIOCIF
         REF      RDDDD
         REF      PDBA,PDBCC,PDBP
         REF      PDBZ
         REF      COB31
         REF      COB32
         REF      COB33
         REF      COB34
         REF      PH3E
         REF      PH5E
         REF      DIAG
         REF      M:OC
         REF      TYPE
         REF      PDBDBG                                                COBOL30
*        REF      COB35             REMOVE * WHEN COBOL35 TURNED ON     COBOL30
         DEF      PH35E                                                 COBOL30
*        REFS TO DLAREAS IN COBOL31,32 REMOVED - SIDR 1954
*
* PHASE 3.0 DEFINITIONS
*
         DEF      COB30,PH31E,PH32E,PH33E,PH34E
         DEF      LSN
         DEF      HSN
         DEF      SITAD
         DEF      USEPOINT,CORRESP
         DEF      LINENTRY,XRFBUILD,CSFLINE,LINENOS
         DEF      SAVERG5,XNAME
         DEF      CHAINLK,GETIX,DICTATE
         REF      COB35
         DEF      NXTSTRNG                                              COBOL35
         DEF      TBLSIZE                                               COBOL30
         DEF      PDBZ:OLD
         DEF      USEND                                                 COBOL30
         PAGE
*
* REGISTER 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
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
* ENTRY TO PHASE 3.0
*
COB30    RES      0
         LI,R4    MESS30
         BAL,R11  TYPE
         CAL1,8   PLIST2            M:SEGLD PHASE 3.1
         LI,R2    BA(EPFBUF)
         LCW,R2   R2
         LI,R3    BA(EPFBUFS)
         LI,R4    -1
         LI,R5    0
         BAL,R11  COBIOOIF          OPEN EPF TO INPUT(CLUSTERED,REV,NS)
         LI,R2    0
         LI,R4    -1
         LW,R5    L(X'80000003')    DDD
         BAL,R11  COBIOOIF          OPEN DDD TO INPUT (NONCLUSTERED,REV)
         LI,R2    BA(CRFBUF)
         LI,R5    2
         BAL,R11  COBIOOOF          OPEN CRF TO OUTPUT (CLUSTERED)
         LI,R2    3
         LI,R3    2
         LW,R4    L(C'CRF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R3    4
         LI,R2    BA(LS)
         BAL,R11  RDDDD             INPUT FROM DDD
         BLZ      %+1               EOF-YES GOTO
         LW,R5    PDBZ               REPLACES LI,R5 DLAREA1 (SEE 3.1)
*                                    ABOVE IS TO USE ALL MEMORY
         STW,R5   DLAREAAD
* RESERVE SPACE FOR SEGMENT INDEX TABLE
*    INIT TO ALL BITS
         LW,R5    LS
         SLS,R5   -14
         AI,R5    1
         MI,R5    3                 COMPUTE &83E 35578  662 9
         LW,R1    PDBZ+2
         SW,R1    R5
         STW,R1   SITAD             SET SIT BYTEADDRESS
*                 SIDR 1954,1831,1540
*                 ILLEGAL TRAPS IN LARGE PROGRAMS
*                 INCORRECT DIAGNOSTICS BASED ON DICTIONARY SEARCH
         LI,R2    X'FF'
         STB,R2   0,R1              SE7 SIT TO ALL ONES
         AI,R1    1
         CW,R1    PDBZ+2            BA(DINDEY)
         BL       %-3
*        ABOVE CLEARS SIT TABLES OF ANY SIZE
* COMPUTE SIZE OF DLAREA PUT INTO V
         LW,R5    SITAD              BYTE ADDRESS OF SIT
         SLS,R5   -2                 WORD ADDRESS OF SIT
         AI,R5    -1                 TOP ADDRESS OF DICTIONARY AREA
         SW,R5    DLAREAAD           OBTAIN SIZE OF DICTIONARY
*                                    ABOVE IS TO USE ALL MEMORY
         STW,R5   V                 SET V TO LENGTH OF DLAREA
         LI,R5    X'3FFF'
         AND,R5   LS
         CW,R5    V
         BLE      COB301            SET TO RELEASE
         LI,R2    -1
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE EPF
         B        COB30E1
COB301   RES      0
         LW,15    ECB
         BLZ      %-1
         BAL,R11  DSTAK
         LI,R2    X'0B'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         LI,R4    MESS31
         BAL,R11  TYPE
         B        COB31
         PAGE
*
* RETURN FROM PHASE 3.1
*
PH31E    RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE EPF
         LW,R5    PDBP
         CI,R5    X'4000'
         BANZ     COB30E2           ABORT FLAG
         LW,R2    LSN
         BEZ      COB3042
         BAL,R11  RTRT
         CAL1,8   PLIST3            M:SEGLD PHASE 3.2
         LI,R2    0                 SET TO SAVE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE CRF
         LI,R2    1
         STB,R2   PDBCC,R2          INIT PASS COUNTER
*        CODE TO SET DLAREAAD REMOVED  - SIDR 1954
COB3031  RES      0
         LI,R5    X'3FFF'
         AND,R5   LS
         CW,R5    V
         BG       COB30E1
         LI,R2    BA(CRFSBUF)
         LI,R5    1
         BAL,R11  COBIOOOF          OPEN CRFSTO OUTPUT (CLUSTERED)
         LI,R2    3
         LI,R3    1
         LW,R4    L(C'CRFS')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(CRFBUF)
         LI,R4    1
         LI,R5    2
         BAL,R11  COBIOOIF          OPEN CRF TO INPUT (CLUSTERED)
         LW,15    ECB
         BLZ      %-1
         BAL,R11  DSTAK
         LI,R2    X'0C'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         LI,R4    MESS32
         BAL,R11  TYPE
         B        COB32
         PAGE
*
* RETURN FROM PHASE 3.2
*
PH32E    RES      0
         LW,R5    PDBP
         CI,R5    X'4000'
         BANZ     COB30E2           ABORT FLAG
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCIF          CLOSE CRF
         LI,R2    0                 SET TO SAVE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE CRFS
         LW,R5    PDBA+1
         XW,R5    PDBA+2            SWAP CRFS/CRF BCB'S
         STW,R5   PDBA+1
         LW,R2    LSN
         BEZ      COB3042A          SEE IF DEBUG                        COBOL30
         MTH,1    PDBCC
         BAL,R11  RTRT
         B        COB3031
COB3042  RES      0
         LI,R2    0                 SET TO SAVE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE CRF
COB3042A RES      0                                                     COBOL30
         MTW,0    PDBDBG            DEBUGGING REQUESTED                 COBOL30
         BEZ      COB3043           NO.                                 COBOL30
         LW,R2    PDBZ                                                  COBOL30
         STW,R2   PDBZ:OLD          SAVE ORIGINAL PDBZ POINTER          COBOL30
         LI,R2    BA(CRFBUF)        YES.                                COBOL30
         LI,R4    -1                                                    COBOL30
         LI,R5    2                                                     COBOL30
         BAL,R11  COBIOOIF          OPEN CRF                            COBOL30
         LI,R2    BA(CRFSBUF)                                           COBOL30
         LI,R5    1                                                     COBOL30
         BAL,R11  COBIOOOF          OPEN CRFS                           COBOL30
         LW,R4    ='CRFS'                                               COBOL30
         LI,R2    3
         LI,R3    1
         BAL,R11  COBIODB           SET PRINT CONTROL                   COBOL30
         CAL1,8   PLIST6            M:SEGLD COBOL35                     COBOL30
         LI,R2    X'19'                                                 COBOL30
         STB,R2   PDBCC                                                 COBOL30
         LI,R4    MESS35                                                COBOL30
         BAL,R11  TYPE                                                  COBOL30
         B        COB35                                                 COBOL30
PH35E    RES      0                                                     COBOL30
         LI,R2    -1                RELEASE                             COBOL30
         LI,R5    2                  CRF                                COBOL30
         BAL,R11  COBIOCIF                                              COBOL30
         LI,R2    0                 SAVE                                COBOL30
         LI,R5    1                  CRFS                               COBOL30
         BAL,R11  COBIOCOF                                              COBOL30
         LW,R5    PDBA+1            EXCHANGE                            COBOL30
         XW,R5    PDBA+2             CRFS AND CRF                       COBOL30
         STW,R5   PDBA+1                                                COBOL30
COB3043  RES      0
         LW,R2    CORRESP           ANY CORRESPOUNDING STATEMENTS
         BEZ      COB3051           NO-SKIP PHASE 3.3
         CAL1,8   PLIST4            M:SEGLD PHASE 3.3
         LI,R2    1                 SET TO SAVE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE CSF
         LI,R2    BA(ECFBUF)
         LI,R5    1
         BAL,R11  COBIOOOF          OPEN ECF TO OUTPUT (CLUSTERED)
         LI,R2    4
         LI,R3    1
         LW,R4    L(C'ECF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(CSFBUF)
         LI,R4    -1
         LI,R5    5
         BAL,R11  COBIOOIF          OPEN CSF TO INPUT (CLUSTERED,REV)
         LI,R2    X'0D'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS33
         BAL,R11  TYPE
         B        COB33
         PAGE
*
* RETURN FROM PHASE 3.3
*
PH33E    RES      0
         LW,R5    PDBP
         CI,R5    X'4000'
         BAZ      PH33E1            ABORT FLAG
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE ECF
         B        COB30E2
PH33E1   RES      0
         LI,R2    0                 SET TO SAVE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE ECF
COB3051  RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCIF          CLOSE CSF
         LI,R2    X'2000'           ANY REPORTS
         AND,R2   PDBP
         BEZ      COB3052           NO-SKIP PHASE 3.4
         CAL1,8   PLIST5            M:SEGLD PHASE 3.4
         LI,R2    1                 SET TO SAVE
         LI,R5    3
         BAL,R11  COBIOCIF          CLOSE DDD
         LI,R2    BA(ECFBUF)
         LI,R4    1
         LI,R5    1
         BAL,R11  COBIOOIF          OPEN ECF TO INPUT (CLUSTERED)
         LI,R2    BA(CRFBUF)
         LI,R4    -1
         MTW,0    PDBDBG                                                COBOL30
         BEZ      %+2                                                   COBOL30
         LI,R4    1                                                     COBOL30
         LI,R5    2
         BAL,R11  COBIOOIF          OPEN CRF TO INPUT (CLUSTERED,REV)
         LI,R2    0
         LI,R4    1
         LW,R5    L(X'80000003')    OPEN DDD TO PASS SIZE TO READ ROUT  COBOL30
         BAL,R11  COBIOOIF          OPEN DDD TO INPUT (NON CLUSTERED)
         LI,R2    BA(RPFBUF)
         LI,R5    5
         BAL,R11  COBIOOOF          OPEN RPF TO OUTPUT (CLUSTERED)
         LI,R2    16
         LI,R3    5
         LW,R4    L(C'RPF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(RGFBUF)
         LI,R5    0
         BAL,R11  COBIOOOF          OPEN RGF TO OUTPUT (CLUSTERED)
         LI,R2    6
         LI,R3    0
         LW,R4    L(C'RGF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    X'0E'
         STB,R2   PDBCC             SET SUB-PHASE INDICATOR
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS34
         BAL,R11  TYPE
         B        COB34
         PAGE
*
* RETURN FROM PHASE 3.4
*
PH34E    RES      0
         MTW,0    PDBDBG                                                COBOL30
         BEZ      %+3                                                   COBOL30
         LW,R5    PDBZ:OLD                                              COBOL30
         XW,R5    PDBZ              RESTORE ORIGINAL POINTER            COBOL30
         LW,R5    PDBP
         CI,R5    X'4000'
         BAZ      PH34E1            ABORT FLAG
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE EOF
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE RGF
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCIF          CLOSE RPF
         B        COB30E2
PH34E1   RES      0
         LI,R2    0                 SET TO SAVE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE ECF
         LI,R2    0                 SET TO SAVE
         LI,R5    2
         BAL,R11  COBIOCIF          CLOSE CRF
         LI,R2    0                 SET TO SAVE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE RPF
         LI,R2    0                 SET TO SAVE
         LI,R5    0
         BAL,R11  COBIOCOF          CLOSE RGF
COB3052  LI,R2    -1                SET TO RELEASE
         LI,R5    3
         BAL,R11  COBIOCIF          CLOSE DDD
         B        PH3E              RETURN TO PHASE 0
COB30E1  RES      0
         LI,R5    X'4000'
         OR,R5    PDBP
         STW,R5   PDBP              SET ABORT FLAG
         LI,R1    122
         BAL,11   DIAG              DDD SEGMENT TO LARGE FOR MEMORY
COB30E2  RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    3
         BAL,R11  COBIOCIF          CLOSE DDD
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCIF          CLOSE CRF
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE CRFS
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCIF          CLOSE CSF
         B        PH5E
         PAGE
*
* THIS ROUTINE READS THE DICTIONARY INTO DLAREA
*      EXPECT DLAREA BYTE LENGTH IN V
*
DSTAK    STW,R11  R10
         LW,R4    V                 INIT AVAILABLE SPACE (R4)
         LW,R2    DLAREAAD
         STW,R2   DLAREACA          INIT CURRENT ADDRESS IN DLAREA (R2)
         LW,R5    LS
         STW,R5   HS                INIT HS
DSTAK1   LI,R3    X'3FFF'
         AND,R3   R5                LSL (R3)
         AND,R5   L(X'00FFC000')
         STW,R5   LSN               SET LSN
        CI,R5    0                 LSN=0
         BE       CSFOPN            YES- GOTO OPEN CSF
         CW,R3    R4                DLAREA FULL
         BG       *R10              RETURN
         LW,R2    DLAREACA
         SLS,R3   2                 RDDDD BYTE SIZE
         SLS,R2   2
         BAL,R11  RDDDD             READ DICTIONARY SEGMENT
         SLS,R3   -2
         SLS,R5   -14               LSN(R5)
         LW,R7    R5
         MI,R7    3
         AW,R7    SITAD             SET DESTINATION ADDRESS
         OR,R7    L(X'03000000')    SET LENGTH
         LI,R6    9                 SET SOURCE ADDRESS
         LW,R2    DLAREACA
         MBS,R6   0                 PLACE SIT ENTRY
         AW,R2    R3                INCREMENT CURRENT ADDRESS IN DLAREA
         STW,R2   DLAREACA
         SW,R4    R3                DECREMENT AVAILABLE SPACE
         LI,R3    4
         LI,R2    BA(LS)
         BAL,R11  RDDDD             READ DICTIONARY CONTROL WORD
         LW,R5    LS
         B        DSTAK1
CSFOPN   RES      0
         LI,R2    BA(CSFBUF)
         LI,R5    5
         BAL,R11  COBIOOOF          OPEN CSF TO OUTPUT (CLUSTERED)
         LI,R2    15
         LI,R3    5
         LW,R4    L(C'CSF ')
         BAL,R11  COBIODB           PRINT CONTROL
         B        *R10
         PAGE
*
* THIS ROUTINE UPDATES DINDEX
*
RTRT     RES      0
         STW,R11  R10               SAVE RETURN
         LI,R12   0                 FIRST REFERENCE NUMBER
NXTREF   BAL,R11  GETIX             PICK UP DINDEX ENTRY IN R3
         AI,R12   3                 INCREMENT TO NEXT REFERENCE NO.
         STW,R3   R13               MASK OUT
         AND,R13  SEGMASK               SEGMENT NUMBER
         CW,R13   LSN               IF SEGMENT ALREADY PROCESSED
         BG       REMOVE                REMOVE DINDEX POINTER
         CW,R14   PDBZ+3            HAVE WE PROCESSED ALL ENTRIES
         BGE      *R10              YES- RETURN
         B        NXTREF            NO- PROCESS NEXT
REMOVE   BAL,R11  CHAINLK           PICK UP SYNONYM LINKAGE FIELD
         NOP                        ZERO
         LW,R15   R14               ADDRESS OF DINDEX ENTRY
         AI,R15   -3                    INTO DESTINATION REG.
         LI,R13   3                 COUNT
         STB,R13  R15                   FIELD
         STW,R14  R7                SAVE R14    SIDR 1954,1831,1540
         LI,R14   13                ADDRESS OF BYTE 1 23
         MBS,R14  0                 REPLACE DINDEX ENTRY
         LW,R14   R7                RESTOR R14
         B        NXTREF+2
         PAGE
CHAINLK  STW,R11  RETURN
*                                    SIDR 1954 - TRAP IN CHAINLK
*                                    LOOKING FOR ZERO SEGMENT NUMBER
         LW,R13  R3                  SAVE DINDEX ENTRY
         AND,R3   SEGMASK            OBTAIN SEGMENT NUMBER
         BEZ      *RETURN            NO LINKAGE POSSIBLE
         BAL,R11  DICTATE+2          AVOID DICTATE INITIALIZATION
         SLS,R4   2                 BYTE ADDRESS
         AI,R4    1                 POINT TO SYNONYM LINKAGE
         LI,R3    0
         LW,R5    RBYST             SET UP R5
         MBS,R4   0                 MOVE SYNONYM LINKAGE TO R3
         CI,R3    0                 CHECK IF LINKAGE FILLED
         BEZ      *RETURN            EMPTY- RETURN
         LI,R7    1                 FILLED-
         B        *RETURN,R7         RETURN PLUS 1
*        R12 DELIVERS DISPLACEMENT FROM BASE OF DINDEX
*        GETIX PUTS DINDEX ENTRY INTO R3
GETIX    LW,R14   PDBZ+2            DINDEX ORIGIN
         AW,R14   R12
         LI,R3    0                 CLEAR RESULT REGISTER
         LW,R15   RBYST
         MBS,R14  0
         B        *R11
DICTATE  LW,R13   R3                SAVE DINDEX ENTRY
         AND,R3   SEGMASK          MASK THROUGH SEGMENT NUMBER
         SLS,R3   -14                   TO LOW ORDER
         MI,R3    3                 SEGMENT NO * ENTRY LENGTH
         LW,R4    R3                   INTO SOURCE REGISTER
         LI,R3    0                 CLEAR RESULT REGISTER
         LW,R5    RBYST             COUNT ABD DESTINATION ADDRESS
         AW,R4    SITAD             ADDRESS OF SEGMENT INDEX TABLE
         MBS,R4   0                 MOVE TABLE ENTRY TO R3
         AND,R13  DISPL             ADD DISPLACEMENT
         STW,R3   SAVERG5           SAVE SEG ADDRESS (CORRES)
         AW,R3    R13                  TO ADDRESS OF SEGMENT BASE
         LW,R4    R3                RESULTANT ADDRESS TO R4
         LW,R3    1,R4              LINE NO. AND COPY LINE NO. OF DEF.
         STW,R3   LINENTRY             INTO XRF CLUSTER
         B        *R11              RETURN
         PAGE
*
* FORM VAR RECORD PARAMETERS IN CRF
*
         DEF      RCORDV
BBRCH    DATA     X'00000101'       BRANCH CONTROL - CORRESPONDING
         DATA     X'00000000'       BRANCH CONTROL - X'44' TO X'7F'
         DATA     X'00000000'
         DATA     X'02020202'
         DATA     X'02010000',X'01020100'
         DATA     X'00020001',X'02000201'
         DATA     X'00010202',X'00000001'
         DATA     X'00000100',X'00020000'
         DATA     X'02020000',0,0,0
         BOUND    8
REGSP    RES      2                 SAVE BUFFERS
BDSP1    RES      1                 BASE, DISP FOR NEXT 01
CURLN    RES      1                 CURRENT LEVEL NUMBER
CURBD    RES      1                 CURRENT BASE, DISP
OCCRM    RES      1                 MAX OCCURS NUMBER
OLNTH    RES      1                 LENGTH OF ODO
TDBNN    DATA     0                SAVE TDB NUMBER
QUALDF   DATA     0
PARAM    RES      16                PARAMETER
REGSV    RES      8
LEVLS    RES      1
NXCLS    RES      1                 CLASS OF NEXT ELEM ITEM
NXCLF    RES      1                 GROUP FLAG FOR CLASS
NDISP    RES      1
SVR4     RES      1
RCORDV   LCI      8
         STM,R1   REGSV
         AW,R1    R1                HA CLOC
         LH,R8    3,R1              REF NO.
         STW,R8   PARAM
         SLS,R1   -1
         LI,R4    X'F000'
         AND,R4   3,R1              H OF DDD
         BEZ      PRSL00
         CI,R4    X'5000'
         BL       PRSL01            NOT APPLICABLE
         CI,R4    X'B000'
         BL       PRSL0             NOT REPORT ITEM
PRSL01   LI,R4    0
PRSL00   STH,R4   1,R2              CLEAR VAR FLAG
         B        PRSLE
PRSL0    MTW,-2   REGSV+2
         AI,R3    -2
         LW,R6    3,R1              GET VAR FLAG
         LW,R8    0,R1
         SLS,R1   2
         LB,R5    2,R1              LEVEL NUMBER
         AND,R5   L(X'7F')          GET RID OF REDEFINE FLAG
         CI,R5    66
         BE       PRSL6             RENAMES
         CI,R5    77
         BE       PRSL6             NOT APPLICABLE
         LH,R7    0,R2
         AND,R7   L(X'7F')          CONTROL BYTE
         LB,R4    BBRCH-16,R7
         BEZ      PRSL6
         STW,R4   SVR4              FLAG FOR LENGTH PARAM
         AND,R8   L(X'FFFFFF')
         STW,R8   QUALDF            QUALIFIED FLAG
         LI,R7    0
         CI,R5    1
         BE       PRSL4
         AND,R6   L(X'C')
         STW,R6   LEVLS             INITIALIZE FIRST VAR FLAG
PRSL1    AI,R1    -1                START ADDR PARAM
         LB,R6    0,R1
         SW,R1    R6                TO PRECEDING DDD
         LB,R4    2,R1
         AND,R4   L(X'7F')
         CI,R4    1
         BE       PRSL4
         CI,R4    77
         BE       PRSL6             88 IN 77
         CI,R4    66
         BE       PRSL1             RENAMES
         SLS,R1   -2
         LI,R5    4                 K OF DDD
         AND,R5   3,R1
         BEZ      PRSL2             NOT VAR DATA
         LW,R5    LEVLS
         BNEZ     PRSL3             NOT FIRST VAR DATA
         MTW,1    LEVLS
PRSL2    SLS,R1   2
         B        PRSL1
PRSL3    BAL,R8   SETPAR            FORM PARAM
         LCW,R5   R5
         STW,R5   PARAM,R7          SAVE IN PARAM
         B        PRSL2
PRSL4    MTW,-1   SVR4
         BEZ      PRSL6             NO PARAM FOR LENGTH
         SLS,R1   -2
         LW,R4    5,R1
         AND,R4   L(X'FFFF')
         STW,R4   BDSP1            LENGTH
         LW,R4    4,R1
         AND,R4   L(X'FFFFFF')      GET RID OF BASE
         AWM,R4   BDSP1             SAVE NEXT 0U DISPLACEMENT
         LW,R1    REGSV
         LI,R4    X'F00'
         AND,R4   3,R1
         BNEZ     PRSL6             NOT GROUP
         SLS,R1   2
         LB,R4    2,R1              LEVEL NUMBER
         AND,R4   L(X'7F')
         STW,R4   LEVLS
         SLS,R1   -2
         LI,R5    8                 CHECK K OF DDD
         AND,R5   3,R1
         BEZ      PRSL6             NO FLAG IN K
PRSL5    SLS,R1   2                 TO BA OF DDD
         LB,R5    0,R1
         SLS,R5   2
         AI,R5    -1                TO LAST BYTE
         AW,R1    R5
         LB,R6    0,R1
         BEZ      PRSL6             END OF DDD
         AI,R1    1
         LB,R5    2,R1              LEVEL NO
         AND,R5   L(X'7F')
         CW,R5    LEVLS
         BLE      PRSL6
         SLS,R1   -2
         CI,R5    66
         BE       PRSL5             RENAMES
         LI,R5    4                 K OF DDD
         AND,R5   3,R1
         BEZ      PRSL5
         BAL,R8   SETPAR            FORM PARAM
         STW,R5   PARAM,R7          SAVE IN PARAM
         B        PRSL5
PRSL6    LW,R2    REGSV+1
         MTH,0    PARAM
         BNEZ     PRSL7             VAR REC
         SLS,R2   -1
         MTW,0    PDBDBG
         BEZ      PRSL6A            NO DEBUG
         LW,R6    =X'FFF3FFFF'      FIELDS IN WORD 3 (J,K)
         AND,R6   2,R2
         STW,R6   2,R2
         LI,R4    0
         SLS,R2   1                 H.W.
         AI,R2    2
         STH,R4   0,R2
         B        PRSLE
PRSL6A   RES      0
         LI,R6    X'FFF3'
         AND,R6   1,R2              REMOVE VAR REC FLAG
         STW,R6   1,R2
         B        PRSLE
PRSL7    MTH,4    PARAM
         SLS,R2   1
         LW,R4    R3
         SW,R4    R2                DISP OF PARAM IN CRF
         LH,R6    PARAM
         STB,R6   R3
         AWM,R6   REGSV+2
         LW,R8    PARAM
         MTW,0    QUALDF
         BEZ      %+2
         LCW,R8   R8                QUALIFIED
         STH,R6   R8
         STW,R8   PARAM
         SLS,R2   -2
         MTW,0    PDBDBG
         BEZ      PRSL7A            NO DEBUG
         LW,R6    =X'FFF3FFFF'
         AND,R6   2,R2              3RD WORD (FLDS J,K)
         STW,R6   2,R2
         SLS,R2   1
         AI,R2    2
*        FOLLOWING WILL ADJUST FIELD E BECAUSE COB35 WILL
*        DELETE THE REFERENCE NUMBER (HW)                               COBOL30
         AI,R4    -2                                                    COBOL30
         STH,R4   0,R2
         B        PRSL7B
PRSL7A   RES      0
         LI,R6    X'FFF3'
         AND,R6   1,R2              REMOVE VAR FLAG
         STH,R4   R6
         STW,R6   1,R2
PRSL7B   RES      0
         LI,R2    BA(PARAM)
         MBS,R2   0                 PARAM TO CRF
PRSLE    LCI      8                 RETURN
         LM,R1    REGSV
         B        *R11
SETPAR   STD,R2   REGSP
         LW,R2    R1
         LW,R3    2,R2
         AND,R3   L(X'7F000000')
         STW,R3   CURLN             SAVE LEVEL NUMBER
         LW,R4    4,R2
         AND,R4   L(X'FFFFFF')      GET RID OF BASE
         STW,R4   CURBD             SAVE DISPLACEMENT
         LW,R4    5,R2
         STH,R4   OLNTH
         LB,R4    R4                TDB NUMBER
         STH,R4   TDBNN             SAVE FOR PARAM
         LH,R4    *PDBZ+4,R4
         AW,R4    PDBZ+3            BA(TDB)
         SLS,R4   -2
         LW,R4    1,R4
         AND,R4   L(X'FFFF')
         STW,R4   OCCRM             MAX OCCURS NUMBER
         MH,R4    OLNTH             TOTAL LENGTH
         AWM,R5   CURBD
         SLS,R2   2                 TO BA
         LI,R3    0
         STW,R3   NXCLS
         STW,R3   NXCLF
SETPR1   LB,R3    0,R2              LENGTH OF DDD
         SLS,R3   2
         AW,R2    R3
         AI,R2    -1
         LB,R3    0,R2              BYTE LENGTH
         BNEZ     SETPR0
         MTW,0    NXCLS
         BNEZ     SETPR5            NOT LAST ENTRY
         LW,R4    BDSP1
         B        SETPR6
SETPR0   AI,R2    1
         SLS,R2   -2
         LW,R3    3,R2
         SLS,R2   2
         AND,R3   L(X'C000')
         CI,R3    X'C000'
         BE       SETPR1            COMPILER GENERATED ITEM
         LB,R3    2,R2              NEXT LEVEL NUMBER
         AND,R3   L(X'7F')
         CB,R3    CURLN
         BLE      SETPR3
         MTW,0    NXCLS
         BEZ      SETPR1
         SLS,R2   -2                TO WA
         LW,R4    3,R2
         SLS,R2   2
         AND,R4   L(X'F00')         GET CLASS
         BEZ      SETPR1
         CI,R4    X'C00'
         BL       SETPR1            BYTE
         LI,R5    2
         CI,R4    X'F00'
         BNE      SETPR2            WORD
         AI,R5    1
SETPR2   CW,R5    NXCLF
         BLE      SETPR1
         STW,R5   NXCLF             UPDATE BOUNDARY FLAG
         B        SETPR1
SETPR3   MTW,0    NXCLS
         BNEZ     SETPR5            END OF NEXT GROUP
         MTW,1    NXCLS
         SLS,R2   -2
         LW,R5    4,R2
         AND,R5   L(X'FFFFFF')      GET RID OF BASE
         STW,R5   NDISP             SAVE DISPLACEMENT
         LI,R4    X'F00'
         AND,R4   3,R2              GET CLASS
         BNEZ     SETPR4
         SLS,R2   2                 TO BA
         LB,R4    2,R2
         AND,R4   L(X'7F')
         STB,R4   CURLN
         B        SETPR1
SETPR4   CI,R4    X'C00'
         BL       SETPR5            BYTE ALLIGNMENT
         MTW,2    NXCLF             WA ALLIGNMENT
         CI,R4    X'F00'
         BNE      SETPR5
         MTW,1    NXCLF             DA ALLIGNMENT
SETPR5   LW,R4    NDISP
SETPR6   LH,R5    OLNTH
         OR,R5    TDBNN             TDB NUMBER
         SW,R4    CURBD             SLACK COUNT
         BGEZ     %+2
         LI,R4    0
         SLS,R4   24
         OR,R5    R4                SLACK COUNT
         LW,R4    NXCLF
         SLS,R4   28
         OR,R5    R4                ALLIGNMENT
         AI,R7    1
         MTH,4    PARAM
         LD,R2    REGSP
         B        *R8
         PAGE
*
* PHASE 3.0 CONSTANTS
*
LS       DATA     0                 SEGMENT NO. AND LENGTH-NEXT
         DATA     X'FFFFFFFF'
HS       DATA     0                 SEGMENT NO. AND LENGTH-HIGHEST
LSN      DATA     0                 SEGMENT NO. FROM COB30 LS
HSN      EQU      HS                SEGMENT NO. FROM COB30HS
V        DATA     0                 CURRENT AVAILABLE BUFF SPACE
DLAREAAD DATA     0                 WORD ADDRESS OF DEAREA
DLAREACA DATA     1                 CURRENT BYTE ADDRESS IN DLAREA
SITAD    DATA     0                 BYTE ADDRESS OF SIT
NXTSTRNG DATA     BA(STRNGTBL)      DEBUG STRING TABLE POINTER          COBOL35
STRNGTBL RES      400               DEBUG STRING TABLE                  COBOL35
TBLSIZE  DATA     0                                                     COBOL30
PDBZ:OLD DATA     0                                                     COBOL30
USEPOINT DATA     USETABLE          USE    TABLE POINTER
USEND    EQU      USEPOINT+63        POINTER LIMIT                      COBOL30
USETABLE RES      64                USE TABLE                           COBOL30
CORRESP  DATA     0                 CORRESPOUNDING STATEMENT FLAG
SEGMASK  DATA     X'00FFC000'
RBYST    DATA     X'0300000D'
DISPL    DATA     X'00003FFF'
RETURN   DATA     0                 CHAINLK LINK REGISTER SAVE
SAVERG5  DATA     0                 SEG ADDRESS(CORRES) SAVE
XRFBUILD DATA,2   0
         DATA,2   0
CSFLINE  DATA,2   0
LINENTRY DATA,2   0
LINENOS  DATA,2   0
         DATA,2   0
XNAME    DATA,2   0
         RES,2    16
         BOUND    4
         PAGE
*
* PHASE 3.0 PLISTS
*
MESS30   TEXTC    'COBOL30  
'
MESS31   TEXTC    'COBOL31  
'
MESS32   TEXTC    'COBOL32  
'
MESS33   TEXTC    'COBOL33  
'
MESS34   TEXTC    'COBOL34  
'
MESS35   TEXTC    'COBOL35  
'
PLIST2   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH31
PLIST3   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH32
PLIST4   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH33
PLIST5   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH34
PLIST6   GEN,8,24 1,0                                                   COBOL30
         DATA     PH35                                                  COBOL30
PH35     TEXTC    'COBOL35'                                             COBOL30
PH31     TEXTC    'COBOL31'
PH32     TEXTC    'COBOL32'
PH33     TEXTC    'COBOL33'
PH34     TEXTC    'COBOL34'
ECB      DATA     0
*
* PHASE 3 I/O BUFFERS
*
         BOUND    4
         DATA,2   C'XX'             HW FILL
EPFBUF   RES      75
         BOUND    4
         DATA,2   C'XX'             HW FILL
EPFBUFS  RES      105
         BOUND    4
CRFBUF   RES      75
CRFSBUF  RES      75
ECFBUF   EQU      CRFSBUF
CSFBUF   EQU      RPFBUF
RGFBUF   EQU      EPFBUF
RPFBUF   RES      75
         END
