         SYSTEM   SIG7FDP
         TITLE    'PHASE 3.3'
*        THIS PHASE 'EXPLODES MOVE, ADD, AND SUBTRACT CORRESPONDING
*        STATEMENTS. THE INPUT TO THIS PHASE IS THE CRF WHICH IS
*        A CLUSTERED FILE READ BACKWARDS CONSISTING OF A COMPLETE
*        DESCRIPTION OF THE GROUPS IN THE CORRESPONDING STATEMENTS
*        IN THE SOURCE PROGRAM. THE OUTPUT OF 3.3 IS THE ECF WHICH
*        CONSISTS OF INDIVIDUAL MOVE, ADD OR SUBTRACT STATEMENTS
*        EXPLODED FROM THE ORIGINAL STATEMENT FOUND ON THE CRF.
*        EACH SERIES OF STATEMENTS FOUND ON THE ECF IS FOLLOWED BY
*        A SPECIAL CLUSTER TO INDICATE THE END OF A CORRESPONDING
*        STATEMENT.
ERX33R   EQU      0                   USE TO HOLD ERROR CODE            COBOL33
ERX33N   EQU      122                 MESSAGE NUMBER, LIMIT EXCEEDED    COBOL33
R1       EQU      1
BYTE     EQU      1                 CURRENT BYTE
CURR     EQU      2                 INPUT AND CURRENT CLUSTER
R2       EQU      2
R3       EQU      3
R4       EQU      4
OUT      EQU      4                 OUTPUT REGISTER
R5       EQU      5
R6       EQU      6
CBYT     EQU      6
R7       EQU      7
UP1      EQU      7
R8       EQU      8
STOP     EQU      8
R9       EQU      9
R10      EQU      10
LINK     EQU      11                LINKAGE REGISTER
R11      EQU      11
R12      EQU      12
W2       EQU      12
R13      EQU      13
W3       EQU      13
R14      EQU      14
W4       EQU      14
R15      EQU      15
W5       EQU      15
         REF      PDBZ
         REF      WRECF
         REF      RDCSF
         REF      PH33E
         REF      DIAG
         REF      CARDNO
         DEF      COB33
         DEF      ERX33               USE TO SNAP ERROR CONDITION       COBOL33
         PAGE
*        INITIALIZATION ROUTINE
COB33    EQU      START
START    RES      0
         LW,W3    HOC
         STW,W3   FR
         LI,UP1   1
         PAGE
CLIP     RES      0
         BAL,LINK RDCSF             GET CLUSTER FROM CSF
         BLZ      PH33E             END OF FILE
         LW,BYTE  CURR              PICK
         AI,BYTE  1                   UP
         LB,CBYT  0,BYTE                CONTROL BYTE
         AND,CBYT LOW4              BRANCH TO APPROPRIATE
         B        %+1,CBYT             CLUSTER HANDLING ROUTINE
         B        FRGROUP           GROUP CLUSTER- FROM GROUP
         B        TOGROUP           GROUP CLUSTER- 'TO' GROUP
         B        FRSUB             SUBORDINATE- FROM GROUP
         B        TOSUB             SUBORDINATE- 'TO' GROUP
         B        TRAILER
         B        TRAILER
         B        TRAILER
         B        TRAILER
         B        UNDGRP
LINECL   LW,R3    DEST
         MBS,CURR 2                 SAVE LINE NUMBER
         B        CLIP              GET NEXT CLUSTER
TRAILER  AI,BYTE  2                 ACCESS
         LB,STOP  0,BYTE                STATEMENT OPTIONS
         CI,STOP  X'40'             IS IT A 'FROM GROUP,TRAILER
         BNE      TOTRLR            NO- 'TO' GROUP TRAILER
         LW,W3    HOC               NEXT SERIES OF CLUSTERS
         STW,W3   FR                    TO HIGHEST AVAILABLE ADDRESS
         OR,CBYT  L(X'00000070')
         STW,CBYT STATYP            SAVE STATEMENT TYPE
         LI,W3    0
         STW,W3   MULTOP            INITIALIZE FLAG
         STH,W3   TYPE8             BYPASS FLAG
         B        CLIP              GET NEXT CLUSTER
