         SYSTEM   SIG7FDP
         TITLE    'PHASE 3.2'
         DEF      COB32
*        DEF      DLAREA3,DLAREA4 REMOVED SIDR 1954
R1       EQU      1
R2       EQU      2
R3       EQU      3
RTYP     EQU      3
R4       EQU      4
R5       EQU      5
UP3      EQU      5
R6       EQU      6
UP2      EQU      6
R7       EQU      7
UP1      EQU      7
R8       EQU      8
CBYT     EQU      8
R9       EQU      9
OTYP     EQU      9
R10      EQU      10
STOP     EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         REF      CARDNO
         REF      DIAG
         REF      LSN
         REF      SITAD
         REF      PDB
         REF      PDBCC
         REF      USEND                                                 COBOL32
         REF      PDBZ
         REF      HSN
         REF      USEPOINT
         REF      CORRESP
         REF      WRCSF
         REF      WRXRF
         REF      RDCRF
         REF     PDBO
         REF      PH32E
         REF      WRCRFS
         REF      CHAINLK
         REF      GETIX
         REF      DICTATE
         REF      SAVERG5
         REF      XRFBUILD
         REF      CSFLINE
         REF      LINENTRY
         REF      LINENOS
         REF      RCORDV
         REF      PDBDBG                                                COBOL32
         PAGE
COB32    EQU      START
START    LI,R7    1                 INITIALIZE
         LW,R13   LSN               IS THIS THE LAST PASS
         BNEZ     %+3               NO
         LI,R13   WA(WRCSF)         CHANGE ADDRESS OF CORRESPONDING
         STW,R13  CFILEOUT              FILE TO CSF
CLIP     BAL,R11  RDCRF             GET CLUSTER FROM CRF
         BLZ      PH32E             END OF FILE
         LW,R1    R2                PICK UP
         AI,R1    1                     CONTROL
         LB,CBYT  0,R1                  BYTE
         BNEZ     VISIBLE           NOT A LINE NUMBER CLUSTER
         LI,R3    BA(LINENTRY)      DESTINATION ADDRESS
         LI,R13   6                 PUT BYTE COUNT
         STB,R13  R3                   OF 6 INTO R3
         LW,R4    R2                SET OUTPUT REGISTER
         MBS,R2   0                 MOVE CLUSTER
         LH,R13   LINENOS,UP1       COPY LINE NUMBER
         BEZ      NOCOPY            ZERO
         MTW,-1   LINENOS           DECREMENT COPY LINE NUMBER
PDBLINE  LW,R13   LINENOS           LINE NUMBER AND COPY LINE NUMBER
         STW,R13  CARDNO            STORE IN PDB
COMX     BAL,R11  WRCRFS            OUTPUT TO CRFS
         B        CLIP              GET NEXT CLUSTER
NOCOPY   MTH,-1   LINENOS           DECREMENT LINE NUMBER
         B        PDBLINE           STORE IN PDB
*        PASS ALONG ALL CLUSTERS EXCEPT:
*        CORRESPONDING ITEMS ALREADY PROCESSED GO TO LOGICAL CSF
*             CONTROL BYTE 40 OR 41
*             SYNTAX ONLY WITH CONTROL BYTE OF 74,75,76 OR 77
*        UNRESOLVED NAME REFERENCES- OPERAND TYPE 8 TO GETDEF
*        SECTION TRAILERS----SAVE REFERENCE NUMBER FOR USE BY GETDEF
VISIBLE  AND,CBYT L(X'7F')          TURN OFF FIRST CLUSTER BIT IN R8
         LW,R4    R2                SET OUTPUT REGISTER
         LW,R14   CBYT              SAVE CONTROL BYTE
*  THE FOLLOWING THREE INSTRUCTIONS CHECK FOR A SPECIAL PERFORM         COBOL32
*   CLUSTER  SINCE IT WOULD APPEAR TO BE A CORRESPONDING CLUSTER        COBOL32
*     IF ALLOWED TO FOLLOW THE NORMAL FLOW.                             COBOL32
         LI,R11   X'C1'                                                 COBOL32
         CB,R11   0,R1                                                  COBOL32
         BE       NONCOR                                                COBOL32
         CI,CBYT  9                 CORRESPONDING LINE NUMBER
         BE       CORSP             YES- PUT ON APPROPRIATE FILE
        CI,CBYT  X'40'             IF NOT A
         BL       NONCOR                CSF
         CI,CBYT  X'43'                CLUSTER
         BG       NONCOR                CONTINUE
CORSP    BAL,R11  *CFILEOUT         PUT OUT ON LOGICAL CSF
         B        CLIP              GET NEXT CLUSTER
NONCOR   AI,R1    1                 ACCESS
         LB,OTYP  0,R1                  OPERAND OPTIONS
         CI,OTYP  X'9A'             IS IT A SECTIOM TRAILER
         BE       TRAILER           PICK UP REFERENCE NUMBER
        LI,RTYP  X'F'              REFERENCE TYPE
         AND,RTYP OTYP                  INTO R10
         SLS,OTYP -4                SHIFT OPERAND TYPE TO LOW ORDER     OP
         CI,OTYP  0                 IS IT A SYNTAX ONLY
         BNE      NOTRES            NO-CKECK IF UNRESOLVED REFERENCE
         EOR,R14  L(X'77')          IF THE CONTROL BYTE
         CI,R14   3                     IS 74-77
*   THE FOLLOWING INSTRUCTIONS CHECK TO SEE IF THE SYNTAX ONLY          COBOL32
*    CLUSTER IS A ROUNDED OPTION, IF SO IT DOES NOT GO ON THE           COBOL32
*   CSF AS OTHER SYNTAX ONLY CLUSTERS OF THIS TYPE.                     COBOL32
         BG       NOTRES                                                COBOL32
         AI,R1    1                                                     COBOL32
         LB,STOP  0,R1                                                  COBOL32
         AI,R1    -1                                                    COBOL32
         CI,STOP  4                                                     COBOL32
         BNE      CORSP                                                 COBOL32
NOTRES   CI,OTYP  8                 UNRESOLVED
         BNE      COMX              NO- OUTPUT ON CRF
         AI,R1    1                 PICK UP
         LB,STOP  0,R1                  STATEMENT OPTIONS
         AND,STOP R7
*   THE FOLLOWING SIX LINES OF CODE PICK UP THE INTERNAL LABEL          COBOL32
*    COUNT FOR UNSATISFIED PROCEDURE DEFINITIONS.                       COBOL32
         CI,RTYP  9                 IS IT A PARAGRAPH DEF               COBOL32
         BNE      NOT%PARD          NO                                  COBOL32
         LW,R1    R2                                                    COBOL32
         SLS,R1   -1                HW ADDRESS OF CLUSTER               COBOL32
         LH,R11   2,R1              GET INTERNAL LABEL COUNT            COBOL32
         STH,R11  INLBR             STORE IT                            COBOL32
         B        NOTRES1                                               COBOL32
