         SYSTEM   SIG7FDP
         TITLE    'PHASE 3.4 - REPORT GENERATOR'
*        REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
W8       EQU      8
W9       EQU      9
W10      EQU      10
W11      EQU      11
W12      EQU      12
W13      EQU      13
W14      EQU      14
W15      EQU      15
*
         REF      PDBMSL
         REF      PDBX,PDBZ,PDBK
         REF      RDCRF,RDDDD
         REF      WRRGF,DIAG
         REF      SUMS,ADDS,GNRTBL,GRPIND
         REF      CLUSTR
         REF      PH34E
*
         DEF      COB34
         DEF      RDI
         DEF      PRDE,P01DE,P01GRV
         DEF      PRADD,PR01,PC01
         DEF      PRSUM,PNEXT
         DEF      DBLIN                                                 COBOL34
*
         TITLE    'PHASE 3.4 - REPORT GENERATOR - COLLECT INPUT'
***********************************************************************
*                                                                     *
* COLLECT INPUT ROUTINE                                               *
*                                                                     *
* PROCESSES REPORT ITEM CLUSTERS (CONTROL BYTE=78) FROM THE           *
* CRF FILE, BUILDS THE CFM TABLE AND REPORT GROUP DESCRIPTOR          *
* TABLES FOR EACH REPORT, AND OUTPUTS CLUSTERS ONTO THE RGF           *
* FILE TO PRODUCE CODE FOR CONTROL FIELD COMPARES AND MOVES.          *
* IT ALSO OUTPUTS CLUSTERS TO PRODUCE THE 'NORMAL' MOVES OF           *
* SOURCE OR SUM ITEMS ONTO THE REPORT LINE IMAGES DESCRIBED IN        *
* THE DDD FILE.                                                       *
*                                                                     *
* EXTERNAL ROUTINES CALLED VIA BAL,W11 LINKAGE                        *
*        GRPIND,SUMS,ADDS,GNRTBL                                      *
*                                                                     *
* INTERNAL SUBROUTINES CALLED VIA BAL,W14 LINKAGE                     *
*        MOVCOM,MATCH                                                 *
*                                                                     *
* ENTRY POINT                                                         *
*        COB34                                                        *
*                                                                     *
***********************************************************************
*
*        PHASE 3.4 INITIAL ENTRY POINT
COB34    RES      0
         LW,R4    PDBZ              AVAILABLE LOW MEMORY ADDRESS
         LW,R5    R4
         AW,R5    PDBMSL
         AW,R5    PDBMSL            ALLOW FOR MAX OF TWO DDD ITEMS
         STW,R5   CFA               WA(CFA TABLE START)
         STW,R5   LOWLIM            SET CURRENT LOW CORE LIMIT FOR CFM
         SLS,R4   2
         STW,R4   DDBUF             BA(DDD BUFFER START)
         LW,R4    PDBZ+2            AVAILABLE MEMORY TOP
         SLS,R4   -2
         STW,R4   CFM               WA(CFM TABLE START)
         STW,R4   CFMREP            SAVE START OF CFM TABLE
         LI,R5    -3
         STW,R4   *CFMREP,R5
         LW,R5    PDBMSL            WORD SIZE OF LARGEST DDD            COBOL34
         SLS,R5   2                 GET BYTE SIZE                       COBOL34
         STW,R5   DDDSIZ            SAVE                                COBOL34
         LI,W8    0
         LI,R2    -2
         STW,W8   *CFMREP,R2
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD             INITIALIZE DDD
         BCS,1    CI730             UNEXPECTED EOF
*        COLLECT INPUT
CI010    RES      0
         BAL,W11  RDCRF             READ CRF CLUSTER
         BCS,1    CI720             UNEXPECTED EOF
CI012    LB,W8    0,R2              GET CLUSTER LENGTH
         AW,W8    W8
         LI,R3    BA(CLUBUF)        DEST ADDR OF RU1
         STB,W8   R3                LENGTH TO RU1
         MBS,R2   0                 MOVE CLUSTER TO BUFFER
         BAL,W11  RDCRF             READ AHEAD
         BCS,1    CI720             UNEXPECTED EOF
         STW,R2   CLUPTR            SAVE ADDR OF NXT CLUSTER
*
*        TEST CLUSTER TYPE
         LI,W8    X'0F8'
         LI,R3    1
         CB,W8    CLUBUF,R3         IS THIS REPORT NAME CLU
         BNE      CI020             BR IF NO
         LH,R5    PDBX              PICK UP CURRENT LINE NUMBER         COBOL34
         STW,R5   DBLIN             SAVE FOR DEBUG MODULE CODE          COBOL34
         LI,R5    -3
         LW,R4    *CFMREP,R5        PICK UP U(CFMREP)
         STW,R4   CFMREP            CFM POINTER FOR NEW REPORT
         AI,R4    -1
         LW,R5    R4                R5=WA(CFMPRE+2)
         AI,R4    -2                R4=WA(CFMREP)
         LI,W9    0
         STW,W9   RDI+5             ZERO OUT RDI FIELDS
         STW,W9   RDI+6             WHICH MAY NOT RECEIVE VALUES
         STW,R4   CFMDAT            SET POINTERS FOR DATA AND
         STW,R4   CFMGR             GROUP ENTRIES
         LI,W8    X'04'
         STW,W8   *R5               SET T=04
         LB,W8    CLUBUF+1          GET RDB NO. FROM CLU
         STH,W8   RDI+3,R3          SAVE RDB NO. IN RDI
         AI,R4    1
         STW,W8   0,R4
         AI,W8    10                GET BASE NO.(L2)
         STB,W8   *R4
         LW,W8    CFA
         STW,W8   CFAGR             INITIALIZE CFA TABLE POINTERS
         SLS,W8   1
         STW,W8   CFADAT
         LW,R7    PDBZ+4            GET DBINOEX ADDR
         SLS,R7   8
         SLS,R7   -8
         LH,R2    *R4,R3            GET BLK NO.
         LH,R2    *R7,R2
         AW,R2    PDBZ+3            R2=BA(RDB)
         SLS,R2   -2                R2=WA(RDB)
         STW,R2   RDI+7             SAVE RDB ADDR
CI018    LW,R2    CLUPTR
         B        CI012             TO READ NEXT CLUSTER
*
CI020    RES      0
         LI,W8    X'78'
         CB,W8    CLUBUF,R3
         BNE      CI030             BR IF NO
         LH,R2  CLUBUF,R3
         AND,R2   MFF
         CI,R2    X'1A'
         BG       CI026             BR IF INVALID CLUSTER
         CI,R2    5
         BLE      CI022-1           PROCESS RD
         MTW,0    PR01              HAVE WE PROCESSED AN RD?
         BNEZ     CI022-1           BR IF YES
         LI,R1    124               INVALID REPORT REFERENCE SEQUENCE
         B        CI026+1           REPORT REFERENCE IGNORED
         B        CI022,R2
*        BRANCH ON VALUE OF H FIELD
CI022    EQU      %
         B        CI026             H=00,B=78, NO ENTRY
         B        CI026             H=01, NO ENTRY
         B        CI120             H=02
         B        CI130             H=03
         B        CI160             H=04
         B        CI170             H=05
         B        CI190             H=06
         B        CI250             H=07
         B        CI210             H=08
         B        CI250             H=09
         B        CI210             H=0A
         B        CI250             H=0B
         B        CI210             H=0C
         B        CI250             H=0D
         B        CI210             H=0E
         B        CI250             H=0F
         B        CI300             H=10
         B        CI310             H=11
         B        CI320             H=12
         B        CI330             H=13
         B        CI340             H=14
         B        CI350             H=15
         B        CI360             H=16
         B        CI400             H=17
         B        CI018             H=18, NO ENTRY
         B        CI370             H=19
         B        CI370             H=1A
*
CI026    LI,R1    99                LOAD DIAGNOSTIC NUMBER
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI018             READ NEXT CLUSTER
CI030    RES      0
         LI,W8    X'0F3'
         CB,W8    CLUBUF,R3         ANY MORE REPORTS
         BNE      CI040             BR IF NO
CI032    RES      0
*        EXIT PHASE 3.4
         B        PH34E
CI040    RES      0
         LI,W8    0
         CB,W8    CLUBUF,R3         TEST FOR LINE NO CLU
         BNE      CI050
         LH,W8    CLUBUF,R3
         STH,W8   PDBX              UPDATE SOURCE LINE NO.
         LH,W8    CLUBUF+1
         STH,W8   PDBX,R3           UPDATE SOURCE LINE SUB-NUMBER
         LI,R4    BA(CLUBUF)
         BAL,W11  WRRGF             COPY LINE NUMBER CLUSTER
         B        CI018
*
CI050    RES      0
         LI,W8    X'77'
         CB,W8    CLUBUF,R3
         BNE      CI070
         LI,W8    0                 INITIALIZE COUNT OF
         STW,W8   SSN               SOURCE-SELECTED ITEMS
         LI,R1    1
         LW,R7    CFA
         SLS,R7   1                 GET HA
         LW,R2    CLUPTR
CI052    SLS,R2   -1
         LH,W9    0,R2
         CI,W9    2
         BAZ      CI059             BR IF END OF SOURCE-SEL
         SLS,W9   -8
CI054    LH,W8    0,R2              MOVE SS CLUSTERS TO CFA
         STH,W8   0,R7
         AI,R2    1
         AI,R7    1
         BDR,W9   CI054
         AWM,R1   SSN               COUNT SS ITEMS
CI058    BAL,W11  RDCRF
         BCS,1    CI720             UNEXPECTED EOF
         B        CI052             GET NEXT SS ITEM
CI059    AI,R7    1
         SLS,R7   -1                ROUND UP TO WA
         STW,R7   LOWLIM            SET LOWER CORE LIMIT
         CW,R7    PNEXT
         BGE      CI750             OVERFLOW
         B        CI010             CONTINUE
*
CI070    RES      0                 PROCESS DECLARATIVES
         LI,W8    X'0F2'
         CB,W8    CLUBUF,R3
         BNE      CI018             SKIP UNDEFINED CLUSTER
         LI,R4    0
         LI,R3    -3
         STW,R4   *CFMREP,R3        ZERO OUT U(CFMREP)
         LI,R4    BA(CLUBUF)
         LW,W9    CLUBUF
         CI,W9    X'FF'
         BANZ     CI073
CI072    BAL,W11  WRRGF
         B        PH34E             EXIT FROM PHASE 3.4
CI073    BAL,W11  WRRGF             WRITE 1ST CLUSTER
         LW,R2    CLUPTR            NEXT CLUSTER ALREADY READ
         B        CI076
CI074    BAL,W11  WRRGF
         BAL,W11  RDCRF
         BCS,1    CI710             UNEXPECTED EOF
CI076    LW,R4    R2
         AI,R2    1
         CB,W8    0,R2              END OF DECLARATIVES
         BE       CI072             BR IF YES
         LB,W10   0,R2              GET CONTROL BYTE                    COBOL34
         CI,W10   X'6C'             USE SECTION ?                       COBOL34
         BE       CI078             JUMP IF YES                         COBOL34
         CI,W10   0                 IS SOURCE LINE CLUSTER ?            COBOL34
         BNE      CI074             BRANCH IN NO                        COBOL34
         AI,R2    3                                                     COBOL34
         SLS,R2   -1                GET HALF WORD ADDR                  COBOL34
         LH,W10   0,R2                                                  COBOL34
         STW,W10  PDBX              UPDATE SOURCE LINE SUB-NUMBER       COBOL34
         AI,R2    -1                                                    COBOL34
         LH,W10   0,R2              GET SOURCE LINE                     COBOL34
         STH,W10  PDBX              UPDATE SOURCE LINE #                COBOL34
         B        CI074             BR FOR NEXT CLUSTER                 COBOL34
