         SYSTEM   SIG7FDP
*        ADDS
*        SUBROUTINE TO GENERATE ADDS TO SUM ITEMS
*        AT EACH DETAIL AND EACH CF REPORT GROUP.
*             ALSO GENERATE RESETS OF THE SUM FIELDS.
*                 LINKAGE  BAL,11  ADDS
*
         REF      CLUSTR,OBJCL,TAG,JUMP,PR01,WRRGF,SUBJCT
         REF      PRSUM,PRDE,MOVCL
         REF      PDBDBG,DBLIN                                          COBOL34B
         REF      DBSIZE
         REF      TBLSIZE                                               COBOL34B
         REF      NXTSTRNG                                              COBOL34B
         REF      PDBZ                                                  COBOL34B
         REF      PDBZ:OLD
         DEF      ADDS
TBL:SIZ  EQU      TBLSIZE                                               COBOL34B
TBL:ARG  EQU      PDBZ:OLD
R1       EQU      1                                                     COBOL34B
R2       EQU      2                                                     COBOL34B
R3       EQU      3                                                     COBOL34B
R4       EQU      4                                                     COBOL34B
R5       EQU      5                                                     COBOL34B
R6       EQU      6                                                     COBOL34B
R7       EQU      7                                                     COBOL34B
R8       EQU      8                                                     COBOL34B
R9       EQU      9                                                     COBOL34B
R10      EQU      10                                                    COBOL34B
R11      EQU      11                                                    COBOL34B
R12      EQU      12                                                    COBOL34B
R13      EQU      13                                                    COBOL34B
R14      EQU      14                                                    COBOL34B
R15      EQU      15                                                    COBOL34B
ADDS     STW,11   ADEXIT
         LI,2     -1                SET PHASE INDICATOR TO SUM STRING
         STW,2    PHASE
NXPHS    LW,2     PHASE
         AI,2     1
         STW,2    PHASE
         B        PHS,2
PHS      B        LDSMST            SETUP TO SCAN SUM STRING
         B        LDDEST            SETUP TO SCAN DETAIL SOURCE STRING
         LW,4     JUMPS
         BAL,12   JUMP
*
*                                   NOW GENERATE RESET CODE
*
         LI,3     PR01
N01      LW,3     *3
         LS,3     AMASK
         BCR,3    *ADEXIT           EXIT ADDS & RESETS
         LI,2     -7
         LB,9     *3,2              IS LEVEL NON ZERO
         BCR,3    N01               TRY NEXT 01
         LI,2     -23               TEST FOR TYPE CF
         LB,2     *3,2
         CI,2     7
         BCS,3    N01               IF NOT CF
         LI,1     PRSUM
         STW,9    NONTRY            SET FLAG-NO ENTRY POINT GENERATED
         STW,9    LVLL
NSUM     LW,1     *1
         LS,1     AMASK
         BCS,3    GCLEAR            MORE SUMS
         LW,9     NONTRY
         BCS,3    N01               ENTRY HAS NOT BEEN GENERATED
         LI,4     'D'
         BAL,12   JUMP
         B        N01
GCLEAR   LI,2     -3                TEST RESET LEVEL
         LB,10    *1,2
         S,10     X'7F'
         CI,10    0
         BCS,3    TRYRST
         LW,11    -1,1              SEE IF SUM POINTS TO 01
         LS,11    AMASK
         CW,11    3
         BCR,3    MATCHES
TRYRST   CW,10    LVLL
         CW,10    LVLL
         BCS,3    NSUM
MATCHES  LW,10    NONTRY            RESET LEVEL MATCHES 01 LEVEL
         BCR,3    GGLEAR
         BAL,12   TAG               GENERTE TAG FOR ENTRY POINT TO RESET
         LI,7     -9
         STH,10   *3,7
         LI,7     0
         STW,7    NONTRY