UNDGRP   LI,W3    X'80'
         AI,BYTE  2
         LB,STOP  0,BYTE
         OR,W3    STOP
         STH,W3   TYPE8
         B        CLIP              GET NEXT CLUSTER
TOTRLR   RES      0                 TRAILER ITEM- 'TO' GROUP
         LH,W3    TYPE8             WAS LAST GROUP UNDEFINED
         BNEZ     SLIPPER           YES- CHECK IF FROM OR TO
         LW,W3    MULTOP            IS THIS A MULTIPLE OPERAND
         BNEZ     NXTO              YES
         STW,UP1  MULTOP            TURN ON FLAG
         B        CLIP              GET NEXT CLUSTER
SLIPPER  AND,W3   UP1               WAS UNDEFINED GROUP ANOTHER 'TO'
         BEZ      CLIP              NO- LEAVE FLAG ALONE
         LI,W3    0                 TURN OFF FLAG
         STH,W3   TYPE8
         B        CLIP              GET NEXT CLUSTER
NXTO     LW,W3    FR                REINTIALIZE TO
         STW,W3   TO                    TO BEGIN TO AREA
         B        CLIP              GET NEXT CLUSTER
FRGROUP  LW,W3    FR                INITIALIZE TO
         STW,W3   TO                    TO CURRENT FR POINTER
         B        CLIP              GET NEXT CLUSTER
TOGROUP  LH,W3    TYPE8
         BNEZ     CLIP
         LW,W3    FR                CHECK TO SEE IS THERE               COBOL33
         CW,W3    HOC               ANY FROM ITEMS                      COBOL33
         BE       NOITEM            NO                                  COBOL33
         CW,W3    TO                ANY TO ITEMS                        COBOL33
         BE       NOITEM            NO                                  COBOL33
         BAL,LINK CORRAL            BOTH GRO4PS NOW 9N-F9LL IN EOR'S
         BAL,LINK EXPLODE           EXPLODE STATEMENT
         LW,W3    FR                INITIALIZE TO
         STW,W3   TO                    IN EVENT OF MULTIPLE OPERANDS
         B        CLIP              GET NEXT CLUSTER
NOITEM   RES      0                                                     COBOL33
         LI,LINK  %+3               SET RETURN                          COBOL33
         STW,LINK NESTRET2                                              COBOL33
         B        ENDEX             WRITE END OF  CORR CLUSTER          COBOL33
         LW,R3    HOC               RESET TABLE START LOC               COBOL33
         STW,R3   FR                                                    COBOL33
         STW,R3   TO                REINIT 'TO' POINTER                 COBOL33
         B        CLIP              GET NEXT CLUSTER                    COBOL33
         PAGE
FRSUB    LH,W3    TYPE8             BYPASS FLAG
         BNEZ     CLIP              ON- GET NEXT
         LW,R3    FR                CURRENT POINTER
         LB,W3    0,CURR            CLUSTER LENGTH
         LW,W2    W3                SAVE LENGTH
         AW,W3    W3                    IN BYTES
         SW,R3    W3                ADJUST POINTER
         CW,R3    LOC                                                   COBOL33
         BGE      %+3                NORMAL, ABOVE LOW LIMIT            COBOL33
         LI,ERX33R 1                 ERROR NUMBER                       COBOL33
         B        ERX33                                                 COBOL33
         STW,R3   FR                    ADDRESS
         AI,CURR  1                 ELIMINATE LEADING BYTE
         STB,W3   R3                COUNT FIELD
         MBS,CURR 0                 MOVE CLUSTER
         LW,CURR  FR                ADDRESS OF NEW CLUSTER
         STB,W2   0,CURR            CLUSTER LENGTH
         B        CLIP
TOSUB    LH,W3    TYPE8             BYPASS FLAG
         BNEZ     CLIP              ON- GET NEXT
         LW,R3    TO                CURRENT POINTER
         LB,W3    0,CURR            CLUSTER LENGTH
         LW,W2    W3                SAVE LENGTH
         AW,W3    W3                    IN BYTES
         SW,R3    W3                ADJUST POINTER
         CW,R3    LOC                                                   COBOL33
         BGE      %+3                NORMAL                             COBOL33
         LI,ERX33R 2                 ERROR NUMBER                       COBOL33
         B        ERX33                                                 COBOL33
         STW,R3   TO                    ADDRESS
         AI,CURR  1                 ELIMINATE LEADING BYTE
         STB,W3   R3                COUNT FIELD
         MBS,CURR 0                 MOVE CLUSTER
         LW,CURR  TO                ADDRESS OF NEW CLUSTER
         STB,W2   0,CURR            CLUSTER LENGTH
         B        CLIP
         PAGE