CI078    AI,R2    11
         LW,R3    R2                                                    COBOL34
         AI,R3    -9                GET OPTION BYTE OF CLUSTER          COBOL34
         LB,W9    0,R3              GET STATEMENT OPTION                COBOL34
         AND,W9   =X'F0'                                                COBOL34
         CI,W9    X'80'             IS FOR USE BEFORE REPORTING ?       COBOL34
         BNE      CI0780            JUMP IF NO                          COBOL34
         AI,R3    -1                                                    COBOL34
         LB,W9    0,R3                                                  COBOL34
         CI,W9    X'80'             IS AN UNDEFFINE REP GRP NAME ?      COBOL34
         BNE      CI0780            JUMP IF NO                          COBOL34
         LI,R1    191               ISSUE 'UNDEFINE  DATA NAME' DIAG    COBOL34
         BAL,W11  DIAG                                                  COBOL34
CI0780   LW,W9    CFM                                                   COBOL34
         STW,W9   CFMREP            POINT TO FIRST REPORT
CI079    LI,R3    -5
         LB,W9    *CFMREP,R3
         BEZ      CI074             SKIP USE CLUSTER
         CB,W9    0,R2
         BE       CI080             BR IF CORRECT REPORT
         LI,R3    -3
         LW,W9    *CFMREP,R3
         BEZ      CI074             IGNORE THIS USE STATEMENT
         STW,W9   CFMREP            POINT AT CFM FOR NEXT REPORT
         B        CI079             TRY NEXT REPORT
CI080    LW,W9    CFMREP
         AI,W9    -3
         STW,W9   CFMGR             POINT TO 1ST GROUP ENTRY
         LI,R3    -5
         LB,W9    *CFMGR,R3
         BEZ      CI074             NO GROUPS TO CHECK
         AI,R2    5                 POINT AT GROUP NUMBER
CI081    LI,R3    -2
         LB,W9    *CFMGR,R3
         CB,W9    0,R2
         BE       CI074             BR IF GROUP IS A CF                 COBOL34
         LI,R3    -3
         LW,W9  *CFMGR,R3                                               COBOL34
         BEZ      CI074             NO MORE GROUPS
         STW,W9   CFMGR             POINT AT NEXT GROUP
         B        CI081
CI090    BAL,W11  WRRGF
         BAL,W11  RDCRF
         BCS,1    CI710             UNEXPECTED EOF
         LW,R4    R2
         AI,R2    1
         LI,W8    X'F2'
         CB,W8    0,R2
         BE       CI072             BR IF END OF DECLARATIVES
         LI,W10   X'6C'
         CB,W10   0,R2
         BE       CI078             BR IF USE SECTION
         LI,W9    0
         CB,W9    0,R2
         BE       CI090             BR IF LINE CLUSTER
         AI,R2    1
         LI,W9    X'90'
         CB,W9    0,R2
         BNE      CI090             BR IF NOT A DATA NAME CLUSTER
         AI,R2    -2
         LW,R3    CFA
         SLS,R3   2                 GET BA
         LW,W15   R3
         LB,W9    0,R2
         SLS,W9   1
         STB,W9   R3                SET LENGTH OF MOVE
         MBS,R2   0                 MOVE TO CFA
         AW,W15   W9                POINT TO END OF SAVED CLUSTER
         LW,W9    PNEXT
         AI,W9    -1
         STW,W9   PCURNT            DESCRIPTOR AREA
         LI,R2    4
         BAL,W14  CI244
         LW,R6    PNEXT
         AW,R6    R6
         AI,R6    -1
         LB,W9    0,R4
         LW,R1    W9
         AI,W9    X'BFD'
         STH,W9   0,R6              SET SIZE AND TYPE OF TRAILER
         AI,R6    -1
         LW,R2    R4
         SLS,R2   -1
         AI,R2    3
         AI,R1    -4
         BAL,W14  CI110             COPY CLUSTER INFO TO TRAILER
         LI,R3    -4
         LI,W8    X'10'
         STB,W8   *PCURNT,R3        NO. OF TRAILERS
         LI,W9    X'60'
         AND,W9   *CFA
         BEZ      CI094             BR IF NO SUBSCRIPTS
         SLS,W9   -5
CI092    BAL,W11  RDCRF             READ SUBSCRIPT CLUSTER
         BCS,1    CI710             UNEXPECTED EOF
         LW,R4    R2
         AI,R2    1
         LI,W8    0
         CB,W8    0,R2
         BE       CI092             SKIP LINE CLUSTER
         LW,R2    R4
         LB,R1    0,R2              LENGTH IN HALF-WORDS
         LW,R5    W15
         LW,W8    R1
         SLS,W8   1
         AW,W15   W8                UPDATE CFA POINTER
         STB,W8   R5
         MBS,R4   0                 MOVE CLUSTER TO CFA
         AI,R2    2
         LI,W8    X'D0'
         CB,W8    0,R2
         BG       CI093             BR IF NOT INTEGER SUBSCRIPT
         LB,W8    0,R2
         AND,W8   M5                TRAILER TYPE
         SLS,W8   8
         AI,R1    -2                TRIALER SIZE
         AI,R2    2
         B        CI093A
CI093    LI,W8    X'0E00'           TRAILER TYPE
         AI,R1    -3
         AI,R2    4
CI093A   OR,W8    R1
         CI,R1    1                 VALID TRAILER
         BG       CI093B            BR IF OK
         LI,W8    2                 SET LENGTH FOR UNDEFINED TRALER
CI093B   STH,W8   0,R6               SET SIZE AND TYPE OF TRAILER
         AI,R1    -1                R1 HAS HALF WORD MOVE COUNT
         AI,R6    -1                TO ADDRESS
         SLS,R2   -1
         BAL,W14  CI110             COPY CLUSTER INFO TO TRAILER
         LI,R3    -4
         LB,W8    *PCURNT,R3
         AI,W8    X'11'
         STB,W8   *PCURNT,R3        INCREMENT TRAILER/SUBSCRIPT COUNTS
         BDR,W9   CI092             LOOP FOR SUBSCRIPTS
CI094    LW,W8    PCURNT
         AW,W8    W8
         STW,W8   CGR               SET FOR MATCH ROUTINE
         LI,R3    -13
         LB,W8    *PCURNT,R3
         CI,W8    3                 MINIMUM LENGTH FOR MATCH
         BGE      CI096             BR IF OK
         LI,W8    0
         STB,W8   CNLVL             SET FOR NO MATCH
         B        CI100
CI096    BAL,W14  MATCH
         MTB,0    CNLVL             MATCH?
         BEZ      CI100             BR IF NO
         LI,W8    X'9F'
         AND,W8   *CFA
         LI,R2    3
         STB,W8   *CFA,R2
CI100    LI,R3    -4
         LB,W8    *PCURNT,R3
         AND,W8   M5
         STW,W8   SUBS              SAVE NO. OF SUBSCRIPTS
         LB,W14   *CFA
         LW,W8    CFA
         SLS,W8   1                 GET HA
         AW,W8    W14
         STW,W8   CFADAT            LOCATION OF 1ST SUBSCRIPT
         BAL,W14  CI278
         LW,W15   *CFA
         LH,R4    *CFA
         AND,R4   L(X'0000FFFF')
         LW,R6    PCURNT
         AW,R6    R6
         AI,R6    -7                POINT TO 1ST TRAILER
CI104    LI,R7    HA(WKBUF)
         BAL,W11  CLUSTR            COMPOSE CLUSTER
         LI,R4    BA(WKBUF)
         BAL,W11  WRRGF             WRITE CLUSTER
         LW,W8    SUBS
         BLEZ     CI108             CONTINUE PROCESSING DECLARATIVES
         AI,W8    -1                PROCESS SUBSCRIPT CLUSTERS
         STW,W8   SUBS
         AI,R6    -1                SUBSCRIPT TRAILER
         LW,R3    CFADAT            SAVED SUBSCRIPT CLUSTER
         LH,W9    0,R3
         LW,R4    W9
         SLS,W9   -8
         AWM,W9   CFADAT            POINT TO NEXT CLUSTER
         AI,R3    1
         LH,W15   0,R3
         B        CI104             TO WRITE SUBSCRIPT CLUSTER
CI108    LW,W8    PCURNT
         AI,W8    1
         STW,W8   PNEXT
         B        CI090+1
CI110    RES      0                 COPY CLUSTER INFO TO TRAILER
         LH,W8    0,R2              COPY BY HALF WORD
         STH,W8   0,R6              IN BACKWARDS DIRECTION
         AI,R2    1
         AI,R6    -1
         BDR,R1   CI110
         B        *W14              RETURN
*
CI120    RES      0
         LW,W8    CLUBUF
         CI,W8    X'07000'          IS MNEMONIC CODE UNDEFINED
         BANZ     CI122             BR IF NO
         LI,R1    95                UNDEFINED DATA REFERENCE
         B        CI026+1
CI122    LW,W8    CLUBUF+1
         AND,W8   MFF               GET MNEMONIC CODE
         STH,W8   RDI+6             SAVE IN RDI
         B        CI018
*
CI130    RES      0
         LW,W8    CLUBUF
         CI,W8    X'07000'          IS IT DEFINED?
         BANZ     CI131             BR IF YES
         MTW,1    UNDFCF            ADD 1 TO NO. OF CF  EL34373         COBOL34
         LI,R1    286               UNDEFINED CONTROL FIELD     EL34474 COBOL34
         BAL,W11  DIAG
         B        CI018             GET NEXT CLUSTER    EL34373         COBOL34
CI131    CI,W8    X'200'            CHECK FOR SUBSCRIPT
         BANZ     CI140             F2=2, SUBSCRIPT
*
         LW,R7    CFADAT
         AI,R7    1
         SLS,R7   -1
         STS,R7   *CFAGR            CFADAT TO U(CFAGR)
         STW,R7   CFAGR
         LI,W8    X'0800'
         SLS,W8   16                SET T=08
         STW,W8   0,R7              ZERO OUT U(CFAGR)
         AI,R7    2                 STEP OVER U AND V
         SLS,R7   1                 GET HA
         STW,R7   CFADAT            POINT AT DATA ENTRY
*
         LW,R6    CFMDAT            CFM R6=WA(CFMDAT)
         LW,R7    CFMGR             R7=WA(CFMGR)
         AI,R7    -3
         STW,R6   *R7               CFMDAT TO U(CFMGR)
         STW,R6   CFMGR             CFMDAT TO CFMGR
         AI,R6    -1
         LI,W8    X'08'
         STW,W8   0,R6              SET T=08,U(CFMGR)=0
         LI,W8    0
         AI,R6    -2
         STW,W8   0,R6
         STW,R6   CFMDAT            POINT AT NEXT ENTRY
         AI,R6    3
         LW,R7    CFAGR
         AI,R7    1
         STW,R6   0,R7
         LW,R2    RDI+7             GET WA(RDB)
         AI,R2    2
         LH,W8    *R2,R3            END OF RPORT DATA AREA
         AND,W8   L(X'0000FFFF')
         AI,R6    -2
         STH,W8   *R6,R3            SAVE IN M2(CFMGR)
         LH,W9    CLUBUF+3,R3       GET SIZE
         AW,W8    W9                INC DATA AREA BY SIZE OF ITEM
         STH,W8   *R2,R3            SAVE BAKC IN H(RDB)
         LI,W8    X'01'
         STH,W8   *R6               5(CFMGR)=0, W(CFMGR)=1
         LI,W8    X'10000'
         LI,R4    -2
         AWM,W8   *CFMREP,R4        INCREMENT W2(CFMREP) BY 1
         AI,R6    -2
         LI,W8    X'0C'
         STH,W8   *R6,R3            SET T=0C