GGLEAR   LI,4     BA(MVZR)
         BAL,11   WRRGF
         LW,6     1
         LI,7     HA(MOVCL)
         S,6      1
         AI,6     -7
         LI,15    X'81'
         LI,4     X'5E'
         BAL,11   CLUSTR
         LI,4     BA(MOVCL)
         BAL,11   WRRGF
         B        NSUM
LDSMST   LI,3     PRSUM             POINT TO SUM STRING
         LI,10    'B'
         STW,10   JUMPS
         LI,10    0
         STW,10   LAST01            SAVE ADDRESS OF LAST 01 DESCRIPTOR
NXSM     LW,3     *3
         LS,3     AMASK
         BCR,3    NXPHS             END OF SUM STRING
         LW,7     RMASK                HAS RESET LEVEL BEEN SET
         LS,6     -1,3
         BCS,3    LADDND
         LW,1     -1,3                 SET TO LEVEL OF O1 POINTED TO
         LS,1     AMASK                   BY SUM DESCRIPTOR
         LI,6     -7
         LB,6     *1,6
         S,6      17
         STS,6    -1,3
LADDND   LW,1     -2,3
NADDND   LS,1     AMASK
         BCR,3    NXSM              NO ADDEND-TRY NEXT SUM
         LW,7     -1,3              TEST 01
         LS,7     AMASK
         CW,7     LAST01
         BCR,3    GNADDS            GENERATE ADDS INTO SUMS
         LW,10    LAST01
         BCR,3    NTRY              FIRST TIME
         LW,4     JUMPS             GENERATE GO TO C:RRB
         BAL,12   JUMP
NTRY     BAL,12   TAG               GENERATE ENTRY TAG
         STW,7    LAST01
         AI,7     -2
         LI,6     1                 SAVE REF ADDR OF ADDS
         STH,10   *7,6
GNADDS   LI,4     X'51'
         LI,9     -5                FOR ADCONDS
         BAL,11   SUBJCT
         MTW,0    PDBDBG
         BEZ      OBJADD
         SLS,R4   -1                H.A. OF SUBJECT CLUSTER
         AI,R4    4
         LH,R7    0,R4              PICK UP DISPLACEMENT
         AI,R4    1
         LH,R6    0,R4              PICK UP DISPL
         STH,R7   R6
         STW,R6   DBR4              SAVE BASE, DISPL FOR DEBUG
OBJADD   LW,7     -1,1              POINT TO SUM FIELD DESCRIPTION
         LS,7     AMASK
         LW,6     7
         S,6      1
         AI,6     -7
         LI,15    X'81'
         LI,4     X'51'
         LI,7     HA(MOVCL)
         BAL,11   CLUSTR
         LI,4     BA(MOVCL)
         BAL,11   WRRGF
         BAL,R10  DBSUM             SEE IF THIS IS A DEBUG ITEM         COBOL34B
         LW,1     -2,1
         B        NADDND
LDDEST   LW,4     JUMPS
         BAL,12   JUMP
         LI,3     PRDE
         LI,10    'F'
         STW,10   JUMPS
         B        NXSM
DBSUM    RES      0                                                     COBOL34B
         MTW,0    PDBDBG            SEE IF DEBUG MODE SET               COBOL34B
         BEZ      *R10              NO--RETURN                          COBOL34B
         LCI      15                                                    COBOL34B
         STM,R1   SAVREG            SAVE REGISTERS                      COBOL34B
*  CHECK ITEM TO SEE IF IT IS A DEBUG ITEM                              COBOL34B
*  R4 = BYTE ADDRESS OF ADD CLUSTER UPON ENTERING                       COBOL34B
*  USE BASE DISP TO SEARCH TABLE                                        COBOL34B
         LI,R4    0                                                     COBOL34B
         LW,R5    DBR4
         BAL,R10  CKDATA            CHECK TABLE FOR DEBUG ITEM          COBOL34B
         B        DATNAM6           EXIT--NO DEBUG                      COBOL34B