CORRAL   STW,LINK NESTRET1
         LW,R5    TO                INITIALIZE POINTER
         LW,R1    FR                FIRST CHECKPOINT            122
CORRAL1  LB,W5    *LEVER            LEVEL # AT TABLE INDEX
         AI,R5    1                 TO CURRENT LEVEL NUMBER
CORRAL2  CB,W5    0,R5              IS LEVEL # AT TABLE INDEX > OR =
         BGE      TOEOR             YES PUT THIS ADDR  INTO EOR AT LEVER
         MTW,1    LEVER             INCREMENT POINTER
         LB,W3    0,R5              LEVEL NUMBER
         AI,R5    -1                BACK UP TO CLUSTER LENGTH
         STW,R5   *LEVER            ADDRESS INTO CURRENT TABLE ENTRY
         STB,W3   *LEVER            LEVEL NUMBER
         LB,W3    0,R5                  CLUSTER LENGTH
         AW,W3    W3                    IN BYTES
         AW,R5    W3                UPDATE POINTER
         CW,R5    R1                END OF GROUP                122
         BNE      CORRAL1           NO- CHECK NEXT ENTRY
FREOR    BAL,LINK XEND
         MTW,-1   LEVER             BACK UP TO PREVIOUS TABLE ENTRY
         LW,W3    *LEVER            LAST ENTRY?
         BNEZ     FREOR             NO
         CW,R1    HOC               END OF 'FROM' GROUP?        122
         BE       *NESTRET1         YES- RETURN                 122
         LW,R1    HOC               'FROM' GROUP STOPPER        122
         B        CORRAL1           PROCESS 'FROM' GROUP        122
         B        *NESTRET1         RETURN FROM CORRAL
TOEOR    AI,R5    -1                ACCESS FIRST BYTE OF CLUSTER
         BAL,LINK XEND              FILL IN EOR OF CLUSTER AT LEVER
         MTW,-1   LEVER             BACK UP TO PREVIOUS TABLE ENTRY
         B        CORRAL1           CHECK AGAIN
XEND     LW,W3    *LEVER            LEVEL NO + ADDRESS- CURR. TABLE ENT.
         AND,W3   LOW24             MASK THRU ADDRESS
         AI,W3    2                 EOR ADDRESS
         LI,W2    3                 COUNT
         STB,W2   W3                    FIELD
         LI,W2    X'15'             ADDRESS OF BYTE 1 OF R5
         MBS,W2   0                 MOVE ADDRESS TO EOR
         B        *LINK             RETURN
         PAGE
EXPLODE  STW,LINK NESTRET2
         LW,W3    FR                SAVE RETURN
         STD,W3   FC                    (ALSO END OF 'TO')
* THE FOLLOWING CODE WAS ADDEDED FOR SIDR'S 10209 AND
*  24476.   IT WILL DETERIMINE IF THE TO ITEMS ARE IN
*  SEQUENTIAL ORDER OR NOT SO THAT THE PLACE TO RETURN AT
*   THE END OF NESTF WILL BE KNOWN.
         LW,W3    TO                FIRST 'TO' LOCATION                 COBOL33
         STW,W3   TC                                                    COBOL33
         LI,W3    0                 INITIALIZE LAST REF NO REGISTER
SEQ%LOP  RES      0                                                     COBOL33
         BAL,R11  GETREF            GET REF NUMBER                      COBOL33
         CW,W4    W3                COMPARE WITH LAST REF NO            COBOL33
         BL       NON%SEQ           SET FLAG FOR NOT SEQUENTIAL         COBOL33
         LW,W3    W4                SAVE LAST REF NO                    COBOL33
         BAL,R11  INCPTR                                                COBOL33
         CW,R4    FR                SEE IF ALL 'TO' ITEMS PROCESSED     COBOL33
         BL       SEQ%LOP           NOT YET                             COBOL33
         B        S%LOOP            SEQ ORDER--DO NOT SET FLAG          COBOL33