CI134    RES      0
         LW,R3    CFADAT
         LB,W8    CLUBUF
         AW,W8    W8                LENGTH IN BYTES
         AW,R3    R3                BA
         STB,W8   R3                LENGTH AND DEST ADDR TO R3
         LI,R2    BA(CLUBUF)
         MBS,R2   0                 MOVE CLUSTER TO CFA
         SLS,W8   -1
         LW,R3    CFADAT
         AW,R3    W8                INC CFADAT BY NO. OF HALFWORDS
         STW,R3   CFADAT            IN CLUSTER
         LW,R6    CFMDAT
         AI,R6    -1
         LW,R7    R6
         AI,R6    -1
*                                   R6=WA(CFMDAT)
*                                   R7=WA(CFMDAT+1)
         LI,R3    1
         LH,W8    CLUBUF+3,R3       GET SIZE
         STH,W8   *R7
         LI,W8    X'03'             TEST IF SUBSCRIPT INTEGER
         LI,R2    3
         CB,W8    *R7,R2
         BCS,1    CI136             BR IF T>03
         LW,W8    CLUBUF+1          PICK UP INTEGER
         STW,W8   *R6               STORE IN DATA ENTRY
         B        CI138
CI136    LH,W8    CLUBUF+2,R3       GET DISP
         STW,W8   *R6
         LH,W8    CLUBUF+1,R3       GET CLASS
         AND,W8   M2
         SLS,W8   -8
         LB,W9    CLUBUF+2          GET BASE
         SLS,W9   8
         OR,W8    W9
         STH,W8   *R6               SET BASE AND CLASS
CI138    STW,R6   CFMDAT            POINT AT NXT ENTRY
         B        CI018             GET NEXT CLUSTER
*
CI140    RES      0
         LW,R6    CFMDAT
         AI,R6    -1
         LI,W8    X'0E'
         STH,W8   *R6,R3            SET T=0E
CI150    LW,R6    CFMGR
         AI,R6    -2
         LH,W8    *R6
         AND,W8   L(X'0000FFFF')
         AI,W8    X'0101'           INC S(CFMGR) AND W(CRMGR)
         STH,W8   *R6
         B        CI134
*
CI160    RES      0
         LW,R6    CFMDAT
         AI,R6    -1
         LH,W8    CLUBUF,R3
         AND,W8   M2
         SLS,W8   -8
         STH,W8   *R6,R3            SET T=01,02,03
         B        CI150
*
CI170    RES      0                 END OF RD
         LI,R3    BA(RDI)           DEST ADDR
         LI,W8    14
         STB,W8   R3                LENGTH IN BYTES
         LI,R2    BA(CLUBUF+1)
         MBS,R2   0                 MOVE INFO TO RDI
         LH,W8    RDI+3             LEVEL TEST
         CI,W8    X'0901'           TEST FOR MAX OF NINE CTL LEVELS
         BGE      CI740             ERROR
         MTW,0    UNDFCF            ANY UNDEF CONTROL FIELD ?  EL34373  COBOL34
         BEZ      MOVCOM            NO, JUMP TO GEN CB CHK RTN  EL34474 COBOL34
         SLS,W8   -8                SET # OF CF WITHOUT FINAL   EL34474 COBOL34
         SW,W8    UNDFCF            W8 = # OF DEF CF    EL34373         COBOL34
         STB,W8   RDI+3             STORE # OF DEF CF   EL34373         COBOL34
         LI,W8    0                                     EL34774         COBOL34
         STW,W8   UNDFCF            RESET TO ZERO       EL34774         COBOL34
         B        MOVCOM            GEN CONTROL BREAK CHK RTN   EL34474 COBOL34
CI171    LW,W8    PDBX              RETURN FROM CB CHK RTN GEN  EL34474 COBOL34
         STW,W8   RDI+8             SAVE LINE NUMBER FOR DIAGNOSTICS
         LW,W9    RDI+7             GET WA(RDB)
         AI,W9    1
         LH,W9    *W9               GET BEGINNING OF RANGE
         AND,W9   L(X'0000FFFF')
CI174    LW,R2    DDBUF
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD             READ DDD SEGMENT
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD             READ CTL SEGMENT
         BCS,1    CI730             UNEXPECTED EOF
         LW,W12   DDSEG
         SLS,W12  -14
         CW,W9    W12
         BG       CI174             SIDR 4845                           COBOL34
         BE       %+4               FIND RIGHT SEGMENT                  COBOL34
         LI,R1    214               DUPLICATE RD                        COBOL34
         BAL,W11  DIAG              FATAL DIAGNOSTIC                    COBOL34
         B        PH34E             EXIT COBOL34                        COBOL34
         LW,R3    DDBUF
         SLS,R3   -2                GET WA
         LW,W8    4,R3
         STW,W8   RDI+4             SAVE BASE+DISP OF LINE CTR
         LW,R2    DDBUF
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD
         BCS,1    CI730             UNEXPECTED EOF
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD             GET PAGE CTR ITEM
         LW,R3    CFMDAT
         STW,R3   PNEXT             NEXT AVAILABLE STORAGE
         AI,R3    -1
         STW,R3   PR01              SAVE ADDR  OF 1ST 01
         B        CI176
***      RETURN HERE FROM END OF ITEM PROCESSING IF NEXT ITEM IS AN 01
CI175    LW,R3    PNEXT             ENTER HERE IF NXT ITEM IS 01
         AI,R3    -1
         STS,R3   *PC01             LINK LAST 01 TO NEW ONE
CI176    STW,R3   PC01              POINT AT NEW 01
         LI,R2    9
         BAL,W14  CI244             CLEAR 01 AREA
         LW,R2    DDBUF
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD             GET DDD 01 ITME
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD
         BCS,1    CI730             UNEXPECTED EOF
         LW,R6    PDBZ
         STW,R6   PDDD              ADDRESS OF DDD ITEM
         AI,R6    4
         LW,W10   *R6
         SLS,W10  8
         SLS,W10  -8
         LI,W8    134               GET SIZE OF LINE IMAGE
         SLS,W8   24
         OR,W10   W8                SIZE AND OFFSET IN W10
         AI,R6    2
         LI,R1    1
         LB,W8    *R6,R1            GET REPORT GROUP NO.
         LW,W9    PC01
         AI,W9    -2
         STB,W8   *W9
         AI,W9    -4
         CI,W8    X'080'
         BANZ     CI182             TYPE NOT DE
         LI,W8    8
         STB,W8   *W9,R1            SET TYPE TO DE
CI182    LI,W8    1                 NO   OF LINE IMAGES
         STB,W8   *W9
         AI,W9    -1
         STW,W10  *W9               PUT SIZE +OFFSET IN 01
         B        CI018             GET NEXT CLUSTER
*
CI190    RES      0                 H=06, ADDEND
         LW,W8    CLUBUF
         CI,W8    X'0200'
         BANZ     CI250             BR IF F2=2
         STB,W8   HVAL
         MTW,0    PCSUM
         BNEZ     CI193
         LW,W8    PNEXT
         AI,W8    -1
         STW,W8   PCSUM             POINT AT CURRENT SUM
         LI,R2    8
         BAL,W14  CI244             CLEAR SUM AREA
CI193    LW,W10   PCADD
         LW,W8    PNEXT
         AI,W8    -1
         MTW,0    PSADD
         BNEZ     CI194
         STW,W8   PSADD             1ST ADDEND FOR CURRENT ITEM
CI194    MTW,0    PRADD
         BNEZ     CI195
         STW,W8   PRADD             1ST ADDEND FOD REPORT
CI195    STW,W8   PCADD             POINT TO CURRENT ADDEND
         STW,W8   PCURNT
         LI,R3    3
         LW,W9    *PDDD,R3          GET CLASS FROM PRINT IMAGE
         AND,W9   M2
         SLS,W9   -7
         STS,W9   *PCURNT           SET CLASS IN DESCRIPTOR
         LI,R2    4
         BAL,W14  CI244             CLEAR ADDEND AREA
         LW,W9    PCADD
         MTW,0    W10
         BEZ      CI196
         STS,W9   *W10              LINK LAST ADDEND TO NEW ONE
CI196    LW,R7    PCSUM
         AI,W9    -1
         STS,R7   *W9               LINK TO SUM ITEM
         AI,W9    -2
         LW,W8    PDBX
         STW,W8   *W9               SET LINE NO./SUB LINE NO.
         LW,W8    PNEXT
         AW,W8    W8
         STW,W8   CFADAT
         B        CI250
*
CI210    RES      0                 H=0A, SOURCE
         LW,W8    CLUBUF
         CI,W8    X'0200'
         BANZ     CI250             BR IF F2=2
         STB,W8   HVAL
         LW,W8    PNEXT
         AI,W8    -1
         STW,W8   PCURNT
         LI,R2    4
         BAL,W14  CI244             CLEAR SOURCE AREA
         LW,W8    PCURNT
         AI,W8    -1
         LW,W9    PC01
         STW,W9   *W8               LINK TO  01 ITEM
         LW,W8    PNEXT
         AW,W8    W8
         STW,W8   CFADAT
         MTW,0    FLG11             WAS LINE NO CLUSTER READ            COBOL34
         BNEZ     CI250             YES                                 COBOL34
         MTW,1    FLG0A                 SET FLAG                        COBOL34
         B        CI250             ATTACH CRF INFO
*
*        SET UP DESCRIPTOR
CI244    RES      0
         LI,W8    0
         LW,R3    PNEXT
         AI,R3    -1
CI246    STW,W8   *R3               ZERO OUT DESCRIPTOR
         AI,R3    -1
         BDR,R2   CI246
         AI,R3    1
         STW,R3   PNEXT             UPDATE PNEXT
         CW,R3    LOWLIM
         BLE      CI750             OVERFLOW
         B        *W14
*
*
CI250    RES      0                 STACK CRF ITEMS
         LW,W9    CLUBUF
         CI,W9    X'07000'          IS REPORT REFERENCE DEFINED?
         BANZ     CI252             BR IF NO
         LI,R1    95                UNDEFINED DATA REFERENCE
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         LI,R2    2                 SET LENGTH FOR UNDEFINED TRAILER
         B        CI253
CI252    LB,R2    CLUBUF
         AI,R2    -3                TRAILER LENGTH
CI253    LW,R6    CFADAT            TRAILER ADDRESS
         AI,R6    -1
         STH,R2   0,R6
         AND,W9   M3
         CI,W9    X'D000'
         BL       CI254             BR IF NOT INTEGER SUBSCRIPT
         AND,W9   M2
         AI,W9    3
         STH,W9   0,R6              SET SIZE AND TYPE OF TRAILER
         AI,R6    -1
         LI,R7    HA(CLUBUF+1)
         B        CI260
CI254    CI,W9    X'300'
         BANZ     CI257             BR IF DATA NAME SUBSCRIPT
         LI,W9    12
CI256    LH,W8    0,R6
         SLS,W9   8
         OR,W8    W9
         STH,W8   0,R6              SET TYPE=C,E
         LW,W8    CLUBUF+1
         SLS,W8   -4
         AND,W8   M2
         CI,W8    X'0B00'           IS THIS A REPORT ITEM?
         BNE      CI258             BR IF NO
         LB,W9    CLUBUF
         AI,W9    -9                HALF-WORDS TO BE MOVED
         BLEZ     CI258
         LH,W8    0,R6
         AI,W8    -1
         STH,W8   0,R6              REDUCE TRAILER LENGTH BY 1
         AI,R2    -1                REDUCE HALF-WORDS TO MOVE
         LI,R4    HA(CLUBUF+4)
         LW,R5    R4
         AI,R5    1