NOT%PARD RES      0                                                     COBOL32
         CI,RTYP  0                                                     COBOL32
         BNE      NOTRES1           NOT IDENTIFIER                      COBOL32
         LW,R1    R2                CLUSTER BYTE ADDR                   COBOL32
         LB,R1    1,R1              SUBSCRIPT COUNT                     COBOL32
         STW,R1   SUBS              SAVE SUBSCRIPT COUNT                COBOL32
NOTRES1  RES      0                                                     COBOL32
         BAL,R11  GETDEF            ATTEMPT TO RESOLVE
         LW,R4    R2                LOAD OUTPUT REGISTER
         B        COMX              OUTPUT TO CRF
TRAILER  AI,R1    1                 PICK UP
         SLS,R1   -1                HA OF REFERENCE NUMBER
         LH,R13   0,R1              REFERENCE NUMBER
         STH,R13  NUMBERS,UP1           INTO SECNO
         B        COMX              OUTPUT CLUSTER ON CRF
*        ROUTINE TO BUILD COMPOSITE CLUSTER INSERTING REFERENCE
*        NUMBERS AHEAD OF THAT FOR NAME.
*        R2 RESET TO BYTE ADDRESS OF NEW CLUSTER.
BUILD00  LI,R4    0
CCBUILD  RES      0
         LW,R14   R2                ORIGINAL CLUSTER- SOURCE REGISTER
         LB,R13   0,R2              SAVE ORIGINAL CLUSTER LENGTH
         LI,R15   BA(NEWCL)         NEW CLUSTER-- DeSTIN. REGISTER
         OR,R15   COUNT4            MOVE FOUR
         MBS,R14  0                 BYTES
         LW,R15   CPTR              NEXT HW LOCATION IN CLIST
         AI,R13   -2                DECREMENT CL. LENGTH BY 2 HALF WDS.
         LW,R2    SAVEREG           REF TYPE                            COBOL32
         CI,R2    2                                                     COBOL32
         BG       CBLD2             NOT DATA NAME                       COBOL32
CBLD1    AI,R13   -1                                                    COBOL32
         AI,R14   2                                                     COBOL32
CBLD2    RES      0                                                     COBOL32
         STB,R13  R15               SET UP COUNT FIELD DESTINATION REG.
         AW,R15   R15               SHIFT TO BYTE ADDRESSING
*                 SIDR 1736
*                 BAD EXTERNAL NAMES WITH LARGE COMMON
*
         AW,R14   R4                SKIP/DON'T SKIP REF #
         MBS,R14  0                 MOVE TAIL END OF CLUSTER
         LI,R2    BA(NEWCL)         CHANGE R2 TO NEW CLUSTER
         SW,R15   R2                CALCULATE NEW CLUSTER LENGTH
         SLS,R15  -1                HA
         STB,R15  0,R2              STORE IN NEW CLUSTER
         LI,R13   HA(CLIST)         INITIALIZE
         STW,R13  CPTR              NEXT CLIST POINTER
         B        *R11              RETURN
         PAGE
*
*        G E T D E F          S U B R O U T I N E S
*ROUTINE *PURPOSE *CALLS   *INPUT   *INPUT   *OUTPUT  *OUTPUT  *OUTPUT
*        *        *ROUTINE *IN REG. *IN REG. *IN REG. *IN REG. *
*-----------------------------------------------------------------------
*NXTRNUM |GET NEXT| GETIX  | R2     | R1     | R12    |  R3    |
*        |R<NO. IN|        | EPF    | HALF WD|        |        |
*        |CLUSTER.|        | CLUSTER|ADDRESS |ABSOLUTE| DINDEX |
*        |TURN OFF|        |        |CURRENT |REFER.  | ENTRY  |
*        |HIGH BIT|        |        |REF. NO.|NUMBER  |        |
*        |AND TURN|        |        |        |        |        |
*        |ON QORN |        |        |        |        |        |
*-----------------------------------------------------------------------
*GETIX   |OBTAIN  |        | R12    |        | R3     |        |
*        |DINDEX  |        |REF. NO.|        |        |        |
*        |ENTRY   |        |(DISPL< |        | DINDEX |        |
*        |FOR REF<|        |FROM    |        | ENTRY  |        |
*        |NUMBER  |        |BASE OF |        |        |        |
*        |        |        |DINDEX) |        |        |        |
*-----------------------------------------------------------------------
*CHAINLK |PICK UP |DICTATE |R3      | R4     |R3      |R4      |RETURN
*        |SYNONYM |        | DINDEX | (SEE   |SYNONYM |LOCATION| + 1
*        |LINKAGE |        | ENTRY  |DICTATE)|LINKAGE |FIELD C |IF LINK.
*        |OF DICT.|        |        |        |        |DICTION.|FILLED
*        |ITEM AND|        |        |        |        |        |
*        |TEST IF |        |        |        |        |        |
*        |FILLED  |        |        |        |        |        |
*-----------------------------------------------------------------------
*DICTATE |LOCATE  |        | R3     |        | R4     |        |
*        |DICTION.|        |        |        |WORD    |        |
*        |ITEM FOR|        |DINDEX  |        |ADDRESS |        |
*        |DINDEX  |        |ENTRY   |        |OF DICT.|        |
*        |ENTRY   |        |        |        | ENTRY  |        |
*-----------------------------------------------------------------------
         PAGE
*        ROUTINE FOR SATISFYING REFERENCE CLUSTERS
*        REPLACING REFERENCE NUMBERS WITH INFORMATION
*        IN DICTIONARY FROM APPROPRIATE DEFINITION
GETDEF   RES       0
GETDEFV1 LCI      4                 SAVE
         STM,R3   SAVEREG           REGISTERS 3-6
         STW,R11  NESTRET1          SAVE RETURN
         LI,R12   0                 FOR LOWER LIMIT
         STB,R12  NUR               TURN OFF NON UNIQUE FLAG
         STB,R12   QFLG
         LW,R13   PDBO
         CI,RTYP  2                 DATA OR PROCEDURE
         BG       PROPR             PROCEDURE REFERENCE OR DEFINITION
         STD,R12  SB1               ZERO SB1
         B        GETD              PROCESS DATA REFERENCE
PROPR    STW,R13  SB1               LOWEST PROCEDURE DICTIONARY SEGMENT
         LW,R13   HSN               HIGHEST DICTIONARY SEGMENT
         STW,R13  SB2               INTO SB2