GETREF   RES      0                                                     COBOL33
         LW,R4    TC                                                    COBOL33
         AI,R4    5                                                     COBOL33
         LB,W4    0,R4              PICK UP                             COBOL33
         SLS,W4   8                   REFERENCE                         COBOL33
         AI,R4    1                   NUMBER                            COBOL33
         LB,W5    0,R4                OF                                COBOL33
         OR,W4    W5                  CURRENT 'TO' ITEM                 COBOL33
         B        *R11              RETURN                              COBOL33
INCPTR   RES      0                                                     COBOL33
         LW,R4    TC                CURRENT 'TO'                        COBOL33
         LB,R12   0,R4                PLUS LENGTH                       COBOL33
         AW,R12   R12                 IN BYTES                          COBOL33
         AW,R4    R12                 TO                                COBOL33
         STW,R4   TC                  CURRENT 'TO'                      COBOL33
         B        *R11              RETURN                              COBOL33
NON%SEQ  MTW,1    SEQFLG            SET NON-SEQ ORDER FLAG              COBOL33
         LW,W3    TO                SET UP CURRENT                      COBOL33
         STD,W3   TC                 AND LOOP PTRS FOR 'TO' GROUP       COBOL33
INITREF  BAL,R11  GETREF                                                COBOL33
         LW,W3    W4                SET UP FIRST REF NO                 COBOL33
DUPLOOP  RES      0                                                     COBOL33
         BAL,R11  INCPTR            INCREMENT 'TO' PTR                  COBOL33
         CW,R4    FR                HAVE WE DONE ALL 'TO'               COBOL33
         BE       INCLOOP           YES--DO NEXT GROUP                  COBOL33
         BAL,R11  GETREF            NO--GET NEXT REF NO                 COBOL33
         CW,W4    W3                                                    COBOL33
         BE       RESET                                                 COBOL33
         B        DUPLOOP           LOOP                                COBOL33
INCLOOP  RES      0
         LW,R4    TPTR              RESET CURRENT PTR                   COBOL33
         STW,R4   TC                                                    COBOL33
         BAL,R11  INCPTR                                                COBOL33
         STW,R4   TPTR              SAVE CURRENT PTR                    COBOL33
         CW,R4    FR                ARE WE FINISHED                     COBOL33
         BL       INITREF           NO                                  COBOL33
         B        S%LOOP            YES                                 COBOL33
RESET    RES      0                                                     COBOL33
         MTW,-1   SEQFLG            RESTE FLAG                          COBOL33
S%LOOP   RES      0                                                     COBOL33
         LW,W3    TO                SAVE FIRST TO
         STD,W3   TC                    LOCATION  (M)
MAINX    LW,W3    TPTR              PUT 'TO' POINTER
         STW,W3   TC                    IN CURRENT
COMPX    LW,BYTE  FC                PICK UP
         CW,BYTE  HOC                TEST FOR UPPER LIMIT               COBOL33
         BGE      ENDEX              TREAT LIKE END                     COBOL33
         AI,BYTE  5                     REFERENCE
         LB,W3    0,BYTE                NUMBER
         SLS,W3   8                     OF
         AI,BYTE  1                     CURRENT
         LB,W2    0,BYTE                'FROM'
         OR,W3    W2                    ITEM
         LW,R4    TC                PICK UP
         AI,R4    5                     REFERENCE
         LB,W4    0,R4                  NUMBER
         SLS,W4   8                     OF
         AI,R4    1                     CURRENT
         LB,W5    0,R4                  'TO'
         OR,W4    W5                    ITEM
         CW,W3    W4                ARE REFERENCE NUMBERS
         BE       GRCHECK           EQUAL- YES- CHECK IF BOTH GROUPS
         LW,R12   TC                PICK UP
         AI,R12   2                     END
         LI,R13   BA(TC)+1              OF
         LI,R14   3                     RANGE
         STB,R14  R13               REPLACE CURRENT 'TO'
         MBS,R12  0                 ITEM WITH ITS END OF RANGE
         LW,R13   TC                IS THIS THE END
         CW,W3    FR                    OF 'TO' ITEMS
         BL       COMPX              NO - CHECK REFERENCE NUMBERS       COBOL33
         BE       NESTF              NORMAL TERMINATION                 COBOL33
         LI,ERX33R 3                 ERROR NUMBER                       COBOL33
         B        ERX33                                                 COBOL33