CI256A   LH,R7    0,R5
         STH,R7   0,R4
         AI,R4    1
         AI,R5    1
         BDR,W9   CI256A            REMOVE HALF-WORD FROM CRF CLU
         B        CI258
CI257    LI,W9    14
         B        CI256
CI258    AI,R6    -1                DEST ADDR
         AI,R2    -1                GET NO. OF HALF-WORDS
         LI,R7    HA(CLUBUF)
         AI,R7    3
CI260    LH,W8    0,R7
         STH,W8   0,R6
         AI,R6    -1
         AI,R7    1
         BDR,R2   CI260             MOVE HALF WORDS TO TRAILER
         AI,R6    1
         STW,R6   CFADAT            INC CFADAT
         LI,R3    -4
         LB,W8    *PCURNT,R3
         AI,W8    X'10'
         STB,W8   *PCURNT,R3        INC NO. OF TRAILERS
         LW,R2    CLUPTR
CI260A   AI,R2    1
         LB,W8    0,R2              CONTROL BYTE
         BEZ      CI260B            LINE NUMBER CLUSTER
         CI,W8    X'78'
         BE       CI260D            TO CHECK FOR SUBSCRIPTS
         CI,W8    X'77'
         BE       CI262             NO SUBSCRIPTS
         LI,R1    510               COMPILER ERROR 10
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI260C            SKIP CLUSTER
CI260B   AI,R2    1                 PROCESS LINE NUMBER CLUSTER
         SLS,R2   -1
         LH,W9    0,R2              GET LINE NUMBER
         STH,W9   PDBX              SAVE IN PDB
         AI,R2    1
         LH,W9    0,R2
         LI,R1    1
         STH,W9   PDBX,R1           UPDATE SOURCE LINE SUB-NUMBER
         LW,R4    CLUPTR
         BAL,W11  WRRGF             COPY LINE NUMBER CLUSTER
CI260C   BAL,W11  RDCRF             GET NEXT CLUSTER
         BCS,1    CI720             UNEXPECTED EOF
         STW,R2   CLUPTR
         B        CI260A            SEE IF IT IS REPORT ITEM
CI260D   RES      0                                                     COBOL34
         AI,R2    1                                                     COBOL34
         LB,W8    0,R2              CHECK F2 FIELD                      COBOL34
         CI,W8    X'D2'             IS IT INDEX INC OR DEC ?            COBOL34
         BL       %+3                                                   COBOL34
         MTW,1    INC%DEC           SET INC/DEC FLAG                    COBOL34
         B        CI018                                                 COBOL34
         AI,R2    1                 LOOK AHEAD AT H FIELD               COBOL34
         LB,W8    HVAL
         AI,W8    1
         CB,W8    0,R2              CHECK FOR SUBSCRIPTS
         BE       CI261             H=SAME+1
         AI,W8    -1
         CB,W8    0,R2
         BNE      CI262             H IS NOT SAME OR SAME+1
         AI,R2    -1                H=SAME
         LB,W8    0,R2              CHECK F2 FIELD
         CI,W8    2
         BAZ      CI262             BR IF F2 NOT 2
CI261    LI,R3    -4
         LB,W8    *PCURNT,R3
         AI,W8    X'01'
         STB,W8   *PCURNT,R3        INC NO OF SUBSCRIPTS
         B        CI018
*
CI262    RES      0
         LB,W8    HVAL
         CI,W8    8
         BE       CI270             BR IF RESET
         CI,W8    14
         BE       CI270             BR IF CONTROL
         CI,W8    10
         BNE      CI263             BR IF NOT SOURCE
         LI,R3    -23
         LB,W10   *PC01,R3          GET TYPE
         CI,W10   7
         BE       CI270             BR IF SOURCE IN CF
CI263    CI,W8    12
         BNE      CI265             BR IF NOT SUM UPON
         LH,W9    CLUBUF+4          GET REPORT GROUP NO.
         LW,R6    PSADD             ADDR OF 1ST ADDEND
CI264    LW,R3    0,R6              LINK WORD
         AI,R6    -2
         STB,W9   *R6               PUT GROUP NO. IN ADDEND
         LS,R3    ADRMSK
         BEZ      CI276             BR IF NO MORE ADDENDS
         LW,R6    R3
         B        CI264
*
CI265    LI,W8    6
         CB,W8    HVAL
         BE       CI267             BR IF ADDEND
CI266    LW,W8    PCURNT
         AI,W8    1
         STW,W8   RITSRC            SAVE ADDR OF SOURCE ITEM
CI267    LW,W8    CFADAT
         SLS,W8   -1                WORD ADDRESS
         STW,W8   PNEXT
         CW,W8    LOWLIM
         BLE      CI750             OVERFLOW
         B        CI018
*
CI270    RES      0                 RESET,CONTROL,SOURCE IN CF
         LW,W8    PCURNT
         AW,W8    W8                HALF WORD ADDR OF LINK WORD
         STW,W8   CGR               SET FOR MATCH ROUTINE
         LI,R3    -13
         LB,W8    *PCURNT,R3
         CI,W8    3                 MINIMUM LENGTH FOR MATCH
         BGE      CI270A            BR IF OK
         LI,W8    0
         STB,W8   CNLVL             SET FOR NO MATCH
         LW,W8    CGR
         AI,W8    -6
         STW,W8   MDAT              POINT AT TRAILER
         B        CI270B
CI270A   BAL,W14  MATCH             MATCH CONTROL FIELDS
CI270B   LI,W8    10
         CB,W8    HVAL
         BNE      CI271
         LI,W14   WA(CI266)         SET RETURN ADDRESS
         B        CI278
CI271    MTB,0    CNLVL
         BNEZ     CI272
         LI,R1    96                INVALID DATA REFERENCE
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI276
CI272    LI,W8    8
         CB,W8    HVAL
         BE       CI274             BR IF RESET
         LB,W8    CNLVL
         LI,R3    -7
         STB,W8   *PC01,R3          PUT CTL LEVEL IN 01 ITEM
         LI,R3    -23
         LB,W8    *PC01,R3          GET 01 TYPE
         CI,W8    7                 IS IT CF
         BNE      CI276             BR IF NO
         LI,R3    12
         LH,W9    *PDDD,R3          GET REPORT GROUP NUMBER
         LI,R1    -2
         STB,W9   *CMGR,R1          SAVE IN CFMGR
         B        CI276
CI274    LB,W9    CNLVL
         SLS,W9   17
         LI,R3    -1
         MTW,0    PCSUM
         BNEZ     CI275             PUT LEVEL IN EXISTING SUM
         LW,W8    PCURNT
         STW,W8   PCSUM
         AI,W8    -3
         STW,W8   PNEXT
         CW,W8    LOWLIM
         BLE      CI750             OVERFLOW
         STS,W9   *PCSUM,R3         PUT RESET LEVEL IN SUM
         LI,R2    4
         BAL,W14  CI244             AREA FOR DDD SUM INFO
         B        CI018
CI275    STS,W9   *PCSUM,R3         PUT RESET LEVEL IN SUM
CI276    LW,W8    PCURNT
         AI,W8    1
         STW,W8   PNEXT
         B        CI018
*
CI278    STW,W14  RET14             SAVE RETURN ADDRESS
         MTB,0    CNLVL             IS SOURCE ITEM A CONTROL FIELD?
         BNEZ     CI293             BR IF YES
         LI,R3    -4
         LB,W12   *PCURNT,R3
         AND,W12  M5                ANY SUBSCRIPTS TO PROCESS?
CI282    BLEZ     *RET14            BR IF NO
         LW,R6    MDAT              GET TRAILER ADDRESS
         BEZ      *RET14                                                COBOL34
         AI,R6    -1
         LH,W8    0,R6
         AND,W8   MFF               TRAILER LENGTH
         AI,W8    -1
         SW,R6    W8
         STW,R6   MDAT
         STW,R6   CDAT
         LW,R3    R6
         AI,R3    -1
         LH,R3    0,R3
         LS,R3    MFF               GET TRAILER LENGTH
         CI,R3    3                 MINIMUM LENGTH FOR MATCH
         BGE      CI284             BR IF OK
         LI,R3    0
         STB,R3   CNLVL             SET FOR NO MATCH
         B        CI292
CI284    LI,W10   1
         STB,W10  MFSW
         BAL,W14  MATCH             MATCH SUBSCRIPT TO CTL FIELD
         MTB,0    CNLVL             MATCH?
         BEZ      CI292             BR IF NO
         LW,R6    CDAT
         AI,R6    -1
         LH,W8    0,R6
         AND,W8   MFF
         CI,W8    3                 INTEGER SUBSCRIPT
         BLE      CI292             BR IF YES
CI288    LW,R6    CDAT
         AI,R6    -4
         LI,R3    -3
         LH,W10   *CMGR,R3          GET M2 FROM CFMGR
         STH,W10  0,R6              SET 'OLD' DISP IN TRAILER
         AI,R6    1
         LI,R3    -8
         LB,W10   *CFMREP,R3        GET L2 FROM CFMREP
         SLS,W10  8
         STH,W10  0,R6              SET 'OLD' BASE IN TRAILER
CI292    AI,W12   -1                REDUCE SUBSCRIPT COUNT
         B        CI282             TRY AGAIN
CI293    LI,W12   1
         LI,R3    -4
         LI,W8    X'10'
         STB,W8   *PCURNT,R3        NO SUBSCRIPTS
         LI,R3    -8
         LH,W8    *PCURNT,R3
         AND,W8   L(X'0000FFFF')
         LW,W9    W8
         AND,W8   M5
         BEZ      CI288             IF NO DIMENSIONS
         SW,W9    W8
         STH,W9   *PCURNT,R3        REDUCE DIMENSIONS
         LI,R3    -7
         LH,W9    *PCURNT,R3
         AND,W9   L(X'0000FFFF')
         SW,W9    W8
         STH,W9   *PCURNT,R3        REDUCE TRAILER LENGTH
         LW,R1    W9
         AND,R1   MFF
         AI,R1    -6                NUMBER OF HALF-WORDS TO MOVE
         LW,R6    PCURNT
         AW,R6    R6
         AI,R6    -13               TO ADDRESS
         LW,R2    R6
         SW,R2    W8                FROM ADDRESS
CI296    LH,W8    0,R2              UPDATE TRAILER
         STH,W8   0,R6
         AI,R2    -1
         AI,R6    -1
         BDR,R1   CI296
         B        CI288
*
CI300    RES      0                 H=10,11,12
         MTW,0    PLINE             ADDITIONAL LINE?
         BEZ      CI302             BR IF NO
         LI,R3    -1
         LW,W8    *PLINE,R3
         CI,W8    X'040000'         WAS LAST ENTRY FOR LINE
         BANZ     CI302             BR IF NO
         LI,R3    -4
         LB,W8    CLUBUF+1
         CB,W8    *PLINE,R3         WAS LAST LINE# = NEW LINE#
         BE       CI018             YES, SKIP CLUSTER
CI302    LI,W9    1                 H=10, LINE
         B        CI311
CI310    LI,W9    2                 H=11, LINE+
CI311    LB,W8    CLUBUF+1
         SLS,W8   8