*     SAVREG+3 CONTAINS THE ADDRESS OF THE OBJECT CLUSTER WHICH IS USED
*     FOR GENERATING THE DEBUG-CONTENTS FIELD, R2 IS SET  = TO THIS
         LW,R2    SAVREG+3          RESTORE R4 INTO R4                  COBOL34B
         LW,R4    DBPTR                                                 COBOL34B
         STW,R4   DBPTRE            INITIALIZE POINTER                  COBOL34B
         LW,R5    R2                                                    COBOL34B
         SLS,R5   -1                                                    COBOL34B
         AI,R5    7                 POINT AT P (SIZE OF ITEM)           COBOL34B
         LH,R4    0,R5              SET UP FOR BUILDING SIZE CLUSTER    COBOL34B
         BAL,R10  PROC2A            PUT IN STACK,NOTE SIZE2 = SIZE      COBOL34B
         BAL,R10  PROC4             DO LINE NUMBER CLUSTER              COBOL34B
         BAL,R10  DBNAME            DO NAME CLUSTERS                    COBOL34B
*  DO SFLD FOR DEBUG CONTENTS                                           COBOL34B
         LW,R12   R2                                                    COBOL34B
         LW,R13   DBPTRE                                                COBOL34B
         LB,R4    0,R2                                                  COBOL34B
         SLS,R4   1                 BYTE SIZE
         STB,R4   R13               STORE FOR MBS
         LW,R3    R2
         AI,R3    1
         LI,R4    X'DE'
         STB,R4   0,R3              CHG CTRL BYTE
         AI,R3    2
         LI,R4    0
         STB,R4   0,R3              CLEAR STM OPTS
         MBS,R12  0                 MOVE CLUSTER TO STACK
         STW,R13  DBPTRE            UPDATE POINTER
*  GENERATE RFLD FOR DEBUG CONTENTS                                     COBOL34B
DATNAM1  RES      0                                                     COBOL34B
         LW,R5    SIZE2             PROC2A STORED SIZE HERE             COBOL34B
         STW,R5   MOVE8                                                 COBOL34B
         LW,R5    PDBDBG                                                COBOL34B
         AW,R5    DISP6             OFFSET FOR DEBUG-CONTENTS           COBOL34B
         STW,R5   MOVE7                                                 COBOL34B
         LI,R12   BA(MOVE5)                                             COBOL34B
         LW,R13   DBPTRE                                                COBOL34B
         OR,R13   COUNT20                                               COBOL34B
         MBS,R12  0                                                     COBOL34B
         STW,R13  DBPTRE                                                COBOL34B
DATNAM5  RES      0                                                     COBOL34B
         BAL,R10  PERFUSE           BUILD PERFORM DECL SECT CODE        COBOL34B
         BAL,R10  WRT%DBSK          WRITE DEBUG CLUSTERS                COBOL34B
DATNAM6  RES      0                                                     COBOL34B
         LCI      15                                                    COBOL34B
         LM,R1    SAVREG                                                COBOL34B
         B        *R10              RETURN                              COBOL34B
PROC2A   RES      0                                                     COBOL34B
         STW,R4   SIZE2                                                 COBOL34B
         CW,R4    DBSIZE            SEE IF SIZE OF DB CONTENTS > OLD SIZ
         BL       *R10              NO                                  COBOL34B
         STW,R4   DBSIZE            YES
         B        *R10              RETURN (IF USED AS SUBROUTINE)      COBOL34B