GETP     LW,R1    R2                CLUSTER ADDRESS
         SLS,R1   -1                HALF WORD ADDRESS
GETNP    BAL,R11  NXTRNUM           TEST FOR QUAL. AND GET DINDEX ENTRY
         CI,R3    0                 DINDEX ENTRY ZERO
         BE       POSSPRM           YES- UNDEFINED- CHECK IF EXTERNAL
*   FIXES TRAP WHEN ALL OF THE PROCEDURE DIVISION DICTIONARIES          COBOL32
*     DONT  FIT IN CORE.                                                COBOL32
RESTR   RES       0                                                     COBOL32
         LW,R14   R3                                                    COBOL32
         AND,R14  SEGN             IS SEGMENT IN CORE                   COBOL32
         BEZ      %+3                  YES                              COBOL32
         CW,R14   LSN                                                   COBOL32
         BLE      TOMAIN              NO                                COBOL32
         CLM,R3   SB1            IS IT IN LIMITS                        COBOL32
         BCS,9    BOLO              OUT OF RANGE
         LB,R12   QORN              IN RANGE- ANY MORE REFERENCE NOS.
         BEZ      SIMNAM            NO- PROCESS SIMPLE NAME
         BAL,R11  CSYN              CHECK FOR DUPLICATE DEFINITION
         AND,R3   SEGN              SEGMENT NUMBER
         STD,R3   SB1                   AND ZERO INTO SB1
         LW,R13   DISPL                 AND  ALL  BITS
         STS,R13  SB2                             INTO SB2
         AI,R1    1                 PROCESS NEXT REFERENCE NUMBER
         B        GETNP             MAKE SURE IT IS WITHIN THIS SECTION
BOLO     LW,R11   SEGN               MASK FOR SEGMENT NUMBER
         AND,R11   R3
         BEZ      POSSPRM            ZERO SEGMENT
         BAL,R11  CHAINLK            CHECK SYNONUM CHAIN
         B        POSSPRM           END OF CHAIN-CHECK IF PARAMETER NAME
         B        RESTR             PROCESS NEXT ENTRY IN CHAIN
SIMNAM   BAL,R11  CHAINLK           CHECK SYNONYM CHAIN
         B        PCONST            END OF CHAIN. BUILD NEW CLUSTER
         CLM,R3   SB1               IS IT IN RANGE OF SB1 AND SB2
         BCS,9    PCONST            OUT OF RANGE
         LB,R13   QFLG,UP1          WAS REFERENCE QUALIFIED
         BEZ      SECQ              NO- QUALIFY IT WITH PRESENT SECTION
         LI,R13   0                 TURN OFF
         STB,R13  QFLG,UP1          FLAG
         STB,R7   NUR               NON UNIQUE INDICATOR
PCONST   LW,R3    R2                PICK UP
         AI,R3    2                    OPERAND
         LB,R13   0,R3                 OPTIONS
         OR,R13   L(X'10')          CHANGE TO TYPE '9'
         STB,R13  0,R3              PUT IN CLUSTER
         LB,R13   NUR               CHANGE NUR
         BEZ      %+2                  TO 2 IF ON
         MTB,1    NUR
         LW,R13   RSAVE             CHECK IF REF,DEF, OR PARAMETER
         CI,R13   4                 REF OR PARAMETER
         BAZ      DEFCONST          NO- BUILD DEFINITION CLUSTER
         CI,R13   2                 PARAMETER NAME?
         BAZ      REFCONST          NO- BUILD REFERENCE CLUSTER
         MTB,-2   0,R3              CHANGE TO '94'
         B        REFCONST             AND BUILD REFERENCE CLUSTER
*        DEFINITION - BUILD PROCEDURE DEFINITION CLUSTER
DEFCONST RES      0
         LI,R3    BA(CRFBUILD)      SET UP
         OR,R3    COUNT3            DESTINATION REGISTER
         MBS,R2   0                 MOVE 3 BYTES FROM EPF CLUSTER
         LW,R2    R4                SET R2
         AI,R2    -4                TO BEGINNING OF DICTIONARY ITEM
         LB,R13   0,R2              TYPE
         STB,R13  0,R3              INTO FIELD G OF CRF CLUSTER
         AI,R3    1                 INCREMENT DESTINATION REGISTER
         AI,R2    8                 POINT TO PROCEDURE REFERENCES
         LB,R12   0,R2              SAVE PROCEDURE REFERENCES BYTE
         OR,R3    COUNT8            MOVE
         MBS,R2   0                     8 BYTES FROM DICTIONARY
         SLS,R3   -1                HA
         LH,R13   INLBR             INTERNAL LABEL
         STH,R13  0,R3                  RANGE
         AI,R3    1                 INCREMENT BY HALF WORD
         AW,R3    R3                BYTE ADDRESS
         CI,R12   X'7F'             IS HIGH ORDER BIT OF PROC. REF  ON
         BG       DEXEX
DEFEX    BAL,R11  PADDLE            APPEND FILLER
         LI,R3    BA(CRFBUILD)+3    PICK UP
         LB,R13   0,R3              TYPE
         CI,R13   X'95'             IS IT DECLARATIVE SECTION
         BNE      TOMAIN            NO- EXIT
         LB,R13   USER,UP1          FLAG ON
         BEZ      TOMAIN            NO- RETURN
         AI,R3    3                 TO DEF ENTRY NO
         SLS,R3   -1                HA
         LH,R13   0,R3              DEF NO
         SLS,R13  8                 TO BITS 17-24
         STH,R13  *USEPOINT,UP1     TO TABLE ENTRY
         AI,R3    2                 TO EXIT
         LH,R13   0,R3                NUMBER
         AWM,R13  *USEPOINT         PUT IN TABLE
         MTW,1    USEPOINT          INCREMENT TABLE INDEX
         MTB,-1   USER,UP1          TURN OFF FLAG
         LW,R6    USEPOINT                                              COBOL32
         CI,R6    USEND             HAVE WE OVERDONE THE TABLE          COBOL32
         BLE      TOMAIN            NO                                  COBOL32
         LI,R1    279
         BAL,R11  DIAG              FATAL DIAG MORE THAN 64 USE STATE   COBOL32
DEXEX    LB,R13   0,R2              EXTERNAL REFERENCE
         AI,R13   1                 LNGTH OF NAME PLUS 1
         STB,R13  R3                    INTO COUNT FIELD DEST. REGISTER
         MBS,R2   0                 MOVE LENGTH BYTE AND NAME
         B        DEFEX             EXIT
SECQ     LH,R1    NUMBERS,UP1       LOAD CURRENT SECTION NUMBER
         OR,R1    QBIT              TURN ON QUALIFICATION BIT
         LW,R4    CPTR              PUT INTO CLIST
         STH,R1   0,R4              BUMP CLIST POINTER
         AWM,UP1  CPTR              BUILD NEW CLUSTER
         BAL,R11  BUILD00           RESOLVE WITH SECTION AS QUALIFIER
         B        GETP