NESTF    LW,R12   FC                PICK UP
         AI,R12   2                     END
         LI,R13   BA(FC)+1              OF
         LI,R14   3                     RANGE
         STB,R14  R13               REPLACE CURRENT 'FROM'
         MBS,R12  0                 ITEM WITH ITS END OF RANGE
         LW,R13   FC                IS THIS THE END
         CW,R13   HOC                   OF 'FROM' ITEMS
         BE       ENDEX             YES- OUTPUT END OF STATEMENT CLUSTER
         CW,R13   FPTR              CURRENT EQUAL TO NEST POINTER
         BNE      MAINX             NO- LOOP
         MTW,-3   STACKER           PUSH UP
         LCI      3                     STACK LIST
         LM,R13   *STACKER          FIELDS FC,
         STW,R13  FPTR
         STW,W4   LPTR
         STW,W5   TPTR
         MTW,0    SEQFLG                                                COBOL33
         BGZ      NXTCK             START AT BEGINING OF 'TO' ITEMS     COBOL33
         B        MAINX             NORMAL LOOP                         COBOL33
NXTCK    RES      0                                                     COBOL33
         LW,R12   TC                                                    COBOL33
         CW,R12   FR                                                    COBOL33
         BE       S%LOOP            NO MORE TO ITEMS                    COBOL33
         AI,R12   2                 ADDR OF EOR                         COBOL33
         LI,R13   5                 BYTE ADDR INTO REG 1                COBOL33
         LI,BYTE  0                 CLEAR REG 1
         LI,R14   3                                                     COBOL33
         STB,R14  R13                                                   COBOL33
         MBS,R12  0                 EOR ADDR TO REG 1                   COBOL33
         AI,BYTE  9                                                     COBOL33
         LB,W3    0,BYTE            PICK UP CLASS OF NEXT TO            COBOL33
         AND,W3   LOW4              TEST IF GROUP                       COBOL33
         BEZ      S%LOOP            YES                                 COBOL33
         B        MAINX             NO                                  COBOL33
         PAGE
GRCHECK  AI,BYTE  3                 PICK UP
         AI,R4    3                    CLASS
         STW,W3   REFNO             SAVE REFNO FOR LATER TEST
         LB,W3    0,BYTE                FIELDS
         AND,W3   LOW4              TEST IF GROUP
         BNEZ     EXGEN             OK TO EXPLODE STATEMENT
GRCHECK2 LB,W3    0,R4              TEST IF
         AND,W3   LOW4                  BOTH GROUPS
         BNEZ     EXGEN             NO- OK TO EXPLODE STATEMENT
         LW,W3    FPTR              PUSH
         LW,W4    LPTR                  DOWN
         LW,W5    TPTR                  LIST
         LCI      3
         STM,W3   *STACKER
         MTW,3    STACKER           UPDATE POINTER
         LW,W2    STACKER                                               COBOL33
         CI,W2    STACKER            TEST FOR OVERFLOW                  COBOL33
         BL       %+3                NORMAL                             COBOL33
         LI,ERX33R 4                 ERROR NUMBER                       COBOL33
         B        ERX33                                                 COBOL33
         LW,W2    FC                END OF RANGE
         AI,W2    2                     CURRENT 'FROM'
         LI,W3    BA(FPTR)+1        TO REPLACE FPTR
         LI,W4    3                 COUNT FIELD
         STB,W4   W3
         MBS,W2   0                 MOVE EOR
         LW,W2    TC                END OF RANGE
         AI,W2    2                     CURRENT 'TO'
         LI,W3    BA(LPTR)+1        TO REPLACE LPTR
         STB,W4   W3                COUNT FIELD
         MBS,R12  0                 MOVE EOR
         LW,R4    TC                CURRENT 'TO'
         LB,R13   0,R4                  PLUS LENGTH OF SAME
         AW,W3    W3                    IN BYTES
         AW,R4    W3                    INTO
         STW,R4   TPTR                  TPTR
         LW,R4    FC                CURRENT 'FROM'
         LB,W3    0,R4                  PLUS LENGTH
         AW,W3    W3                    IN BYTES
         AW,R4    W3                    INTO
         STW,R4   FC                NEW CURRENT 'FROM'
         B        MAINX             LOOP
         PAGE