PROC4    RES      0                                                     COBOL34B
*        MOVE LINE NUMBER                                               COBOL34B
         LI,R12   0                 CLEAR DECA                          COBOL34B
         STW,R12  R13                                                   COBOL34B
         LW,R14   DBLIN             LINE NUMBER                         COBOL34B
         CVS,R14  CVRTBL            CONVERT TO PACFED                   COBOL34B
         BAL,R11  CVREBCD           CONVERT TO EBCDIC                   COBOL34B
         LW,R4    MOVE3             STRING CLUSTER                      COBOL34B
         STW,R4   DBBUILD                                               COBOL34B
         LW,R4    BCDLIN1           BUILD STRING                        COBOL34B
         STW,R4   DBBUILD+1                                             COBOL34B
         LW,R4    BCDLIN2           BUILD STRING                        COBOL34B
         STW,R4   DBBUILD+2                                             COBOL34B
         LI,R12   BA(DBBUILD)                                           COBOL34B
         LW,R13   DBPTRE                                                COBOL34B
         OR,R13   COUNT12           SIZE FOR MBS                        COBOL34B
         MBS,R12  0                 MOVE TO STACK SFLD                  COBOL34B
         LW,R4    PDBDBG                                                COBOL34B
         STW,R4   MOVE7                                                 COBOL34B
         LI,R4    6                                                     COBOL34B
         STW,R4   MOVE8             RFLD SIZE                           COBOL34B
         LI,R12   BA(MOVE5)                                             COBOL34B
         OR,R13   COUNT20                                               COBOL34B
         MBS,R12  0                                                     COBOL34B
         STW,R13  DBPTRE            UPDATE POINTER                      COBOL34B
         B        *R10              RETURN (IF USED AS SUBROUTINE)      COBOL34B
DBNAME   RES      0                                                     COBOL34B
*  PUT DEBUG NAME IN STACK                                              COBOL34B
         LW,R5    T:ENTRY                                               COBOL34B
         AI,R5    2                 POINT AT FLD E  (POINTER TO NAME)   COBOL34B
         LW,R12   *R5                                                   COBOL34B
DBNAME1  RES      0                                                     COBOL34B
         LW,R4    MOVE3                                                 COBOL34B
         STW,R4   DBBUILD                                               COBOL34B
         LI,R13   BA(DBBUILD+1)                                         COBOL34B
         LW,R1    R12                                                   COBOL34B
         LB,R4    0,R1                                                  COBOL34B
         AI,R4    1                                                     COBOL34B
         STB,R4   R13                                                   COBOL34B
         MBS,R12  0                                                     COBOL34B
         SLS,R4   -1                                                    COBOL34B
         AI,R4    3                 H.W. SIZE +3                        COBOL34B
         STB,R4   DBBUILD                                               COBOL34B
         LW,R13   DBPTRE                                                COBOL34B
         LI,R12   BA(DBBUILD)                                           COBOL34B
         SLS,R4   1                                                     COBOL34B
         STB,R4   R13                                                   COBOL34B
         MBS,R12  0                 PUT SFLD IN STACK                   COBOL34B
         LW,R5    PDBDBG            PUT RFLD FOR NAME IN STACK          COBOL34B
         AW,R5    DISP2                                                 COBOL34B
         STW,R5   MOVE7                                                 COBOL34B
         LW,R5    MOVE10                                                COBOL34B
         STW,R5   MOVE8                                                 COBOL34B
         LI,R12   BA(MOVE5)                                             COBOL34B
         OR,R13   COUNT20                                               COBOL34B
         MBS,R12  0                                                     COBOL34B
         STW,R13  DBPTRE                                                COBOL34B
         B        *R10                                                  COBOL34B
* WRITE  PERFORM USE CLUSTER                                            COBOL34B
PERFUSE  RES      0                                                     COBOL34B
         LI,R1    1                                                     COBOL34B
         LW,R4    T:ENTRY           TABLE ENTRY POINTER                 COBOL34B
         AI,R4    3                                                     COBOL34B
         SLS,R4   1                                                     COBOL34B
         LH,R5    0,R4              PNO                                 COBOL34B
         STH,R5   PERFCRF1,R1                                           COBOL34B
         AI,R4    1                                                     COBOL34B
         LH,R5    0,R4              XNO                                 COBOL34B
         STH,R5   PERFCRF2                                              COBOL34B
         LI,R12   BA(PERFCRF)       MOVE PERFORM CLUSTER TO STACK       COBOL34B
         LW,R13   DBPTRE                                                COBOL34B
         OR,R13   COUNT12                                               COBOL34B
         MBS,R12  0                                                     COBOL34B
         STW,R13  DBPTRE            UPDATE POINTER                      COBOL34B
         B        *R10              RETURN                              COBOL34B