CI312    SLS,W9   1
         OR,W8    W9
         MTW,0    PLINE
         BEZ      CI318             BR IF 1ST LINE OF 01
         LW,W10   W8
         LI,R2    2
         MTW,1    FLG11             TURN ON LINE FLAG                   COBOL34
         BAL,W14  CI244             GET AREA FOR LINE IMAGE INFO
         STH,W10  *PNEXT            SAVE LINE INFO
         LW,W9    PNEXT
         AI,W9    1
         LI,R3    -1
         STS,W9   *PLINE,R3         LINK TO NEW LINE INFO
         STW,W9   PLINE
         LI,W8    134
         STB,W8   *PLINE            LINE IMAGE LENGTH
         LI,R3    -24
         LB,W8    *PC01,R3
         AI,W8    1
         STB,W8   *PC01,R3          INCREMENT LINE IMAGE COUNT
         B        CI018
CI318    LI,R3    -2
         STH,W8   *PC01,R3
         LI,R3    -16
         STH,W8   *PC01,R3          SAVE LINE INFO IN 01
         LW,W8    PC01
         AI,W8    -7
         STW,W8   PLINE             POINT AT CURRENT LINE IMAGE INFO
         B        CI018
CI320    LI,W9    3                 H=12, LINE NEXT PAGE
         LI,W8    0
         B        CI312
*
CI330    RES      0                 H=13,14,15
         LI,W9    1                 H=13, NEXT
         B        CI341
CI340    LI,W9    2                 H=14, NEXT+
CI341    LB,W8    CLUBUF+1
         SLS,W8   8
CI342    SLS,W9   1
         OR,W9    W8
         STH,W9   *PC01
         B        CI018
CI350    LI,W9    3                 H=15, NEXT PAGE
         LI,W8    0
         B        CI342
*
CI360    RES      0                 H=16,19
         LB,R3    CLUBUF+1
         LB,W8    RGT,R3            GET REPORT GROUP TYPE
         LI,R3    -23
         STB,W8   *PC01,R3          PUT GROUP TYPE IN 01
         B        CI018
*
CI365    LI,R3    -7
         STB,W9   *PC01,R3          PUT FINAL CTL LEVEL IN 01
         B        CI360
*
CI370    RES      0                 H=1A, REST FINAL
         LI,R3    -7
         LB,W9    *CFMREP,R3        GET W2 FROM CFMREP
         AI,W9    1                 INC FOR FINAL LEVEL
         LI,R3    3
         LB,W8    CLUBUF,R3
         CI,W8    X'19'
         BE       CI365
         SLS,W9   17
         LI,R3    -1
         STS,W9   *PCSUM,R3         SET CTL LEVEL TO FINAL
         B        CI018
         PAGE
***      H=17, PROCESS END OF ITEM CLUSTER
*
CI400    RES      0                 END OF ITEM
         LI,W8    0
         STW,W8   PSADD             SET NO ADDENDS FLAG
         STW,W8   DDDNXT
         LI,R1    1
         LI,R2    8
         CB,R1    *PDDD,R2
         BNE      CI410
         LH,W8    PDBK,R1
         AI,W8    1
         STW,W8   REFNO             PUT KB IN CLUSTER
         STH,W8   PDBK,R1
         LW,R6    PC01
         AI,R6    -5
         STH,W8   *R6               SAVE REF# IN 01 ITEM
         LI,R4    BA(EPCLU)
         BAL,W11  WRRGF             WRITE ENTRY TAG CLU (NORMAL MOVES)
CI410    LW,W8    CLUBUF+1
         CI,W8    1                 ELEMENTARY LINE NO.?
         LW,W9    W8
         OR,W9    HIST01
         STW,W9   HIST01            UPDATE HISTORY FOR THIS 01
         BANZ     CI412             BR IF YES
         CI,W8    X'1000'           GROUP LINE NUMBER?
         BAZ      CI413             BR IF NO
CI412    LW,W9    PC01
         AI,W9    -7
         CW,W9    PLINE             ADDITIONAL LINE?
         BE       CI413             BR IF NO
         LI,R3    4
         LW,W9    *PDDD,R3
         SLS,W9   8
         SLS,W9   -8
         STS,W9   *PLINE            OFFSET OF ADDITIONAL LINE
CI413    CI,W8    X'0400'
         BAZ      CI486             BR IF NOT ELEMENTARY ITEM
CI414    CI,W8    X'04'
         BANZ     CI420             BR IF SUM
         CI,W8    X'08'
         BANZ     CI430             BR IF SOURCE
         CI,W8    X'02'
         BANZ     CI510             BR IF VALUE
         CI,W8    X'0800'
         BANZ     CI600             BR IF SOURCE-SELECTED
CI416    LI,R1    137               LOAD DIAGNOSTIC NUMBER
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI480
CI420    LW,W8    PDDD              SUM BIT ON
         LB,W9    *PDDD
         AW,W8    W9                GET 2ND DDD ITEM FOR SUM
         STW,W8   DDDNXT
         LW,R7    PCSUM             SET UP SUM TRAILER
         BEZ      CI416             ERROR CONDITION
         LI,R2    1
         LI,R3    8
         CB,R2    *PDDD,R3          IS THIS AN 01 ITEM?
         BNE      CI422             BR IF NO
         LW,R2    W8                BUFFER ADDR FOR 2ND DDD ITEM
         SLS,R2   2
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD             GET 2ND DDD ITEM
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD
         BCS,1    CI730             UNEXPECTED EOF
CI422    AI,R7    -1
         LI,W9    X'10'
         STB,W9   *R7               NO. OF TRAILERS
         LI,W9    X'0C07'
         AW,R7    R7
         AI,R7    -5
         STH,W9   0,R7              SIZE AND TYPE OF TRAILER
         LI,R3    5
         LW,R5    W8                DDD POINTER
         AW,R5    R5
         AI,R5    7
         AI,R7    -1
CI424    LH,W9    0,R5              MOVE DDD INFO TO TRAILER
         STH,W9   0,R7
         AI,R5    1
         AI,R7    -1
         BDR,R3   CI424
         AI,R5    1                 SKIP COLUMN NUMBER
         LH,W9    0,R5
         STH,W9   0,R7              POINT LOCATION FIELD
         LW,R2    PCSUM
         B        CI440
CI430    RES      0
         LW,W8    CLUBUF+1
         CI,W8    X'0100'
         BANZ     CI560             BR IF GRP INDICATE
         LW,R2    PCURNT
         BEZ      CI416             ERROR CONDITION
CI440    LI,R3    24
         LB,W9    *PDDD,R3          IS THERE A COLUMN NUMBER?
         BEZ      CI463             BR IF NO
         LW,W8    MOVE1
         AI,R2    -1
         LB,W9    *R2               GET NO. OF SUBSCRIPTS
         LI,W10   15
         AND,W9   W10
         LW,W12   W9
         SLS,W9   5
         OR,W8    W9
         STW,W8   WKBUF             SET 1ST WORD OF CLUSTER
         AW,R2    R2                HALF WORD ADDRESS
         AI,R2    -5
CI443    LH,R3    0,R2
         AND,R3   MFF
         AI,R3    -1
         LW,W9    R3
         AI,W9    4
         STB,W9   WKBUF             SET CLU LENGTH
         LI,W8    0
         STH,W8   WKBUF+1
         AI,R2    -1
         LI,R6    HA(WKBUF+1)
         AI,R6    1
CI446    LH,W8    0,R2              MOVE CRF INFO TO CLU
         STH,W8   0,R6
         AI,R2    -1
         AI,R6    1
         BDR,R3   CI446
         LI,R4    BA(WKBUF)
         BAL,W11  WRRGF             WRITE SUBJ CLU/SUBSCRIPTS
         AI,W12   -1
         BGEZ     CI447             PROCESS SUBSCRIPTS                  COBOL34
         MTW,-1   INC%DEC           ANY INDEX INC OR DEC ?              COBOL34
         BGEZ     CI447             YES                                 COBOL34
         MTW,1    INC%DEC           SET FLAG TO ZERO                    COBOL34
         B        CI460             BR IF NO MORE SUBSCRIPTS            COBOL34
CI447    RES      0                                                     COBOL34
         LH,W8    0,R2
         AND,W8   M2                GET TRAILER TYPE
         CI,W8    X'0E00'
         BNE      CI452
         LI,W8    X'0200'           SET FOR DATA NAME SUBSCRIPT
CI448    OR,W8    MOVE2
         STW,W8   WKBUF             PUT T IN CLUSTER
         B        CI443             OUTPUT SUBSCRIPT
CI452    AI,W8    X'4000'           SET FOR INTEGER SUBSCRIPT
         OR,W8    MOVE2
         STW,W8   WKBUF
         LI,W8    5
         STB,W8   WKBUF             SET CLUSTER LENGTH
         LI,R6    HA(WKBUF+1)
         AI,R2    -1
         LI,R3    2                 HALF-WORD LENGTH OF INTEGER
         B        CI446             OUTPUT INTEGER SUBSCRIPT
CI460    LW,W8    MOVOBJ            OUTPUT OBJECT CLUSTER
         STW,W8   WKBUF
         LI,W8    0
         STH,W8   WKBUF+1
         LI,R3    BA(WKBUF+1)
         AI,R3    2
         LI,W8    9
         STB,W8   WKBUF             CLU LENGTH (NO EDIT)
         LI,W8    10
         STB,W8   R3                LENGTH OF MOVE
         LW,R2    PDDD
         SLS,R2   2
         AI,R2    14
         MBS,R2   0                 UP TO COLUMN NO.
         LB,W8    0,R2              GET COLUMN NO.
         LI,R7    2
         AW,W8    WKBUF,R7          ADD COLUMN NO. TO DISP
         STW,W8   WKBUF,R7          SET IN CLU
         LB,W8    *PDDD
         SLS,W8   1
         AI,W8    -13
         LB,W9    WKBUF
         AW,W9    W8
         STB,W9   WKBUF             CLU LENGTH (EDIT)
         SLS,W8   1
         STB,W8   R3                MOVE LENGTH FOR EDIT INFO
         MBS,R2   2                 ADD EDIT INFO
CI462    LI,R4    BA(WKBUF)
         BAL,W11  WRRGF             WRITE OBJ CLU
CI463    LW,W8    CLUBUF+1
         CI,W8    8
         BAZ      CI464             BR IF NOT SOURCE
         CI,W8    X'08000'
         BANZ     CI490             BR IF DE
         B        CI468             SOURCE NOT DE
CI464    CI,W8    4
         BANZ     CI494             BR IF SUM
         LI,R1    137               LOAD DIAGNOSTIC NUMBER
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI480
*        SIDR 6315 CHANGED THE RESETING OF PNEXT TO RESET IT ONLY IF    COBOL34
*        THE LINE NUMBER CLUSTER APPEARS 1 ST IN THE SOURCE CODE        COBOL34
*        EX.  02  LINE PLUS 1 COLUMN 7 PIC XX SOURCE YY.                COBOL34
CI468    RES      0                                                     COBOL34
         MTW,0    FLG0A                                                 COBOL34
         BNEZ     CI469             DO NOT CHANGE PNEXT                 COBOL34
         LW,W8    RITSRC                                                COBOL34
         STW,W8   PNEXT
CI469    RES      0                                                     COBOL34
         LI,R2    0                                                     COBOL34
         STW,R2   FLG0A             RESET SOURCE FLAG                   COBOL34
         STW,R2   FLG11             RESET LINE   FLAG                   COBOL34
CI480    LW,R2    CLUPTR
         AI,R2    1
         LB,W8    0,R2
         BEZ      CI480A            BR IF LINE NUMBER CLUSTER
         CI,W8    X'7F'             IS IT LEVEL NO. CLUSTER
         BNE      CI480B            NO
         AI,R2    2
         LB,W8    0,R2              GET LEVEL NO.
         STB,W8   CLUBUF+2          PUT INTO CLUSTER BEING PROCESSED
         BAL,W11  RDCRF
         BCS,1    CI720
         STW,R2   CLUPTR
         B        CI480B