POSSPRM  LW,RTYP  SAVEREG
         CI,RTYP  6                 IS IT A PARAMETER NAME
         BNE      %+5               NO- UNDEFINED
         LI,R12   0                 CHANGE
         LW,R13   PDBO                SEARCH
         STD,R12  SB1                    LIMITS
         B        GETD                     TO DDD
         LW,R13   LSN               IF THIS IS NOT THE LAST PASS
         BNEZ     TOMAIN            RETURN TO CALLING PROGRAM
EXPRM    LB,R13   1,R2              REFERENCE NUMBER
        CI,R13   X'7F'             IS IT QUALIFIED
         BG       PUNDIT            YES-ERROR- RETURN UNRESOLVED
         LI,R13   X'A4'             EXTERNAL REFERENCE
         LW,R4    R2                PICK UP
         AI,R4    2                     OPERAND OPTIONS
         STB,R13  0,R4              CHANGE TO TYPE 'A'
         LI,R13   X'0704'           CROSS REFERENCE CODE FOR EXTERNAL
PXRFU    BAL,R11  XRFU              PUT OUT ON XRF IF REQUESTED
         LI,R4    2
         BAL,R11  CCBUILD           REBUILD CLUSTER WITHOUT REF. NUMBER
         B        TOMAIN            RETURN TO CALLING PROGRAM
PUNDIT   LI,R13   X'0703'           CROSS REFERENCE CODE FOR ERROR
         B        PXRFU             OUTPUT TO XRF AND RETURN
TOMAIN   LCI      4                 RESTORE
         LM,R3    SAVEREG
         MTW,0    R2SAV             SEE IF CORRES CHANGED R2
         BEZ      TOMAIN1           NO
         LW,R2    R2SAV             YES
         LI,R1    0
         STW,R1   R2SAV             RESET R2SAV
TOMAIN1  RES      0
         LB,R13   NUR               IS NON UNIQUE FLAG ON
         BEZ      *NESTRET1         NO- RETURN
         LB,R1    NUR               FLAG- 1 IF DATA,2 IF PROCEDURE REF.
         AI,R1    X'57'             88-DATA 89-PROCEDURE REF. DIAG.
         BAL,R11  DIAG              PUT OUT DIAGNOSTIC
         B        *NESTRET1         RETURN
*        ROUTINE TO CONSTRUCT CRF CLUSTER REPLACING
*        PROCEDURE REFERENCE NUMBER WITH DICTIONARY INFORMATION
*        R2 CONTAINS BYTE ADDRESS OF EPF CLUSTER
*        R4 CONTAINS BYTE ADDRESS OF FIELD C OF DICTIONARY DEFINITION
*        R2 WILL CONTAIN BYTE ADDRESS OF NEW CLUSTER
*        R3 CONTAINS SYNONYM LINKAGE FIELD
REFCONST RES      0
         SLS,R4   -2                WORD ADDRESS OF LINE NO. INFO
         LW,R5    0,R4              LINE NUMBER AND COPY LINE NUMBER
         STW,R5   LINENTRY             INTO CROSS REFERENCE CLUSTER
         SLS,R4   2                 REVERT TO BYTE ADDRESSING
         LI,R5    BA(CRFBUILD)+2    SET UP
         LI,R3    BA(CRFBUILD)      RECEIVING REGISTERS
         OR,R3    COUNT4            MOVE FIRST FOUR BYTES
         MBS,R2   0                 FROM CURRENT CLUSTER
         AI,R4    -4                TO FIELD A OF PDD
         LB,R13   0,R4              MOVE
         STB,R13  0,R5              TYPE
         AI,R4    8                 POINT TO FIELD E OF PDD
         AI,R5    2                 POINT TO FIELD I OF NEW CLUSTER
         OR,R5    COUNT4            MOVE 4 BYTES
         MBS,R4   0                 TO NEW CLUSTER
         AI,R4    2                 POINT TO EXIT NUMBER IN PDD
         OR,R5    COUNT2            MOVE EXIT NUMBER
         MBS,R4   0                 TO NEW CLUSTER
         LW,R3    R5
CLUPAD   BAL,R11  PADDLE
         LI,R13   X'0702'           CROSS REFERENCE CODE FOR MATCH
         BAL,R11  XRFD              WRITE OUT CROSS REFERENCE
         B        TOMAIN            RETURN TO CALLING PROGRAM
PADDLE   LI,R13   X'FF'             APPEND
         STB,R13  0,R3                  FILLER BYTE
        AI,R3    2                 DETERMINE
         LI,R2    BA(CRFBUILD)          CLUSTER
         SW,R3    R2                    LENGTH
         SLS,R3   -1                DIVIDE BY 2
         STB,R3   0,R2              PUT LENGTH INTO FIRST BYTE
         B        *R11
NXTRNUM  STW,R11  NESTRET2
         LH,R12   1,R1              REFERENCE NUMBER - R1
         BLZ      QREFN             HIGH ORDER BIT ON - QUALIFIER
         LI,R13   0                 SIMPLE NAME -
         STB,R13  QORN                  ZERO OUT FLAG
         STH,R12  XRFBUILD,UP1      PUT REFERENCE NO. INTO XRF CLUSTER
         STH,R12  REF#              SAVE FOR DEBUG                      COBOL32
PINR     BAL,R11  GETIX             GET CORRESPONDING DINDEX ENTRY
         B        *NESTRET2         RETURN
QREFN    AND,R12  LOFIFTN           MASK OUT SIGN BITS AND QUALIF. BIT
         STB,R7   QORN              TURN ON QUALIFIER INDICATOR
         STB,R7   QFLG,UP1          TURN ON QUALIFICATION FLAG
         B        PINR              GET DINDEX ENTRY IN R3 AND RETURN
         PAGE
*        ROUTINE TO CHECK FOR DUPLICATE DEFINITIONS
CSYN     RES      0
         STW,R11  NESTRET3
         STW,R3   SAVEREG+4         SAVE CURRENT DINDEX ENTRY
         BAL,R11  CHAINLK           GET SYN. LINKAGE AND TEST IF FILLED
         B        SYNEX             END OF CHAIN
         CLM,R3   SB1               IS LINKAGE ALSO WITHIN RANGE
         BCS,9    SYNEX             NO- RETURN
         STB,UP1  NUR               TURN ON NON UNIQUE FLAG
SYNEX    LW,R3    SAVEREG+4         RESTORE CURRENT ENTRY
         B        *NESTRET3