WRT%DBSK RES      0                                                     COBOL34B
         LW,R3    DBPTRE            LAST ENTRY IN STACK                 COBOL34B
         LW,R4    DBPTR                                                 COBOL34B
         CW,R4    R3
         BE       WRT%EX                                                COBOL34B
         LW,R5    R4                SAVE IN R5                          COBOL34B
         LB,R6    0,R4              HALFWORD SIZE                       COBOL34B
WRT1     RES      0                                                     COBOL34B
         BAL,R11  WRRGF             WRITE CLUSTER                       COBOL34B
         SLS,R6   1                 SIZE OF LAST CLUSTER TO BYTES       COBOL34B
         AW,R5    R6                ADD TO STACK ADDRESS                COBOL34B
         CW,R5    R3                COMPARE WITH LAST ENTRY             COBOL34B
         BGE      WRT%EX            GREATER--FINISHED                   COBOL34B
         LB,R6    0,R5              NEW SIZE OF CLUSTER                 COBOL34B
         LW,R4    R5                POINTER FOR WRCRF                   COBOL34B
         B        WRT1                                                  COBOL34B
WRT%EX   RES      0                                                     COBOL34B
         LW,R5    DBPTR                                                 COBOL34B
         STW,R5   DBPTRE                                                COBOL34B
         B        *R10              RETURN                              COBOL34B
CVREBCD  RES      0                                                     COBOL34B
         LI,R3    BA(BCDLIN1)                                           COBOL34B
         UNPK,4   0,R3                                                  COBOL34B
         LI,R3    6                                                     COBOL34B
         STB,R3   BCDLIN1           PUT SIZE IN                         COBOL34B
         LW,R3    BCDLIN2                                               COBOL34B
         OR,R3    MSK3                                                  COBOL34B
         STW,R3   BCDLIN2                                               COBOL34B
         B        *R11              RETURN                              COBOL34B
CKDATA   RES      0                                                     COBOL34B
*    CHECK DATA ROUTINE VALIDATES ITEM FOR DEBUGGING                    COBOL34B
*    R4 = 1ST WORD OF SCH ARG                                           COBOL34B
*    R5 = 2ND WORD OF SCH ARG                                           COBOL34B
*    T:ENTRY = ADDRESS OF FOUND ITEM                                    COBOL34B
         STD,R4   T:ARG             SAVE ARGUMENTS                      COBOL34B
         LI,R1    0                                                     COBOL34B
         B        P:FOUND1                                              COBOL34B
P:SCH02  RES      0                                                     COBOL34B
         AI,R1    4                 NO MATCH TRY NEXT                   COBOL34B
         CW,R1    TBL:SIZ                                               COBOL34B
         BLE      P:FOUND1                                              COBOL34B
         B        *R10              TABLE ENDED GO BACK TO NOT FOUND PT COBOL34B
P:FOUND1 RES      0                                                     COBOL34B
         STW,R1   T:ENTRY           SET ADDRESS OF FOUND ITEM           COBOL34B
         AI,R1    1                                                     COBOL34B
         LW,R4    *TBL:ARG,R1                                           COBOL34B
         CW,R4    T:ARG+1           COMPARE 2ND WORD                    COBOL34B
         BE       P:FOUND2                                              COBOL34B
         AI,R1    -1                                                    COBOL34B
         B        P:SCH02                                               COBOL34B
P:FOUND2 RES      0                                                     COBOL34B
         LW,R4    TBL:ARG                                               COBOL34B
         AWM,R4   T:ENTRY           RETURN TABLE ADDRESS                COBOL34B
         AI,R10   1                 ** ENTRY FOUND **                   COBOL34B
         B        *R10              EXIT TO BAL + 2                     COBOL34B