CI480A   AI,R2    1
         SLS,R2   -1
         LH,W8    0,R2
         STH,W8   PDBX              UPDATE LINE NO.
         AI,R2    1
         LH,W8    0,R2
         LI,R3    1
         STH,W8   PDBX,R3
         BAL,W11  RDCRF             CHECK NEXT CLUSTER
         BCS,1    CI720
         STW,R2   CLUPTR
         B        CI480+1
CI480B   LI,W8    1
         CB,W8    CLUBUF+2
         BL       CI484             BR IF NOT 00 OF 01 ITEM
         LI,R4    BA(JRPT3)
         BAL,W11  WRRGF             WRITE 'JUMP TO RPG' CLU
         LI,W8    0
         LW,W9    HIST01
         STW,W8   HIST01            CLEAR HISTORY FOR THIS 01
         CI,W9    X'200'            WAS THERE A COLUMN NUMBER
         BANZ     CI481             BR IF YES
         LI,R3    -24
         STB,W8   *PC01,R3          SET # OF LINE IMAGES TO ZERO
CI481    LI,R3    -23
         LB,W9    *PC01,R3
         SLS,W9   -1
         CI,W9    1                 TEST FOR 0H OR 0V
         BNE      CI482             BR IF NEITHER
         LI,R3    -1
         LI,W9    X'60000'
         AND,W9   *PC01,R3
         CI,W9    X'60000'          LINE NEXT PAGE
         BNE      CI482             BRANCH IF NO
         LW,W9    *PC01,R3
         AND,W9   ADRMSK
         STW,W9   *PC01,R3          SUPPRESS NEXT PAGE INDICATION
         LI,R3    -8
         LW,W9    *PC01,R3
         AND,W9   ADRMSK
         STW,W9   *PC01,R3
CI482    MTB,0    GISW
         BEZ      CI483             BR IF NO GRP IND
         BAL,W11  GRPIND
         LI,W8    0
         STB,W8   GISW
         STW,W8   P01GRV
CI483    STW,W8   P01DE             RESET FOR NEXT 01
         STW,W8   PLINE
         LI,W8    1
         CB,W8    CLUBUF+2
         BE       CI175             BR IF NXT ITEM IS 01
         LW,W8    PNEXT
         AI,W8    -1
         STW,W8   PNEXT
         BAL,W11  SUMS              ANALYZE SUMS
         BAL,W11  ADDS              GENERATE ADDS
         BAL,W11  GNRTBL            GENERATE REPORT TABLE
         LW,W8    PR01
         AI,W8    1
         LI,R3    -3
         STW,W8   *CFMREP,R3        SET U(CFMREP) FOR NEXT REPORT
         STW,W8   PNEXT
         LI,W8    0
         STW,W8   PCADD             ZERO POINTERS FOR NEXT REPORT
         STW,W8   PRADD
         STW,W8   PCSUM
         STW,W8   PLSUM
         STW,W8   PCSRC
         STW,W8   PRDE
         STW,W8   PRSUM
         STW,W8   PR01
         STW,W8   PC01
         B        CI018             READ NEXT CLUSTER
CI484    MTW,0    DDDNXT
         BEZ      CI486
         LB,W8    *DDDNXT
         LW,W9    DDDNXT
         B        CI488             UPDATE DDD POINTER
CI486    LB,W8    *PDDD
         LW,W9    PDDD
CI488    AW,W9    W8
         STW,W9   PDDD              NEXT DDD ITEM
         B        CI018
CI490    RES      0                 LINK DE SOURCE TO STRING
         LW,W9    PCURNT
         MTW,0    P01DE
         BNEZ     CI491
         STW,W9   P01DE             1ST DE SOURCE THIS 01
CI491    MTW,0    PCSRC
         BNEZ     CI492
         STW,W9   PCSRC
         STW,W9   PRDE              SAVE ADDR OF 1ST DE SOURCE
         B        CI493
CI492    LW,R7    *PCSRC
         OR,R7    W9
         STS,R7   *PCSRC            LINK LAST SOURCE TO NEW ONE
         STW,W9   PCSRC
CI493    LW,R6    PCURNT
         B        CI499
CI494    RES      0                 LINK SUM TO STRING
         LW,W9    PC01
         LI,R3    -1
         STS,W9   *PCSUM,R3         LINK TO 01
         LW,W10   PCSUM
         MTW,0    PLSUM
         BNEZ     CI496
         STW,W10  PLSUM
         STW,W10  PRSUM             SAVE ADDR OF 1ST SUM
         B        CI498
CI496    LW,W8    *PLSUM
         OR,W8    W10
         STW,W8   *PLSUM            LINK LAST SUM TO NEW ONE
         STW,W10  PLSUM
CI498    LI,W8    0
         STW,W8   PCSUM
         LW,R6    PLSUM
CI499    LW,W8    PDBX              GET LINE NO./SUB-LINE NO.
         LI,R3    -3
         STW,W8   *R6,R3            PUT IN DESCRIPTOR
         LI,R3    3
         LW,W9    *PDDD,R3          GET CLASS
         AND,W9   M2
         SLS,W9   -7
         LI,R3    12
         LH,W8    *PDDD,R3          GET COLUMN NO.
         AND,W8   M3
         OR,W9    W8
         LW,W8    CLUBUF+1
         CI,W8    X'0100'
         BAZ      CI500             BR IF NOT GRP IND
         AI,W9    X'00E0'           SET GRP IND FLAG
CI500    STH,W9   *R6               PUT IN DESCRIPTOR
         B        CI480
*
CI510    RES      0                 VALUE ITEM
         CI,W8    X'0100'
         BAZ      CI480             BR IF NOT GRP IND
         LI,W8    1
         STB,W8   GISW              SET GRP IND SWITCH
         LW,W8    PDDD
         LB,W9    *PDDD
         AW,W8    W9
         STW,W8   DDDNXT            GET 2ND DDD ITEM
         LI,R2    1
         LI,R3    8
         CB,R2    *PDDD,R3          IS THIS AN 01 ITEM?
         BNE      CI512             BR IF NO
         LW,R2    W8                BUFFER ADDR FOR 2ND DDD ITEM
         SLS,R2   2
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD             GET 2ND DDD ITEM
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD
         BCS,1    CI730             UNEXPECTED EOF
CI512    LW,W9    PNEXT
         AI,W9    -1
         MTW,0    P01GRV
         BNEZ     CI514
         STW,W9   P01GRV            POINT AT 1ST ITEM IN CHAIN
         B        CI515
CI514    STS,W9   *PLGRV            LINK LAST ITEM TO NEW ONE
CI515    STW,W9   PLGRV
         LI,R2    10
         BAL,W14  CI244             AREA FOR NEW DESCRIPTOR
         LW,W8    PC01
         LI,W9    1
         SCS,W9   -4
         OR,W8    W9
         LI,R3    -1
         STW,W8   *PLGRV,R3         LINK TO 01 ITEM
         LI,R3    4
         LW,W8    *PDDD,R3          GET BASE AND OFFSET
         LI,R3    -4
         STW,W8   *PLGRV,R3
         LI,R3    5
         LW,W8    *PDDD,R3          GET N AND P
         LI,R3    -5
         STW,W8   *PLGRV,R3
         LW,R7    DDDNXT
         AW,R7    R7                HA(2ND DDD ITEM)
         AI,R7    7                 HIJK
         LW,R5    PLGRV
         AW,R5    R5
         AI,R5    -11
         LI,W8    X'0C06'
         STH,W8   0,R5              SIZE AND TYPE OF TRAILER
         AI,R5    -1
         LI,R3    5
CI528    LH,W9    0,R7              MOVE 2ND DDD ITEM INFO TO DESCRIPTOR
         STH,W9   0,R5
         AI,R7    1
         AI,R5    -1
         BDR,R3   CI528
         AI,R5    1
         SLS,R5   -1
         STW,R5   PNEXT             ROUND DOWN TO WORD BOUNDARY
         LW,R6    PLGRV
         CW,R5    LOWLIM
         BLE      CI750             OVERFLOW
         B        CI499             TO FINISH DESCRIPTOR
*
CI560    RES      0                 GROUP INDICATE SOURCE
         LI,W9    1
         STB,W9   GISW              SET GRP IND SW
CI564    LW,W10   PDDD
         LB,W9    *PDDD
         AW,W10   W9
         STW,W10  DDDNXT            GET 2ND DDD ITEM
         LI,R2    1
         LI,R3    8
         CB,R2    *PDDD,R3          IS THIS AN 01 ITEM?
         BNE      CI566             BR IF NO
         LW,R2    W10               BUFFER ADDR FOR 2ND DDD ITEM
         SLS,R2   2
         LW,R3    DDDSIZ            LATGEST DDD                         COBOL34
         BAL,W11  RDDDD             GET 2ND DDD ITEM
         LI,R2    BA(DDSEG)
         LI,R3    4                 SIZE = 4 BYTES                      COBOL34
         BAL,W11  RDDDD
         BCS,1    CI730             UNEXPECTED EOF
CI566    LW,W10   PCURNT
         BEZ      CI416             ERROR CONDITION
         AI,W10   -3
         LW,R5    W10
         SW,W10   PNEXT             GET LENGTH OF AREA TO BE SAVED
         AW,W10   W10               HALF WORDS
         LW,W12   W10
         AW,R5    R5
         LW,W15   R5                SAVE START OF TRAILERS
         AI,W15   -4                INC FOR 2 WORDS OF DDD INFO
         AI,R5    -1
         LI,R7    HA(WKBUF)
CI570    LH,W9    0,R5              MOVE TRAILER TO SAVE AREA
         STH,W9   0,R7
         AI,R7    1
         AI,R5    -1
         BDR,W10  CI570
         LW,W9    PC01
         LI,R3    -1
         STS,W9   *PCURNT,R3        LINK TO 01 ITEM
         LI,R3    4
         LW,W8    *PDDD,R3
         LI,R3    -4
         STW,W8   *PCURNT,R3        BASE AND OFFSET
         LI,R3    5
         LW,W8    *PDDD,R3
         LI,R3    -5
         STW,W8   *PCURNT,R3        N AND P
         LW,R6    PCURNT
         AI,R6    -1
         LB,W8    *R6
         AI,W8    X'10'
         STB,W8   *R6               INC NO. OF TRAILERS
         LB,W8    *PDDD
         AW,W8    W8
         AI,W8    -13               GET HALFWORD LENGTH OF EDIT INFO
         LW,R6    W8
         AI,W8    1
         SW,W15   W8
         AI,W8    X'0600'
         LI,R3    -11
         STH,W8   *PCURNT,R3        EDIT SIZE AND TYPE
         LW,R7    PCURNT
         AW,R7    R7
         AI,R7    -12
         LW,R5    PDDD
         AW,R5    R5
         AI,R5    13
CI585    LH,W9    0,R5              MOVE EDIT INFO TO TRAILER
         STH,W9   0,R7
         AI,R5    1
         AI,R7    -1
         BDR,R6   CI585
CI590    LW,R7    W15
         AI,R7    -1                NEXT AVAILABLE HALF-WORD
         LI,R5    HA(WKBUF)
CI594    LH,W9    0,R5              RESTORE ORIGINAL TRAILERS
         STH,W9   0,R7
         AI,R5    1
         AI,R7    -1
         BDR,W12  CI594
         AI,R7    1
         SLS,R7   -1                ROUND DOWN TO WORD ADDR
         STW,R7   PNEXT
         LW,R6    PCURNT
         CW,R7    LOWLIM
         B        CI490             TO FINISH DESCRIPTOR