GETD     LW,R1    R2                CLUSTER ADDRESS - R1
         SLS,R1   -1                HALF WORD ADDRESS
         CI,CBYT  X'74'                                                 COBOL32
         BL       GETD0             NOT IN CORR                         COBOL32
         CI,CBYT  X'77'                                                 COBOL32
         BLE      GETND                                                 COBOL32
GETD0    CI,RTYP  6                 PARAMETER                           COBOL32
         BE       GETND                                                 COBOL32
         AI,R1    1                                                     COBOL32
GETND    BAL,R11  NXTRNUM           SELECT NEXT REFERENCE NUMBER
         CI,R3    0                 IS DINDEX ENTRY
         BE       DXRFU                EMPTY
         STD,R3   R14               SAVE IN BOTH R14 AND R15
         AND,R14  SEGN              MASK THROUGH SEGMENT NUMBER
         CW,R14   LSN               IS SEGMENT IN MEMORY
         BG       DMAIN
         CI,R14   0                 SEGMENT NUMBER THIS ITEM 0
         BNE      DXRFU             UNRESOLVED
         LW,R13   SB1               SEGMENT 0 REFERENCED
         BNEZ     DXRFU             UNRESOLVED
GETFD    LB,R13   QORN              MORE REFERENCE NUMBERS?
         BEZ      FILEREF           NO- FILE REFERENCE- BUILD CLUSTER
         LW,R13   RSAVE             IS THIS A DATA NAME
         CI,R13   X'FD'                 OR SUBSCRIPT DATA NAME
         BANZ     DXRFU             NO- INVALID
         AND,R15  DISPL
         LW,R4    PDBZ+3            DB AREA ORIGIN
         AW,R4    R15                   PROPER ENTRY IN DDB
         SLS,R4   -1                HALF WORD ADDRESS
         LH,R12   1,R4              BEGINNING OF DICTIONARY RANGE
         AND,R12  LOW10             MASK THRU BITS 6-15
         SLS,R12  14                SEGNO POSITION
* THE FOLLOWING FOUR LINES  FIXES TRAP WHEN PROCESSING A REFERENCE      COBOL32
* QUALIFIED BY A 'FD' NAME AND ALL OF THE 01'S OF THAT FD DO NOT        COBOL32
* FIT IN CORE.   GG                                                     COBOL32
         CW,R12   LSN                                                   COBOL32
         BG       %+3                                                   COBOL32
         LW,R12   LSN                                                   COBOL32
         OR,R12   DISPL                                                 COBOL32
         AI,R4    1
         LH,R13   1,R4              END OF DICTIONARY RANGE
         AND,R13  LOW10             MASK THRU BITS 6-15
         SLS,R13  14                SEGNO POSITION
         OR,R13   DISPL             ALL BITS
         STD,R12  SB1               LIMITS INTO SB1 AND SB2
         AI,R1    1                 PROCESS NEXT
         B        GETND                 REFERENCE NUMBER
DXRFU    RES      0                                                     COBOL32
         LW,R13   LSN                IS THIS                            COBOL32
         BNEZ     TOMAIN            LAST PASS                           COBOL32
         LW,RTYP  SAVEREG           PICK UP REFERENCE TYPE
         CI,RTYP  6                 IS IT A PARAMETER NAME
         BE       EXPRM             YES
         LI,R13   X'0703'           CROSS REFERENCE CODE FOR ERROR
         BAL,R11  XRFU              OUTPUT ON XRF IF REQUESTED
         B        CORRES            CHECK IF CORRESPONDING
FILEREF  RES      0
         LI,R3    BA(CRFBUILD)      DESTINATION REGISTER
         OR,R3    COUNT4            MOVE FOUR BYTES
         MBS,R2   0                     FROM EPF CLUSTER
         MTW,0    PDBDBG                                                COBOL32
         BEZ      FILEREF2          DEBUG FLAG OFF                      COBOL32
         SLS,R3   -1                H.A. FOR REF#                       COBOL32
         LH,R4    REF#                                                  COBOL32
         STH,R4   0,R3              PUT IN CLUSTER                      COBOL32
         SLS,R3   1                 B.A.                                COBOL32
         AI,R3    2                 ADD 2 FOR REF#                      COBOL32
FILEREF2 RES      0                                                     COBOL32
         LW,R4    PDBZ+3            DB ORIGIN
         AW,R4    R15               ADD DISPLACEMENT
         LB,R13   0,R4              D.B. I.D.
         CI,R13   5                 IS IT AN RDB
         BE       RDBNO             YES
         LB,R13   10,R4             DDB POINTER
         AI,R4    X'29'             ACCESS NAME
DBLINE   LB,R14   0,R4                 LENGTH
         AW,R4    R14               ADD TO POINTER
         SLS,R4   -2                WORD ADDR
         AI,R4    1                 NEXT WORD IS
         LW,R15   0,R4              DB LINE NUMBER
         STW,R15  LINENTRY          INTO XRF CLUSTER
         STB,R13  0,R3                  INTO CRF CLUSTER
         MTW,0    PDBDBG                                                COBOL32
         BEZ      DBL2              NORMAL CLUSTER                      COBOL32
         AI,R3    -4                BACK UP TO OPERAND OPTIONS          COBOL32
         LI,R13   X'93'             CODE FOR FILE REF                   COBOL32
         STB,R13  0,R3                 INTO OPERAND OPTIONS             COBOL32
         LI,R13   4                 LENGTH OF 4 (HALF WORD)             COBOL32
         LI,R2    BA(CRFBUILD)      R2 TO NEW CLUSTER                   COBOL32
         STB,R13  0,R2              1NTO NEW CLUSTER                    COBOL32
         B        REFEXIT                                               COBOL32
DBL2     RES      0                                                     COBOL32
         AI,R3    -2                BACK UP TO OPERAND OPTIONS
         LI,R13   X'93'             CODE FOR FILE REF
         STB,R13  0,R3                  INTO OPERAND OPTIONS
         LI,R2    BA(CRFBUILD)      R2 TO NEW CLUSTER
         LI,R13   3                 LENGTH OF 3
         STB,R13  0,R2              INTO NEW CLUSTER
REFEXIT  LI,R13   X'0702'           CROSS REFERENCE CODE FOR MATCH
         BAL,R11  XRFD              WRITE OUT CROSS REFERENCE ENTRY
         CI,CBYT  X'6C'             IS IT IN USE STATEMENT
         BNE      CORRES            NO- CHECK IF IN 'CORRESPONDING'
         LW,R1    R2                PICK
         AI,R1    6                     UP
         LB,R13   0,R1                  TYPE CODE
         SLS,R13  -4                SHIFT TO LOW ORDER
         CI,R13   4                 IS IR REPORT TYPE
         BNE      TOMAIN            NO- RETURN TO CALLING PROGRAM