EXGEN    LW,W3    STATYP            CHECK FOR
         AND,W3   LOW7                  MOVE
         CI,W3    X'76'                 CORRESPOINDING
         BNE      CLCHECK           NO. ADD OR SUBTRACT-CHECK CLASSES
EXOK     EQU      %
         LI,W3    X'FFFF'           ARE THESE FILLER
         CW,W3    REFNO              DATA ITEMS?
         BE       NESTF              YES - IGNORE THEM
         STW,UP1  ANYEQ             TURN ON FLAG
         LI,W3    X'9000'           OPERAND AND STATEMENT OPTIONS BYTES
         LW,CURR  FC                SOURCE ITEM
         BAL,LINK ECFCONST          CONSTRUCT ECF CLUSTER
         LI,W3    X'9081'           CONSTRUCT
         LW,CURR  TC                    ECF CLUSTER
         BAL,LINK ECFCONST          FORM REST OF CLUSTER
         B        NESTF             PICK UP NEXT ENTRIES
         PAGE
ECFCONST STW,LINK NESTRET1          SAVE RETURN
         LW,CBYT  STATYP            CONTROL BYTE
         AI,CBYT  -4                DETERMINE
         AND,CBYT LOW4              WHICH 'CORRESPONDING'
         LB,CBYT  MOVEC,CBYT
         STW,W3   ECFBUILD          SET CONTROL BYTE
         LI,R3    BA(ECFBUILD)+1    ADDRESS OF ECF CONTROL BYTE
         AND,W3   UP1               IS THIS 'FROM' OR 'TO'
         BNEZ     %+2               TO
         OR,CBYT  L(X'80')          FROM. TURN ON FIRST CLUSTER BIT
         STB,CBYT 0,R3              CONTROL BYTE TO ECF CLUSTER
         AI,R3    3
         LB,W3    0,CURR            LENGTH OF CURRENT CLUSTER
         AW,W3    R13                   IN BYTES
         AI,W3    -8
         STB,W3   R3                INTO COUNT FIELD
         AI,CURR  7                 SOURCE ADDRESS
         MBS,CURR 0                 MOVE CSF INFORMATION TO ECF
         LH,R4    ECFBUILD+1
         BEZ      %+2
         MTH,-4   ECFBUILD+1        UPDATE DISP OF VAR REC
         AI,R3    2-BA(ECFBUILD)    CLUSTER LENGTH IN BYTES
         LI,OUT   BA(ECFBUILD)         CLUSTER
         SLS,R3   -1                DIVIDE BY 2
         STB,R3   0,OUT             LENGTH INTO LEADING BYTE
         BAL,LINK WRECF             WRITE ON ECF
         B        *NESTRET1         RETURN
MOVEC    DATA     X'516A5E00'       CONTROL BYTE
         PAGE
CLCHECK  RES      0
         LW,BYTE  FC                PICK UP
         AI,BYTE  9                   CLASS
         LB,W3    0,BYTE                FROM
         AND,W3   LOW4                  FIRST ITEM
         CI,W3    6                 IS IT NUMERIC
         BL       NESTF             NO.
         LW,BYTE  TC                PICK UP
         AI,BYTE  9
         LB,W3    0,BYTE                FROM
         AND,W3   LOW4                  SECOND ITEM
         CI,W3    6                 IS IT NUMERIC
         BL       NESTF             NO
         B        EXOK              BUILD ECF CLUSTERS
         PAGE