*
CI600    RES      0                 SOURCE-SELECTED
         LW,W15   SSN
         BLEZ     CI632
         LI,R3    6
         LH,W9    *PDDD,R3          DDD REF NO.
         LW,R7    CFA               GET START OF SS CLUSTERS
         SLS,R7   1                 GET HA
         BLE      CI750             OVERFLOW
CI610    AI,R7    3                 POINT AT REF NO.
         CH,W9    0,R7
         BE       CI620             BR IF MATCH
         AI,R7    -3
         LH,W8    0,R7
         SLS,W8   -8                GET LENGTH OF SS CLUSTER
         AW,R7    W8
         MTW,-1   W15
         BEZ      CI632             NO MATCH IS ERROR
         B        CI610             TRY NEXT SS ITEM
CI620    LI,W9    8
         STS,W9   CLUBUF+1          SET HISTORY TO SOURCE
         LW,W8    PNEXT
         STW,W8   RITSRC
         AI,W8    -1
         STW,W8   PCURNT
         LI,R2    4
         BAL,W14  CI244             GET AREA FOR SOURCE ITEM
         LW,W8    PC01
         LI,W9    1                 NO. OF TRAILERS
         SCS,W9   -4
         OR,W8    W9
         LI,R3    -1
         STW,W8   *PCURNT,R3        LINK TO 01
         LW,R5    PCURNT
         AW,R5    R5                HALF-WORD ADDR
         AI,R5    -7
         AI,R7    -3
         LH,R3    0,R7              1ST HALF-WORD OF TRAILER
         SLS,R3   -8                SIZE OF S-S ITEM IN R3
         AI,R3    -4                SIZE OF TRAILER
         LW,W8    R3
         AI,W8    X'0C00'           TYPE OF TRAILER
         STH,W8   0,R5              SET SIZE AND TYPE OF TRAILER
         AI,R5    -1
         AI,R7    4                 HIJK OF S-S ITEM
         AI,R3    -1                NO. OF HALF-WORDS TO BE MOVED
CI628    LH,W9    0,R7              MOVE SS INFO TO TRAILER
         STH,W9   0,R5
         AI,R5    -1
         AI,R7    1
         BDR,R3   CI628
         AI,R5    1
         SLS,R5   -1                ROUND DOWN TO WORD ADDR
         STW,R5   PNEXT
         CW,R5    LOWLIM
         BLE      CI750             OVERFLOW
         LW,W8    CFA
         STW,W8   LOWLIM            RESET LOWER CORE LIMIT
         B        CI430             PROCESS AS NORMAL SOURCE ITEM
*
CI632    RES      0
         LI,R1    95                LOAD DIAGNOSTIC NUMBER
         BAL,W11  DIAG              ISSUE DIAGNOSTIC
         B        CI480
*
CI710    RES      0                 UNEXPECTED EOF
         LI,R1    203
         BAL,W11  DIAG
         B        PH34E             EXIT PHASE 3.4
*
CI720    LI,R1    512               COMPILER ERROR 12
         B        CI710+1
*
CI730    LI,R1    511               COMPILER ERROR 11
         B        CI710+1
*
CI740    LI,R1    222               TOO MANY REPORT CTL LEVELS
         B        CI710+1           DIAGNOSTIC
*
CI750    LI,R1    122               CFA-CFM TABLE OVERFLOW
         B        CI710+1
         TITLE    'PHASE 3.4 - REPORT GENERATOR'
*
* MOVCOM SUBROUTINE
*        GENERATES CLUSTERS TO COMPARE CONTROL FIELDS AGAINST THEIR
*        PREVIOUS CONTENTS WITH JUMPS TO THE REPORT PROCESSOR ROUTINE
*        TO INDICATE THE HIGHEST LEVEL CONTROL FIELD CHANGED. GENERATES
*        CLUSTERS TO MOVE NEW VALUE OF EACH CONTROL FIELD INTO A FIELD
*        REPRESENTING THE OLD OR PREVIOUS VALUE.
*
MOVCOM   RES      0
         LI,W8    1
         STB,W8   COMSW             SET COMSW=1 FOR COMPARE
         STB,W8   FSW
         LW,R5    CFMREP
         AI,R5    -2                R5=WA(CFMREP)
MC010    LH,W8    *R5
         STB,W8   NCONTR            NO. OF CTL FIELDS
         LW,W8    CFA
         STW,W8   CFAGR
         MTB,0    COMSW
         BEZ      MC020             BR IF PROCESSING MOVES
         LI,R2    1
         LH,W8    PDBK,R2           GET KB
         AI,W8    1
         STW,W8   REFNO             PUT KB IN CLUSTER
         STH,W8   PDBK,R2           SAVE NEW KB
         STH,W8   RDI+5
         LI,R4    BA(EPCLU)
         BAL,W11  WRRGF             WRITE CLUSTER
         MTB,0    NCONTR            ANY CONTROL FIELDS?
         BEZ      MC300             EXIT IF NONE
*
MC020    LW,R2    CFAGR
         LW,W8    1,R2
         STW,W8   CFMGR
         SLS,R2   1
         AI,R2    4                 NO. OF HALF-WORDS IN CFAGR ENTRY
         STW,R2   CFADAT
         AI,W8    -3                NO. OF WORDS IN CFM ENTRY
         STW,W8   CFMDAT
         LI,R2    5
         LB,W9    *W8,R2            GET NO. OF DATA ENTRIES
         STB,W9   NDATA
         MTB,0    COMSW
         BEZ      MC030             BR IF PROCESSING MOVES
         LW,W8    COMP1
         STW,W8   MCBUF             SET 1ST WORD OF CLUSTER
         B        MC034
*
MC030    LI,R2    1
         LH,W8    PDBK,R2           GET KB
         AI,W8    1
         STW,W8   REFNO             PUT KB IN CLUSTER
         STH,W8   PDBK,R2
         MTB,0    FSW               FIRST TIME THRU?
         BEZ      MC032             BR IF NO
         STH,W8   RDI+5,R2          SAVE FIRST REF NO.
         MTB,-1   FSW
MC032    LI,R4    BA(EPCLU)
         BAL,W11  WRRGF             WRITE EP CLU FOR MOVE
         LW,W8    MOVE1
         STW,W8   MCBUF             SET 1ST WORD OF CLUSTER
MC034    LW,R3    CFMGR             CALC NO. OF SUBSCRIPTS
         AI,R3    -2
         LB,W9    *R3
         SLS,W9   5
         STS,W9   MCBUF             1+(NO. OF SUBSCRIPS X 2)
         LI,R3    BA(MCBUF+1)
         BAL,W13  MC150             ATTACH EHI, ETC.
         LI,R4    BA(MCBUF)
         BAL,W11  WRRGF             WRITE CLUSTER
MC040    RES      0
         LW,W8    CFMDAT            GET NEXT DATA ITEM (CFM)
         AI,W8    -2
         STW,W8   CFMDAT
         LW,R2    CFADAT            GET NEXT DATA ITEM (CFA)
         LH,W8    0,R2
         SLS,W8   -8                GET CFA ENTRY LENGTH
         AW,R2    W8
         STW,R2   CFADAT
         LH,W9    0,R2
         MTB,-1   NDATA
         BEZ      MC060             BR IF END OF GROUP
         MTB,0    COMSW
         BEZ      MC050             BR IF PROCESSING MOVES
         LW,W8    COMP2
         STW,W8   MCBUF             SET 1ST WORD OF CLUSTER
MC044    LI,R3    -1
         LH,W9    *CFMDAT,R3        GET T(CFMDAT)
         CI,W9    X'0E'
         BE       MC048             BR IF DATA NAME SUBSCRIPT
         AI,W9    X'40'             TURN ON INTEGER BIT
MC046    SLS,W9   8
         STS,W9   MCBUF             SET T INTO CLUSTER
         LI,R3    BA(MCBUF+1)
         BAL,W13  MC150             ATTACH EHI, ETC.
         LI,R4    BA(MCBUF)
         BAL,W11  WRRGF             WRITE CLUSTER
         B        MC040
MC048    LI,W9    2                 SET FOR DATA NAME SUBSCRIPT
         B        MC046
MC050    LW,W8    MOVE2             SET FOR MOVE
         STW,W8   MCBUF
         B        MC044
MC060    RES      0
         LW,W8    CFAGR
         SLS,W8   1
         AI,W8    4                 POINT AT 1ST DATA CLUSTER
         STW,W8   CFADAT
         MTB,0    COMSW
         BEZ      MC070
         LI,R4    BA(RELCLU)
         BAL,W11  WRRGF             WRITE RELATION CLUSTER
         LW,W8    COMOBJ
         STW,W8   MCBUF
MC064    LI,R3    BA(MCBUF+1)
         BAL,W13  MC150             ATTACH EHI, ETC
         LW,W8    MCBUF+1
         AND,W8   M5                GET J (NO. OF DIMENSIONS)
         BEZ      MC068             BR IF NO SUBSCRIPTS
         LB,W10   MCBUF             GET CLU LENGTH
         LW,W9    W10
         SW,W10   W8
         STB,W10  MCBUF             SET NEW CLU LENGTH
         LW,R3    CFADAT
         AI,R3    8                 POINT AT Q,R,S INFO
         AW,R3    W8                STEP OVER Q,R,S INFO
         AI,W8    9
         SW,W9    W8                W9 CONTAINS A-(J+9)
         LI,R2    HA(MCBUF+4)
MC066    LH,W8    0,R3
         STH,W8   0,R2              ADD EDIT INFO
         AI,R3    1
         AI,R2    1
         BDR,W9   MC066
MC068    LW,W8    MCBUF+1
         AND,W8   M4                SAVE I ANDK FIELDS
         AI,W8    X'B000'           H FIELD=B, REPORT ITEM
         STW,W8   MCBUF+1
         LB,W8    *R5               BASE FOR REP DEFINED 'OLD' FIELD
         SCS,W8   -8
         LI,R2    -3
         LH,R3    *CFMGR,R2
         OR,W8    R3
         STW,W8   MCBUF+2           SET BASE AND DISP INTO CLUSTER
         LI,R4    BA(MCBUF)
         BAL,W11  WRRGF             WRITE CLUSTER
         B        MC080
MC070    LW,W8    MOVOBJ            SET FOR MOVE
         STW,W8   MCBUF
         B        MC064
MC080    RES      0                 SELECT EXTERNAL NAME FOR FALSE JUMP
         MTB,0    COMSW
         BEZ      MC090             BR IF MOVE
         LB,R3    NCONTR
         LB,W9    JFTBL,R3          GET ENTRY POINT LETTER
         LI,R3    3
         STB,W9   JFCLU+2,R3        SET LEVEL IN CLUSTER
         LI,R4    BA(JFCLU)
         BAL,W11  WRRGF             WRITE CLUSTER
MC090    LW,W9    *CFAGR
         LS,W9    ADRMSK            GET U(CFAGR)
*                                   PREPARE TO WORK ON NEXT
         STW,W9   CFAGR             CONTROL LEVEL
         MTB,-1   NCONTR            REDUCE LEVEL
         BGZ      MC020             BR IF NCONTR NOT ZERO
         MTB,0    COMSW
         BEZ      MC100             BR IF MOVE
         LI,R4    BA(JRPT1)
         BAL,W11  WRRGF             WRITE CLU (JUMP TO RPG)
         LI,W8    0
         STB,W8   COMSW             GO THRU ROUTINE AGAIN (COMSW=0)
         B        MC010             FOR MOVES
MC100    LI,R4    BA(JRPT2)         JUMP BACK TO RPG
         BAL,W11  WRRGF             AFTER MOVES
         B        CI171             RETURN               EL34474        COBOL34