*        CONSTRUCT USE BEFORE REPORTING TABLE ENTRY
         LW,R4    USEPOINT          PICK UP NEXT AVAILABLE SLOT IN TABLE
         AI,R1    6                 PICK UP
         LB,R13   0,R1                 FIELD N (REPT DB NUMBER)
         STB,R13  *USEPOINT         BYTE 1 OF TABLE ENTRY
         AI,R1    5                 PICK UP
         LB,R13   0,R1                 FIELD R (REPT GROUP REF NUMBER)
         STB,R13  *USEPOINT,UP1     BYTE 2 OF TABLE ENTRY
         STB,UP1  USER,UP1
         B        TOMAIN
RDBNO    LB,R13   3,R4              RDB POINTER
         AI,R4    13                ACCESS NAME LENGTH                  COBOL32
         B        DBLINE
         PAGE
DBOLT    RES      0                 SEG OUT OF RANGE
         LW,R14   R3                IS THIS
         AND,R14  SEGN                 SEGMENT IN
         CW,R14   LSN                  MEMORY
         BLE      DXRFU             NO- THIS PASS CANNOT RESOLVE
         BAL,R11  CHAINLK           CHECK IF SYNONYM LINKAGE FILLED
         B        DXRFU             END OF CHAIN
         STD,R3   R14               R3 TO R14 & R15
         AND,R14   SEGN               DOES LINKAGE POINT
         CI,R14   0                     TO SEGMENT ZERO
*     THE FOLLOWING FOUR LINES OF CODE FIX A TRAP WHEN A PARAGRAPH      COBOL32
*    NAME AND A DATA NAME ARE THE SAME AND BOTH ARE NOT IN CORE         COBOL32
*   AT THE SAME TIME.                                                   COBOL32
         BE       GETFD                                                 COBOL32
         CW,R14   LSN                                                   COBOL32
         BG        DMAIN                                                COBOL32
         B         DXRFU                                                COBOL32
DQUAL    STW,R3   SB1               LOCATION OF CURRENT ENTRY
         BAL,R11  DICTATE           LOCATE DICTIONARY ENTRY
         SLS,R4   2                 BYTE ADDRESS
         AI,R4    9                 INCREMENT TO END OF RANGE POINTER
         LI,R3    0                 CLEAR RECEIVING FIELD
         LW,R5    RBYST             MOVE END OF RANGE
         MBS,R4   0                     TO R3
         LW,R4    SEGN              PICK UP SEGMENT NUMBER
         AND,R4   SB1                  FROM LOWER LIMIT
         OR,R3    R4                PUT IN UPPER LIMIT
         STW,R3   SB2               STORE IN UPPER SEARCH LIMIT
         AI,R1    1                 PROCESS NEXT
         B        GETND                 REFERENCE NUMBER
DMAIN    RES      0
         CLM,R3   SB1               IN RANGE OF SB1 AND SB2
         BCS,9    DBOLT             OUT OF RANGE
         BAL,R11  CSYN              CHECK FOR DUPLOCATE DEFINITION
         LB,R13   NUR               IS NON UNIQUE INDICATOR ON
         BEZ      UNIQUED           NO
         MTB,-1   NUR
         STW,R1   SAVEREG+4         SAVE R1
         LI,R1    X'58'             CODE FOR NON UNIQUE DATA REF
         BAL,R11  DIAG              PUT OUT DIAGNOSTIC
         LW,R1    SAVEREG+4         RESTORE R1
UNIQUED  LB,R13   QORN              ANY MORE REFERENCE NUMBERS
         BNEZ     DQUAL             YES- CHANGE SEARCH LIMITS
DATAREF  RES      0                 BUILD DATA REFERENCE CLUSTER
         BAL,R11  DICTATE           LOCATE DICTIONARY ITEM
         STW,R4   DPONTR            DDD POINTER
         LI,R3    BA(CRFBUILD)      NEW CLUSTER ADDRESS
         MTW,0    PDBDBG            IS DEBUG SWITCH ON                  COBOL32
         BEZ      MOV4                                                  COBOL32
         OR,R3    COUNT8            YES SAVE REF#                       COBOL32
         B        %+2                                                   COBOL32
MOV4     RES      0                                                     COBOL32
         OR,R3    COUNT6            MOVE 6 BYTES                        COBOL32
         LI,OTYP  X'90'             NEW OPERAND TYPE
         LW,R6    R2                PICK UP
         AI,R6    2                     OPERAND
         LW,R13   2,R4              LEVEL NUMBER IN BYTE 0
         LI,R14   X'58'             CHECK IF THIS
         CB,R14   R13                  IS A CONDITION NAME
         BNE      %+3               NO
         LI,R13   1                 CHANGE OPERAND OPTIONS
         B        %+2                   TO '9'
         LB,R13   0,R6                  OPTIONS
         OR,R13   OTYP              CHANGE TO TYPE 9
         STW,R13  SVOTYP            SAVE OPERAND TYPE                   COBOL32
         CI,R13   X'96'             IS IT A PARAMETER NAME?
         BNE      %+2               NO
         AI,R13   -6                CHANGE TO DATA NAME
         STB,R13  0,R6              IN NEW CLUSTER
         SLS,OTYP -4                SAVE OTYP FOR CORRESPONDING ROUT.
         MBS,R2   0                 FROM EFP CLUSTER
         LW,R6    R4                SAVE WORD ADDRESS DDD ITEM (CORRES)
         SLS,R4   2                 BYTE ADDRESS OF DDD ITEM
         LB,R15   0,R4              SAVE DDD ITEM LENGTH
         SLS,R15  2                     IN BYTES
         AI,R4    14                INCREMENT TO FIELD H
         LW,R2    R4                THIS ADDRESS TO SOURCE REGISTER
         AI,R15   -14               LENGTH OF REMAINDER
         STB,R15  R3                    INTO COUNT FIELD DEST. REGISTER
         MBS,R2   0                 MOVE DDD PORTION TO NEW CLUSTER
         LW,R1    DPONTR            DDD POINTER
         LI,R2    HA(CRFBUILD)      CRF BUFFER ADDR
         BAL,R11  RCORDV            RESOLVE VAR REC
         LW,R2    SVOTYP            OPRND TYPE                          COBOL32
         CI,R2    X'90'                                                 COBOL32
         BNE      MOV41             NOT DATA REF                        COBOL32
         LB,R2    CRFBUILD+1                                            COBOL32
         OR,R2    SUBS              RECOVER SUBSCRIPT COUNT             COBOL32
         STB,R2   CRFBUILD+1                                            COBOL32