*        AT THIS POINT A SPECIAL CLUSTER MUST BE OUTPUT TO FLAG
*        PHASE 4 THAT THE END OF A CORRESPONDING STATEMENT HAS BEEN
*        ENCOUNTERED, SO THAT THE NEXT INPUT CLUSTER CAN BE READ
*        FROM THE CRF. A STATEMENT OPTIONS BYTE OF ZERO INDICATES
*        THAT NO CORRESPONDING ITEMS WERE FOUND IN THE GROUPS
ENDEX    RES      0
         LI,BYTE  BA(ENDALL)+1
         LW,CBYT  STATYP
         STB,CBYT 0,BYTE
         AI,BYTE  2
         LW,W3    ANYEQ
         BEZ      NONEQ
ENDSTOP  STB,W3   0,BYTE
         LI,W3    0
         STW,W3   ANYEQ
         LI,R4    BA(ENDALL)
         BAL,R11  WRECF
         B        *NESTRET2         RETURN FROM EXPLODE
NONEQ    STW,R1   SAVER1
         LI,R1    X'72'
         BAL,R11  DIAG
         LW,R1    SAVER1
         B        ENDSTOP
         PAGE                                                           COBOL33
*        FOLLOWING ROUTINE IS ENTERED ONLY WHEN A SPACE OVERFLOW        COBOL33
*        CONDITION OR OTHER ERROR OCCURS, WHICH FORMERLY CAUSED         COBOL33
*        A COMPILER TRAP.                                               COBOL33
*        THE TYPE OF ERROR CAN BE DETECTED BY SNAPPING AT EXTERNAL      COBOL33
*        NAME ERX33.  REGISTER 0 WILL CONTAIN A NUMBER                  COBOL33
*                                                                       COBOL33
*        1 MEANS FROM SUBORDINATE COULD NOT BE STORED                   COBOL33
*        2 MEANS TO SUBORDINATE COULD NOT BE STORED                     COBOL33
*        3 MEANS EXPLODE PASSED BEYOND THE END OF THE WORK AREA         COBOL33
*        4 MEANS THAT THE SIZE OF ASTACK WAS EXCEEDED                   COBOL33
*                                                                       COBOL33
ERX33    B        ENDEX                                                 COBOL33
         PAGE
*        ADDRESS CONSTANTS- POINTERS,ETC.
HOC      GEN,32   BA(HADDR)         HIGHSET LOC AVAILABLE FOR GROUPS
LOC      GEN,32   BA(LADDR)         LOWEST ADD AVAILABLE FOR GROUPS
FG       DATA     0                 POINTS TO FROM GROUP LOCATION
TG       DATA     0                 POINTS TO 'TO' GROUP LOCATION
FS       DATA     0                 FROM SUBORDINATE
TS       DATA     0                 TO SUBORDINATE
LEVER    DATA     LTAB+1
LTABX    DATA     LTAB
LTAB     DATA     0
         DATA     0
         DATA     0
         DATA     0
         DATA     0
         DATA     0
         RES      43
         BOUND    8
FC       DATA     0                 CURRENT 'FROM' ITEM          I
FPTR     DATA     0                 NESTED CURRENT 'FROM' ITEM   K
TC       DATA     0                 CURRENT 'TO' ITEM            J
TPTR     DATA     0                 NESTED CURRENT 'TO' ITEM     M
SEQFLG   DATA     0                 SEQ/NON-SEQ FLAG                    COBOL33
TND      DATA     0                 END OF 'TO' ITEMS            KL
LPTR     DATA     FR                                             L
FR       DATA     0
TO       DATA     0
STATYP   DATA     0
MULTOP   DATA     0
SAVER1   DATA     0
STOP1    DATA     0
TYPE8    DATA,2   0
PASS8    DATA,2   0
REFNO    DATA     0                 SAVE FIELD FOR REFERENCE NUMBER
DEST     GEN,8,24 4,BA(CARDNO)
ECFBUILD RES      100               ECF BUFFER
ASTACK   RES      147               PUSH DOWN LIST STACK
STACKER  DATA     ASTACK            INDEX TO LIST
ANYEQ    DATA     0
ENDALL   DATA     X'03000000'
         DATA     X'FF030000'
LOW4     DATA     X'0000000F'
LOW7     DATA     X'0000007F'
LOW24    DATA     X'00FFFFFF'
NESTRET1 DATA     0
NESTRET2 DATA     0
LADDR    RES      4096
HADDR    DATA     0
         END      START