*
MC150    RES      0
         LW,R2    CFADAT
         LH,W8    0,R2
         SLS,W8   -8
         STB,W8   MCBUF      SET CLU LENGTH
         AW,W8    W8
         AI,W8    -4                LESS 1ST 4 BYTES
         STB,W8   R3                SET LENGTH OF MOVE
         AI,R2    2                                     EL34373         COBOL34
         AW,R2    R2                BA OF 'FROM' AREA
         MBS,R2   0                 MOVE EHI TO CLUSTER
         B        *W13              RETURN
*
MC300    RES      0                 NO CTL FIELDS EXIT
         LI,R4    BA(JRPT1)
         BAL,W11  WRRGF             OUTPUT JUMP TO RPG CLU
         B        CI171             RETURN               EL34474        COBOL34
         PAGE
*
* MATCH SUBROUTINE
*        MATCHES DESCRIPTOR TRAILERS AGAINST CONTROL FIELD GROUPS IN
*        THE CFM TABLE TO DETERMINE IF DATA ITEM IS ONE OF THE CONTROL
*        FIELDS FOR THIS REPORT. AT ENTRY CGR POINTS TO THE DESCRIPTOR
*        TO BE TESTED. THE SUBROUTINE RETURNS WITH CNLVL CONTAINING
*        THE CONTROL LEVEL NUMBER AT WHICH THE MATCH TOOK PLACE, CMGR
*        POINTS TO THE CFM CONTROL GROUP FOR THAT LEVEL, AND CDAT POINTS
*        TO THE DESCRIPTOR TRAILER FOR THE MATCH.
*
MATCH    RES      0
         MTB,0    MFSW              PROCESSING SUBSCRIPT ONLY?
         BNEZ     MF012             BR IF YES
         LW,R6    CGR
         AI,R6    -2
         LH,W10   0,R6              GET NO. OF TRAILERS
         SLS,W10  -12
         LW,W12   W10               SAVE IN R12
MF012    LW,R7    CFMREP
         AI,R7    -3
         LI,R1    5
         LB,W8    *R7,R1            GET NO. OF CTL LEVELS
         STB,W8   CNLVL
         BEZ      MF050             NO CONTROL FIELDS
         STW,R7   CMGR              POINT AT DVMGR
MF020    AI,R7    -3
        LI,R1     5
         LB,W8    *R7,R1
         STB,W8   NM                NO OF CFM ITEMS
         STW,R7   CMDAT
         MTB,0    MFSW              MATCHING SUBSCRIPTS INDIVIDUALLY?
         BNEZ     MF024             BR IF YES
         LW,R6    CGR
         AI,R6    -6
         STW,R6   CDAT              POINT AT DATA ITEM TO TEST
         STW,R6   MDAT              SAVE ADDR OF 1ST TRAILER
MF024    CB,W10   NM
         BNE      MF040             BR IF NO OF TERMS UNEQUAL
MF030    AI,R6    -1
         LH,W8    0,R6
         CI,W8    X'0400'           IS THIS AN INTEGER SUBSCRIPT?
         BG       MF034             BR IF NO
         AI,R6    -2
         LH,W8    0,R6              CHECK INTEGER ONLY
         AI,R7    -2
        LI,R1     1
         CH,W8    *R7,R1
         BNE      MF040             NOT A MATCH
         B        MF038             MATCH
MF034    AI,R6    -2
         LH,W8    0,R6
         SLS,W8   -8                GET BASE OF TEST ITEM
         AI,R7    -2
         CB,W8    *R7               COMPARE BASES
         BNE      MF040             BR UNEQUAL
         AI,R6    -1
         LH,W8    0,R6              GET DISP OF TEST ITEM
        LI,R1     1
         CH,W8    *R7,R1            COMPARE DISPLACEMENTS
         BNE      MF040
         AI,R6    -2
         LH,W8    0,R6              GET SIZE OF TEST ITEM
         AI,R7    1
         CH,W8    *R7               COMPARE SIZES
         BNE      MF040
MF038    MTB,-1   NM                ALL ITEMS TRIED?
         BEZ      MF048             EXIT IF YES (MATCH)
         LW,R6    CDAT
         AI,R6    -1
         LH,W8    0,R6
         AND,W8   MFF
         AI,W8    -1
         SW,R6    W8
         STW,R6   CDAT
         LW,R7    CMDAT
         AI,R7    -2                ADVANCE TO NEXT
         STW,R7   CMDAT             DATA ITEM
         B        MF030
MF040    MTB,-1   CNLVL             HAVE ALL LEVELS BEEN TESTED?
         BEZ      MF050             EXIT (NO MATCH)
         MTB,0    MFSW
         BEZ      MF044
         LW,R6    CDAT              POINT AT SUBSCRIPT TO BE TESTED
MF044    LW,R5    CMGR
         LW,R7    -3,R5
         STW,R7   CMGR              GO TO NXT CTL LEVEL
         B        MF020
*
MF048    MTB,0    MFSW              CHECKING SUBSCRIPTS?
         BNEZ     MF050             BR IF NO
         LW,W8    MDAT
         STW,W8   CDAT              POINT AT 1ST TRAILER
*
MF050    RES      0
         LI,W8    0
         STB,W8   MFSW              RESET SUBSCRIPT SWITCH
         B        *W14              RETURN TO CALLER
         PAGE
*        POINTERS
*
PRDE     DATA     0                 1ST DE SOURCE ITEM OR REPORT
P01DE    DATA     0                 1ST DE SOURCE FOR THIS 01
P01GRV   DATA     0                 1ST GR IND VALUE FOR THIS 01
PRADD    DATA     0                 1ST ADDEND FOR REPORT
PR01     DATA     0                 1ST 01 DESCRIPTOR FOR REPORT
PC01     DATA     0                 CURRENT 01
PRSUM    DATA     0                 1ST SUM DESCRIPTOR FOR REPORT
*
PSADD    DATA     0                 1ST ADDEND FOR CURRENT SUM
PCURNT   DATA     0                 CURRENT ITEM
PNEXT    DATA     0                 1ST UNUSED POSITION
PDDD     DATA     0                 CURRENT DDD ITEM
DDDNXT   DATA     0                 NEXT DDD ITEM
PCADD    DATA     0                 POINT AT CURRENT ADDEND
PCSUM    DATA     0                 POINT AT CURRENT SUM
PLSUM    DATA     0                 POINT AT PREVIOUS SUM
PLGRV    DATA     0                 LAST GRP IND VAL DESCRIPTOR
PCSRC    DATA     0                 POINT AT CURRENT SOURCE
PLINE    DATA     0                 POINT AT 2 WORD CURRENT LINE INFO
RITSRC   DATA     0
UNDFCF   EQU      PCADD             NO. OF CONTROL FIELDEL34373         COBOL34
CGR      DATA     0                 ITEM FOR CTL FIELD MATCH
CMGR     DATA     0                 CFM GROUP ITEM
CDAT     DATA     0                 DATA ITEM
CMDAT    DATA     0                 CFM DATA ITEM
MDAT     DATA     0                 TRAILER POINTER (HA)
CFMREP   DATA     0                 CURRENT CFM REPORT ENTRY (WA)
CFMGR    DATA     0                 CURRENT CFM GROUP ENTRY (WA)
CFMDAT   DATA     0                 CURRENT CFM DATA ENTRY (WA)
*
CFAGR    DATA     0                 CURRENT CFA GROUP ENTRY (WA)
CFADAT   DATA     0                 CURRENT CFA DATA ENTRY (HA)
*
CLUPTR   DATA     0                 POINTS TO NEXT CRF CLUSTER (BA)
RET14    DATA     0                 RETURN ADDR SAVE AREA
HIST01   DATA     0                 HISTORY SAVE
LOWLIM   DATA     0                 CURRENT LOW CORE LIMIT FOR CFM
*
*        MASKS
MFF      DATA     X'00FF'
M2       DATA     X'0F00'
M3       DATA     X'FF00'
M4       DATA     X'0FF0'
M5       DATA     X'0F'
ADRMSK   DATA     X'1FFFF'
*
*        SWITCHES AND COUNTERS
COMSW    GEN,32   0                 SWITCH FOR MOVCOM (1=COMPARE)
FSW      GEN,32   0                 1=1ST PASS FOR MOVES
GISW     GEN,32   0                  01=GRP IND THIS 01
MFSW     GEN,32   0                 SET TO 01 IF PROCESSING SUBSCRIPTS
NCONTR   GEN,32   0                 NO. OF CTL FIELDS FOR MOVCOM
NDATA    GEN,32   0                 NO. OF DATA ENTRIES
FLG11    DATA     0                 LINE FLAG --SET WHEN LINE SPECIFIED COBOL34
FLG0A    DATA     0                 SOURCE FLAG--SET WHEN SOURCE READ   COBOL34
INC%DEC  DATA     0                 INDEX INCREMENT/DECREMENT FLAG      COBOL34
*
CNLVL    DATA     0                 CONTROL LEVEL NO.
NM       DATA     0                 NO OF CFM TERMS
HVAL     DATA     0                 CURRENT VALUE OF H
SSN      DATA     0                 NO. OF SOURCE SELECTED ITEMS
SUBS     DATA     0                 SUBSCRIPT COUNTER
DBLIN    DATA     0                 LINE NO OF RD FOR DEBUG MODULE      COBOL34
*
*        CLUSTERS  FOR COMPARES
EPCLU    GEN,32   X'08F39996'       ENTRY POINT TAG CLUSTER
REFNO    GEN,32   0
         GEN,32   0
         GEN,32   8
*
COMP1    GEN,32   X'00DC9010'       MOVE AND COMPARE CLUSTER
COMP2    GEN,32   X'0C5C9000'       HEADERS
MOVE1    GEN,32   X'0CDE9000'
MOVE2    GEN,32   X'0C5E9000'
COMOBJ   GEN,32   X'0C5C9080'
MOVOBJ   GEN,32   X'0C5E9081'
*
RELCLU   GEN,32   X'025C2002'       RELATION CLUSTER
*
JFCLU    GEN,32   X'075CE600'       JUMP FALSE CLUSTER
         GEN,32   X'000005C3'
         GEN,32   X'7AD9D900'
         GEN,32   X'00070000'
*
JRPT1    GEN,32   X'06DBA480'       JUMP BACK TO RPG AFTER COMPARES
         GEN,32   X'05C37AD9'
         GEN,32   X'D9D80006'
*
JRPT2    GEN,32   X'06DBA480'       JUMP BACK TO RPG AFTER MOVES
         GEN,32   X'05C37AD9'
         GEN,32   X'D9C50006'
*
JRPT3    GEN,32   X'06DBA480'       JUMP BACK TO RPG (NORMAL MOVES)
         GEN,32   X'05C37AD9'
         GEN,32   X'D9C30006'
*
JFTBL    GEN,32   X'00D9E2E3'       EP CHARACTER FOR FALSE JUMP
         GEN,32   X'E4E5E6E7'
         GEN,32   X'E8E90000'
*
RGT      GEN,32   X'00040206'       TYPE OF 01 ITEM
         GEN,32   X'01050307'
         PAGE
*
*        WORKING STORAGE
*
RDI      RES      9                 RD INFORMATION
*
SAV3     DATA      0                                                    COBOL34
DDDSIZ   DATA     0                 BYTE SIZE OF LARGEST DDD            COBOL34
DDBUF    DATA     0                 BA(CURRENT DDD SEGMENT)
CFA      DATA     0                 WA(CFA TABLE START)
CFM      DATA     0                 WA(CFM TABLE START)
DDSEG    DATA     0                 HOLD DDD CTL SEGMENT
CLUBUF   RES      128               CRF INPUT BUFFER
*
WKBUF    RES      128               RGF OUTPUT BUFFER
MCBUF    EQU      WKBUF
         END