CVRTBL   DATA     8000000           CONVERSION TABLE                    COBOL34B
         DATA     4000000                                               COBOL34B
         DATA     2000000                                               COBOL34B
         DATA     1000000                                               COBOL34B
         DATA     800000                                                COBOL34B
         DATA     400000                                                COBOL34B
         DATA     200000                                                COBOL34B
         DATA     100000                                                COBOL34B
         DATA     80000                                                 COBOL34B
         DATA     40000                                                 COBOL34B
         DATA     20000                                                 COBOL34B
         DATA     10000                                                 COBOL34B
         DATA     8000                                                  COBOL34B
         DATA     4000                                                  COBOL34B
         DATA     2000                                                  COBOL34B
         DATA     1000                                                  COBOL34B
         DATA     800                                                   COBOL34B
         DATA     400                                                   COBOL34B
         DATA     200                                                   COBOL34B
         DATA     100                                                   COBOL34B
         DATA     80                                                    COBOL34B
         DATA     40                                                    COBOL34B
         DATA     20                                                    COBOL34B
         DATA     10                                                    COBOL34B
         DATA     8                                                     COBOL34B
         DATA     4                                                     COBOL34B
         DATA     2                                                     COBOL34B
         DATA     1                                                     COBOL34B
         DATA     0                                                     COBOL34B
         DATA     0                                                     COBOL34B
         DATA     0                                                     COBOL34B
         DATA     0                                                     COBOL34B
         RES      0                                                     COBOL34B
SAVREG   RES      15                SAVE REGISTERS                      COBOL34B
DBBUILD  RES      10                                                    COBOL34B
BCDLIN1  DATA     0                 FIRST 3 POS OF LINE NUMBER WITH CNT COBOL34B
BCDLIN2  DATA     0                 NEXT 3 POS (LINE NO = 6 POS)        COBOL34B
T:ENTRY  DATA     0                 POINTER TO TABLE ENTRY              COBOL34B
DBSTACK  RES      100                                                   COBOL34B
DBPTR    DATA     BA(DBSTACK)       STACK POINTER                       COBOL34B
DBPTRE   DATA     0                 LAST ENTRY IN STACK                 COBOL34B
PERFCRF  DATA     X'06E19480'                                           COBOL34B
PERFCRF1 DATA     X'00000000'                                           COBOL34B
PERFCRF2 DATA     X'0000FF06'                                           COBOL34B
MOVE3    DATA     X'06DEB000'       FOR LINE NO                         COBOL34B
MOVE5    DATA     X'0A5E9081'       A,B,C,D  FIELDS FOR MOVE TO         COBOL34B
MOVE6    DATA     X'00005100'       E,H,I,J (LABEL RECORD,ALPHANUM)     COBOL34B
MOVE7    DATA     X'0A000000'       BASE DISP (CHANGES PER ITEM)        COBOL34B
MOVE8    DATA     X'00000006'       P (SIZE OF ITEM--RFLD)              COBOL34B
MOVE9    DATA     X'FF0A'           FILLER                              COBOL34B
MOVE10   DATA     X'0000001E'       SIZE FOR P FIELD OF NAME FILED      COBOL34B
SIZE2    DATA     0                                                     COBOL34B
DISP2    DATA     7                 AW FOR DISP OF DEBUG-NAME           COBOL34B
DISP6    DATA     53                AW FOR DISPL OF CONTENTS            COBOL34B
         BOUND    8                                                     COBOL34B
T:ARG    RES      2                                                     COBOL34B
DBR4     DATA     0                 SAVE SUBJ ADDRESS
COUNT10  DATA     X'0A000000'                                           COBOL34B
COUNT12  DATA     X'0C000000'                                           COBOL34B
COUNT20  DATA     X'14000000'                                           COBOL34B
MSK3     DATA     X'F000'                                               COBOL34B
PHASE    DATA     0
RMASK    DATA     X'00FE0000'
NMASK    DATA     X'000000FF'
ADEXIT   DATA     0
LAST01   DATA     0
AMASK    DATA     X'0001FFFF'
MVZR     DATA     X'03DE3000'       MOVE ZEROS SUBJ CLUSTER
         DATA     X'00030000'
NONTRY   DATA     0
LVLL     DATA     0
JUMPS    DATA     0
         END