MOV41    RES      0                                                     COBOL32
         MTW,0    PDBDBG                                                COBOL32
         BEZ      BALPAD                                                COBOL32
         LH,R13   REF#              PICK UP SAVED REF#                  COBOL32
         LI,R4    HA(CRFBUILD)                                          COBOL32
         AI,R4    1                                                     COBOL32
         STH,R13  1,R4              STORE REF# IN CRF CLUSTER           COBOL32
BALPAD   RES      0                                                     COBOL32
         BAL,R11  PADDLE            APPEND FILLER AND INSERT NEW LENGTH
         B        REFEXIT
XRFU     STW,R11  NESTRET2
         LW,R1    R2                ADDRESS OF ORIGINAL CLUSTER
         SLS,R1   -1                HALF WORD ADDRESS
XRNO     LH,R15   1,R1              LOAD REFERENCE NUMBER
         BLZ      QINC              QUALIFIER
         STH,R15  XRFBUILD,UP1      SIMPLE NAME- STORE IN XRF CLUSTER
         LW,R14   ALLBITS           PUT ALL BITS
         STW,R14  LINENTRY              INTO DEF. LINE NUMBERS
XRFDENT  STH,R13  XRFBUILD          LENGTH AND CROSS REFERENCE CODE
         LI,R13   X'2000'           IS XRF
         AND,R13  PDBCC                 OPTION REQUESTED
         BEZ      %+3               NO-RETURN
         LI,R4    BA(XRFBUILD)      PUT OUT
         BAL,R11  WRXRF                 THE CROSS REFERENCE
         B        *NESTRET2         RETURN
QINC     AI,R1    1                 INCREMENT TO
         B        XRNO                  NEXT REFERENCE NUMBER
XRFD     STW,R11  NESTRET2
         B        XRFDENT           DEF FOUND AND INFO STORED ALREADY
CORRES   AND,CBYT L(X'7F')
         CI,CBYT  X'74'             IS THIS A REFERENCE
         BL       TOMAIN            WITHIN A MOVE,ADD OR SUBTRACT
         CI,CBYT  X'77'             CORRESPONDING OR SOURCE IS SLEECTED
         BG       TOMAIN            IF NOT RETURN TO CALLING PROGRAM
         LW,R3    SAVEREG           IS THIS A
         CI,R3    2                     SUBSCRIPT DATA NAME
         BE       TOMAIN            IF SO RETURN TO CALLING PROGRAM
         CI,OTYP  9                 IS THE NAME RESOLVED
         BNE      UNRECOR           NO- PUT OUT SPECIAL CLUSTER
         STW,UP1  CORRESP           TERN ON FLAG IN 3.0
         MTW,0    PDBDBG            SEE IF DEBUGGING
         BEZ      WHERE1
         LW,R3    R2                ADDRESS OF CLUSTER
         AI,R3    2
         LB,R15   0,R3
         CI,R15   X'90'
         BL       WHERE1            DO NOT COMPRESS
         CI,R15   X'92'
         BG       WHERE1
         LI,R15   BA(NEWSAV)        TEMP WORK AREA FOR COMPRESSING CLUS
         OR,R15   COUNT6            MOVE FIELDS A,B,C,D,E
         LW,R14   R2
         MBS,R14  0
         AI,R14   2                 SKIP REFERENCE NUMBER
         LB,R3    0,R2              SIZE IN H.W.
         SLS,R3   1                 SIZE IN BYTES
         AI,R3    -8                ADJUST SIZE OF CLUSTER
         STB,R3   R15               SIZE FOR MOVING REST OF CLUSTER
         MBS,R14  0
         AI,R3    6                 SIZE OF CLUSTER
         SLS,R3   -1
         STB,R3   NEWSAV
         STW,R2   R2SAV             SAVE R2
         LI,R2    BA(NEWSAV)
WHERE1   RES      0
         LW,R1    R2                ADDRESS OF CRF CLUSTER
         LW,R4    R2                ACCESS
         AI,R4    6                    FIELDS
         LB,R13   0,R4                 H AND I
         CI,R13   X'F'              CHECK CLASS
         BANZ     ELEMCOR           NOT A GROUP
         AI,R1    1                 PICK UP
         LB,R13   0,R1                  CONTROL BYTE
         STB,R13  1,R2              PUT IT INTO FIELD E
         LI,R14   X'40'             CODE FOR GROUP IN CORRESPONDING
         OR,R14   STOP              CHANGE TO 41 IF 'TO' GROUP
         STB,R14  0,R1              PUT INTO CONTROL BYTE FIELD
         LW,R4    R2                SET OUTPUT REGISTER TO MODIFIED CRF
         BAL,R11  WHERE
         STW,R6   CGPOINT           SAVE ADDRESS OF GROUP DDD ENTRY
         STB,R13  0,R1              RESTORE CONTROL BYTE IN CRF CLUSTER
         LB,R13   *R6               LOAD LENGTH OF GROUP DDD SEGMENT
         LW,R14   2,R6              SAVE END OF RANGE
         AND,R14  LOW24                 OF GROUP
         AW,R14   SAVERG5
         STW,R14  CSE                   IN CSE
         LI,R14   3
         AND,R14  3,R6              NUMBER OF DIMENSIONS
         STB,R14  CSD                   IN CSD
NXTSUB   AW,R6    R13               INCREMENT TO NEXT SUBORDINATE ENTRY
         CW,R6    CSE               END OF GROUP ENTRIES
         BGE      TOTRAIL           GO PUT OUT TRAILER
         LB,R13   *R6               LENGTH OF THIS ENTRY
         LW,R14   2,R6              LOAD LEVEL NUMBER AND END OF RANGE
         SLS,R14  -24               SHIFT LEVEL NUMBER TO LOW ORDER
         CI,R14   50                IS IT GREATER THAN 49
         BGE      NONXT             YES- PROCESS NEXT AT EQ. OR L LEVEL
         LI,R14   3
         AND,R14  3,R6              NUMBER OF DIMENSIONS
         CW,R14   CSD               IS IT GREATER THAN THAT FOR GROUP
         BG       NONXT             IF SO PROCESS NEXT
         LI,R1    HA(SAVBUF)        FORMAT CSF CLUSTER IN SAVBUF
         LI,R12   X'0042'           CODE FOR CORRESPONDING SUBORDINATE
         OR,R12   STOP              43 IF 'TO' GROUP
         STH,R12  0,R1              INTO BYTE 1 OF CLUSTER
         LW,R4    R6                ADDRESS OF SUBORDINATE DDD ENTRY
         LI,R5    BA(SAVBUF)+2      DESTINATION ADDRESS
         LI,R12   6
         STB,R12  R5                TO COUNT POSITION OF DESTIN. REG.
         AI,R4    2                 INCREMENT SOURCE ADDRESS TO
         SLS,R4   2                 BYTE ADDRESS OF FIELD E
         MBS,R4   0                 MOVE TO SAVBUF
         CI,CBYT  X'77'
         BE       %+2               SOURCE SELECTED
         AI,R5    2
         LW,R12   R13
         SLS,R12  2
         AI,R12   -14
         STB,R12  R5
         MBS,R4   0                 FROM H ON TO SAVBUF
         LCI      3
         STM,R1   VREGS
         LW,R3    R5
         CI,CBYT  X'77'
         BE       NXTSSL            SOURCE SELECTED
         LW,R4    SAVBUF+1          SAVE F OF CSF
         LW,R1    R6                DDD ADDRESS
         LI,R2    HA(SAVBUF)        CLUSTER ADDRESS
         BAL,R11  RCORDV            RESOLVE VAR REC
         XW,R4    SAVBUF+1
         SLS,R4   -16
         LI,R2    X'FFF3'
         AND,R2   SAVBUF+2          GET RID OF VAR FLAG
         STH,R4   R2
         STW,R2   SAVBUF+2
NXTSSL   AI,R3    2-BA(SAVBUF)
         SLS,R3   -1                CLUSTER LENGTH
         STB,R3   SAVBUF
         LCI      3
         LM,R1    VREGS
         LI,R4    BA(SAVBUF)
         BAL,R11  *CFILEOUT         OUTPUT ON APPROPRIATE FILE
         B        NXTSUB            PROCESS NEXT ENTRY IF ANY
NONXT    LW,R6    2,R6              END OF RANGE                        COBOL32
         AND,R6   LOW24                                                 COBOL32
         AW,R6    SAVERG5           BASE OF DDD                         COBOL32
         B        NXTSUB+1          TRY NEXT ENTRY
WHERE    STW,R11  NESTRET2          SAVE RETURN
         CI,CBYT  X'77'             IS IT SOURCE SELECTED
         BNE      %+3               NO
         BAL,R11  WRCRFS            PUT ON CRF
         B        *NESTRET2         RETURN
         BAL,R11  *CFILEOUT         PUT ON APPROPRIATE FILE
         B        *NESTRET2         RETURN
         PAGE
UNRECOR  LW,R13   LSN               IS THIS THE LAST PASSS
         BNEZ     TOMAIN            IF NOT RETURN
ELEMOUT  RES      0
         LW,R13   ELEMUND           SYNTAX ONLY CLUSTER
         OR,R13   STOP              'FROM' OR 'TO' GROUP INDICATOR
         STW,R13  TRAILCOR             INTO CLUSTER
         LI,R4    BA(TRAILCOR)      OUTPUT ON APPROPRIATE FILE
         BAL,R11  WHERE
         B        TOMAIN            RETURN TO CALLING PROGRAM
TOTRAIL  CI,CBYT  X'77'             IS IT SOURCE SELECTED
         BE       TOMAIN            YES- NO TRAILER NECESSARY
         LI,R3    BA(TRAILCOR)+1    PUT STATEMENT OPTIONS
         STB,CBYT 0,R3                 INTO CLUSTER
         AI,R3    2                 PUT CODE
         LI,R13   X'40'                INTO STATEMENT OPTIONS
         OR,R13   STOP              41 IF 'TO' GROUP
         STB,R13  0,R3
         LI,R13   X'0409'           WRITE OUT
         STH,R13  CSFLINE,UP1          A LINE NUMBER
         LI,R4    BA(LINENTRY)         CLUSTER
         BAL,R11  WHERE
         LI,R4    BA(TRAILCOR)      OUTPUT TRAILER
         BAL,R11  WHERE
         B        TOMAIN            RETURN
ELEMCOR  AI,R4    -4                ACCESS OPERAND OTIONS
         LI,R13   X'91'                CHANGE TO CONDITION NAME
         STB,R13  0,R4              TO FORCE PHASE 4 DIAGNOSTIC
         B        ELEMOUT           PUT OUT AN UNDEFINED CLUSTER ON CSF
         PAGE
*        CONSTANTS AND MASKS USED BY GETDEF
SUBS     DATA     0                 SAVE SUBSCRIPT                      COBOL32
SVOTYP   DATA     0                 SAVE OPRND TYPE                     COBOL32
NUMBERS  RES      0
INLBR    DATA,2   0                 RANGE NUMBER
SECNO    DATA,2   0                 SECTION NUMBER
CPTR     GEN,32   HA(CLIST)
CGPOINT  GEN,32   0                 ADDRESS OF CORRESPOMDING GROUP- DDD
CSE      GEN,32   0                 END OF RANGE OF CORRESPONDING GROUP
CSD      GEN,32   0
COUNT8   DATA     X'08000000'
COUNT4   DATA     X'04000000'
COUNT6   DATA     X'06000000'       COUNT FOR 6 BYTES                   COBOL32
REF#     DATA     0                                                     COBOL32
QBIT     DATA     X'00008000'
RBYST    DATA     X'0300000D'
ELEMUND  DATA     X'03080000'
LOW10    DATA     X'000003FF'
LOFIFTN  DATA     X'00007FFF'
SEGN     DATA     X'00FFC000'
DISPL    DATA     X'00003FFF'
COUNT3   DATA     X'03000000'
COUNT2   DATA     X'02000000'
LOW24    DATA     X'00FFFFFF'
ALLBITS  DATA     X'FFFFFFFF'
         BOUND    4
NEWCL    RES,1    4
CLIST    RES,2    2
CRFBUILD RES,2    400               CRU BUFFER
         BOUND    4
SAVEREG  RES      6
FLAGD1   RES      0
QORN     DATA,1   0
QFLG     DATA,1   0
         RES,2    1
NUR      DATA,1   0
USER     DATA,1   0
         RES,1    2
RSAVE    EQU      SAVEREG           SAVED REF. TYPE
*ADDRESS CONSTANTS
NESTRET1 GEN,32   0                 FOR NESTED
NESTRET2 GEN,32   0                     SUBROUTINE EXITS
NESTRET3 GEN,32   0
CFILEOUT GEN,32   WA(WRCRFS)        OUTPUT FILE ADDRESS FOR CORRES
         BOUND    8
SB1      GEN,32   0                 LOW LIMIT DICTIONARY SEARCH
SB2      GEN,32   0                 UPPER LIMIT DICTIONARY SEARCH
SAVBUF   RES      300
NEWSAV   RES      75
R2SAV    DATA     0                 STORE R2 FOR CORRES
TRAILCOR GEN,32   X'03000000'
         GEN,16   X'FF03'
DPONTR   DATA     0                 SAVE DDD PONTER(WORD ADDR)
VREGS    RES      3
*DLAREA3,4 RES     REMOVED  SIDR 1954
         END      START
