         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.2 - ADD,SUBTRACT'
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RMCF     CNAME    1                                                     APR01
         PROC                                                           APR04
LF       BAL,L1   RDMCF             READ MCF CLUSTER
         SLS,R2   -1                BA(CLOC) TO HA
         DO       NUM(AF(1))                                            APR30
         LW,AF(1) R2                LOAD HA(CLOC)+/- HW OFFSET          APR31
         DO       NUM(AF(2))                                            APR40
         AI,AF(1) AF(2)                                                 APR41
         ELSE                                                           APR42
         AI,AF(1) -1                SET HA(CLOC)-1
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
         PROC                                                           APW03
         DO       NUM(AF(2))                                            APW11
LF       LI,R4    AF(2)             LOAD BA(CLOC)                       APW12
         ELSE                                                           APW13
         DO       NUM(AF(1))                                            APW132
LF       LW,R4    AF(1)             LOAD,SET HA(CLOC) TO BA             APW14
         AW,R4    R4                                                    APW15
         FIN                                                            APW16
         FIN                                                            APW17
         DO       NUM(AF(3))                                            APW821
         LI,L1    AF(3)             LOAD LINK REGISTER                  APW822
         B        WRPOF             TO WRITE  POF  CLUSTER              APW823
         ELSE                                                           APW824
         DO       NUM(AF(4))                                            APW840
         B        WRPOF             WRITE POF CLUSTER                   APW841
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         PEND                                                           APW90
* DIAG PROC                                                             APD
DX       CNAME                                                          APD00
         PROC                                                           APD01
* AF     DX       DIAG CODE,LINK                                        APD02
LF       LI,R1    AF(1)             LOAD DIAG CODE                      APD10
         DO       NUM(AF(2))                                            APD20
         LI,L1    AF(2)             LOAD LINK REGISTER                  APD21
         B        DIAG              WRITE DMF CLUSTER                   APD22
         ELSE                                                           APD24
         DO       NUM(AF(3))                                            APD241
         B        DIAG              WRITE DMF CLUSTER                   APD242
         ELSE                                                           APD243
         BAL,L1   DIAG              WRITE DMF CLUSTER                   APD244
         FIN                                                            APD248
         FIN                                                            APD29
         PEND                                                           APD40
* LINK(OR LOAD) AND BRANCH PROC                                         APL
* LF     LAB,L/R  BRANCH ADDRESS,LINK ADDRESS(OR LOAD VALUE)            APL  1
LAB      CNAME                                                          APL01
         PROC                                                           APL04
LF       LI,CF(2) AF(2)             SET LINK REGISTER                   APL12
         B        AF(1)             BRANCH                              APL14
         PEND                                                           APL90
* LOAD,BRANCH AND LINK                                                  PRL
LBAL     CNAME    0                                                     PRL01
         PROC                                                           PRL02
* LF     LBAL,L-  BRANCH,LOAD VALUE,V-                                  PRL09
         DO       NUM(AF(3))                                            PRL20
         LI,AF(3) AF(2)             LOAD VALUE                          PRL22
         ELSE                                                           PRL23
         LI,V0    AF(2)             LOAD VALUE                          PRL24
         FIN                                                            PRL28
         DO       NUM(CF(2))                                            PRL40
         BAL,CF(2) AF(1)            BRANCH                              PRL42
         ELSE                                                           PRL43
         BAL,L1   AF(1)             BRANCH                              PRL44
         FIN                                                            PRL48
         PEND                                                           PRL99
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      BAA40,BAA42       SAVE DATA
         REF      BDE00             EXPRESSION ROUTINE
         REF      PIA00,PIA02,PIA06,PIA08,PIA20,PIA22,PIA26,PIA28
         REF      PII00,PII02,PII20,PII22
         REF      PIL00,PIL02,PIL06,PIL20,PIL22,PIL26
         REF      PID10,PID11,PID12,PID14,PID16,PID18
         REF      PIP00,PIP02,PIP20,PIP22
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PRB00,PRB02,PRB06,PRB20,PRB22,PRB26
         REF      PRC06
         REF      PRE00,PRE01,PRE02,PRE20,PRE21,PRE22
         REF      PRF00,PRF02,PRF06
         REF      PRG00,PRG02,PRG06,PRG20,PRG22,PRG26
         REF      PRT00,PRT02,PRT06,PRT20,PRT22,PRT26
         REF      PDB00,PDB02,PDB06
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDL10,PDL12,PDL16
         REF      PPI10,PPI11,PPI12
         REF      PIX06,LDR00,LIT00,LRN00
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      LRA00,LRA01,LRA02
         REF      LRR00,LRR01,LRR02
         REF      LRD00,LRD01
         REF      LRD10,LRD11,LRD20,LRD21
         REF      LRD40,LRD41,LRD42
         REF      LRD60,LRD61,LRD62,LRD80,LRD81,LRD82
         REF      LRL00,LRL01
         REF      MRR10,MRR11,MRR12
         REF      MRR40,MRR41,MRR42
         REF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
*
         REF      NRR40,NRR41,NRR42
         REF      NRR60,NRR61,NRR62,NRR80,NRR81,NRR82,NRR70
         REF      NRD00,NRD01,NRD02
         REF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         REF      ORD12,ORD22,ORD23,ORD24
         REF      ORD42,ORD44,ORD48
         REF      MTL20
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
         REF      MDF65
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      MCBUF,MDBUF
         REF      JDECP,JDSIZ       DECP,DSIZ
         REF      BAA46,VPP10,VPP30
         REF      VBIDX,NOVF,LITF
         REF      VRPPD,VRPMD,ARTHF
         REF      JSXR,RFLDF,VPP50
         REF      SCCBD                                                 COBOL42F
JUNSD    EQU      JDSIZ+21          UNSIGNED FLAG
* REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
R8       EQU      8
R9       EQU      9
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
RE       EQU      4                 EVEN
RO       EQU      5                 ODD
RB       EQU      R6                BIN
RFL      EQU      V0                FLP
RF       EQU      V2                FILE CNTL
RS       EQU      V2                SIGN - EDIT
RC       EQU      L1                %
P1       EQU      V2                PREG 1
SR1      EQU      8                 SR1
SR3      EQU      X'A'              SR3
* BA(D-)
CBD0     EQU      X'30'
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'3C'
* INDEX REGISTERS                                                       CIR
CIR1     EQU      2                                                     CIR1
CIR2     EQU      4                                                     CIR2
CIR3     EQU      6                                                     CIR3
CIR4     EQU      8                                                     CIR4
CIR5     EQU      X'A'                                                  CIR5
CIR6     EQU      X'C'                                                  CIR6
CIR7     EQU      X'E'
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRR8     EQU      X'80'
CRR9     EQU      X'90'
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
CRD0     EQU      X'C0'                                                 CR12
CRD1     EQU      X'D0'                                                 CR13
CRD2     EQU      X'E0'                                                 CR14
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRFL     EQU      CRV0              FLP
CRF      EQU      CRV2              FILE CNTL
CRS      EQU      CRV2              SIGN - EDIT
CRC      EQU      CRL1              %
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES
CLCI     EQU      X'0220'
CCAL1    EQU      X'0400'           CAL1
CLD      EQU      X'1200'                                               C12
CSTD     EQU      X'1500'
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CLI1     EQU      X'2210'           LI,1                                C221
CMI      EQU      X'2300'
CSF      EQU      X'2400'                                               C24
CS       EQU      X'2500'                                               C25
CAW      EQU      X'3000'
CSTW     EQU      X'3500'           STW                                 C35
CLW      EQU      X'3200'                                               C32
CXW      EQU      X'4600'           XW
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
CSAS     EQU      X'400'            RA SETING - SAS                     C484
CSDA     EQU      X'500'            RA SETTING - SAD                    C485
COR      EQU      X'4900'           OR                                  C49
CAND     EQU      X'4B00'
CLAH     EQU      X'5B00'
CMBS     EQU      X'6100'
CBDR     EQU      X'6400'                                               C64
CEXU     EQU      X'6700'                                               C67
CBR      EQU      X'6800'           B                                   C68
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CBL      EQU      X'6910'           BL                                  C691
CBNE     EQU      X'6930'           BNE,BNEZ
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CPACK    EQU      X'7600'                                               C76
CUNPK    EQU      X'7700'
CDSA     EQU      X'7C00'
CDL      EQU      X'7E00'                                               C795
CDST     EQU      X'7F00'
CIND     EQU      X'8000'           INDIRECT BIT                        C900
CFAS     EQU      X'3D00'
CSW      EQU      X'3800'
CFSS     EQU      X'3C00'
CFSL     EQU      X'1C00'
CDA      EQU      X'7900'
CDS      EQU      X'7800'
CDM      EQU      X'7B00'
CAWM     EQU      X'6600'
CMW      EQU      X'3700'
CFMS     EQU      X'3F00'
CFML     EQU      X'1F00'
CDW      EQU      X'3600'
CFDS     EQU      X'3E00'
CFDL     EQU      X'1E00'
CB       EQU      X'6800'
CBOV     EQU      X'6940'
CBNOV    EQU      X'6840'
CDD      EQU      X'7A00'
* POF CLUSTER CLNG,CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           CONSTANT
DAID     EQU      X'0609'           DATA
DAII     EQU      X'0402'           INTERNAL LABEL
DAIL     EQU      X'0406'           LOC. CNTR
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIX     EQU      X'0108'           XREF
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARB     EQU      X'0417'           BRANCH TABLE
DARE     EQU      X'0415'           EXIT TABLE
DARF     EQU      X'41A'            FILE LABEL
DARG     EQU      X'0414'           GLOBAL LITERALS
DARL     EQU      X'0418'           LOCAL LITERALS
DART     EQU      X'0417'           TEMP STG
* DATA DEF
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADL     EQU      X'0626'           LOC. CNTR
* DEFINITIONS/DECLARATIONS
DADX     EQU      X'0328'           EXTERNAL NAME
DAPI     EQU      X'0341'           INTERNAL LABEL
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
* GLOBAL LITERAL BA DISPL - BASE 4
DGZRO    EQU      0                 ZERO
DGSPC    EQU      1                 SPACE
DGQUO    EQU      2                 QUOTE
DGLV     EQU      3                 LOW-VALUE
DGHV     EQU      4                 HIGH-VALUE
DGAST    EQU      6                 ASTERISK
* REGISTER SAVE LEVELS
DSS      EQU      1                 SUBSCRIPT
DSL      EQU      2                 STORE
DSG      EQU      4                 GENERATOR
* TEMP REGISTER SAVE AREAS
DTB      EQU      9                 BIN
DTF      EQU      18                FLP
DTCSX    EQU      20                CORRESPONDING SXR1,SXR2
DTD1     EQU      10                DECA - SUBSCRIPT
DTD2     EQU      14                DECA - STORE
DTD4     EQU      22                DECA - GENERATORS
ADT1     EQU      DTD4
AOVFLG   EQU      DTD4+4
DTWA     EQU      28
ADT2     EQU      DTWA
ADT3     EQU      DTWA+4
*
*
* ENTRY POINTS
         DEF      BBG00             ADD,SUBTRACT
         DEF      BBH00             COMPUTE
         DEF      BOVSE             BOV FOR SIZE ERROR
*        TEMP DEFS
         DEF      CDECP
         DEF      CSIZE
         DEF      DUBL
         DEF      RSHFT
         DEF      STMTYP
         DEF      SUBTHND
*        PERMANENT EXPRESSION ENTRIES
         DEF      BBFDAD
         DEF      BBFDMD
         DEF      BBFDDI
         DEF      BBFDDB
         DEF      BBFBSD
BBG00    RES      0
         B        SC00
BBH00    RES     0        COMPUTE
*         COMPUTE
         BAL,L1   IN00              SIMPLE INITIALIZATION
         LI,D0    1
         STW,D0   COMPFLG           SET EXPRESSION COMP FLAG
*
         RMCF     R5                SKIP EXP CLUSTER
*
         BAL,L1   BDE00             EXPRESSION
         B        GV00              GIVE  AANSWERS
*
*        4.2   ARITHMETIC MASTER ENTRY
*
*
SC00     RES      0
*
         BAL,L1   IN00              SIMPLE INTITALIZATION
         LW,R1    MCBUF
         AND,R1   K260
         BEZ      SC10             ADD SUBTRACT
         SLS,R1   -13
         STW,R1   STMTYP
         B        MP00              MULTIPLY DIVIDE
*       ADD   SUB
SC10     RES      0
         LW,R1    MCBUF
         AND,R1   K301              0,1 STMTYP
         STW,R1   STMTYP
         B        AB00
*
AREXIT   RES      0
         LW,D0    SZECLUP
         BNEZ     ARX10             SIZE ERROR CLEANED UP
*        SIZE ERROR NOT CLEANED UP
         STW,D0   NTOT              ZERO
         BAL,L1   JNOVT
ARX10    RES      0
*     4.2 ALL DONE
         LI,D0    0
         STW,D0   OSE0
         B        BAA02
*
*
*
*        4.2
*        ADD
AB00     RES      0
*        SUBTRACT
AB01     RES      0
AB02     RES      0
*
AB05     RES      0
         LW,D0    NBIN
         BEZ      AB10
         LI,R3    0                 BINARY
         BAL,L1   ASBSL
AB08     RES      0
         LW,D0    NFLS
         BNEZ     AB085
         LW,D0    NFLL
         BEZ      AB087
*        FLOATING LONG
         LI,R6    X'8F'
         BAL,L1   BFD00
         B        AB17
*        FLS PRESENT
AB085    LI,R6    X'2F'
         BAL,L1   BFD00
AB087    RES      0
*
AB10     RES      0
         LW,D0    NFLS
         BEZ      AB15
         LI,R3    1                 FLS
         BAL,L1   ASBSL
*
AB13     RES      0
         LW,D0    NBIN
         BEZ      AB14
*        BINARY AND FLS
         BAL,L1   PIA06             GENERATE
         LI,R9    0
         BAL,L1   PIA06
         FAL,R8   R2
*
*        BAL,L1   B0VSE             IMPOSSIBLE
         B        AB143
*        NO BINARY
AB14     RES      0
         LW,D0    NFLL
         BEZ      AB20
*        FLL AND FLS
         BAL,L1   PIA06
         LI,R9    0
AB143    RES      0
         LI,D0    0
         STW,D0   NBIN
         STW,D0   NFLS
*        NOW SEE IF FLOATING LONG
*        IF SO GO IMM TO FAL
*        ELSE SET FLL
AB145    RES      0
         LW,D0    NFLL
         BNEZ     AB17
*        N0 FLL
         B        AB19              SET FLL
AB15     RES      0
         LW,D0    NFLL
         BEZ      AB20
         LI,R3    2                 FLL
         BAL,L1   ASBSL
         B        AB19
*        FLL      (BIN OR FLS ALREADY IN R6-7 AS FLL)
AB17     RES      0
         LW,D0    NFLL
         LI,R3    2                 FLL
         BAL,L1   ASBSL6            SPECIAL
AB19     RES      0
         MTW,1    NFLL              AS FLAG ONLY
*
AB20     RES      0
         LW,D0    NDEC
         BEZ      AB37
         BAL,L1   READMCF
*
*
AB21     RES      0
         LI,R6    X'88'             LOAD DECA
         BAL,L1   LD00
         LD,D0    BSIZE
         STD,D0   CSIZE             SIZ,DP CURRENT
*
*
AB22     RES      0
         MTW,-1   NDEC
         BEZ      AB25
*        ANOTHER DECIMAL
         BAL,L1   READMCF
*
AB23     RES      0
         BAL,L1   DADSS             ADD TO THE DECA
         B        AB22
*
AB25     RES      0
         BAL,R1   XAMD00
AB255    RES      0
         LW,D0    NFLL
         BNEZ     AB31
         LW,D0    NFLS
         BNEZ     AB30
         LW,D0    NBIN
         BNEZ     AB35
*        DEC RESULT
         B        AB37
*        FLS
AB30     RES      0
         BAL,L1   PIA06
         LI,R9    0
*        FLL
AB31     RES      0
         LI,R6    X'2F'             R2 FLL
         BAL,L1   LDR67
*        V1 IS DSIZ -DDECP
         CI,V1    75
         BL       AB32
         BAL,L1   B0VSE
AB32     RES      0
         BAL,L1   PIA06
         FAL,R8   R2
         LW,D0    DDECP
         CI,D0    44
         BL       AB37        NO OVERFLOW POSSIBLE
         BAL,L1   B0VSE
         B        AB37
*        BINARY AND DECIMAL
AB35     RES      0
         BAL,L1   PRT06
         DST,0    ADT2
         LI,R6    X'8'
         BAL,L1   BFD00             BZN TO DECA INTEGER
AB36     LI,R2    HA(DT2CL)
         LW,R5    R2
         AI,R5    -1
         LW,D0    DSIZE
         STH,D0   3,R5              DIGIT
*        LEAVE BYTE SIZE ZERO AS FLAG FOR DT2 BIN DEC FULL DECA
         LI,D0    0
         STH,D0   3,R2              BYTE
         LW,D0    DDECP
         STH,D0   4,R5
         BAL,L1   BSD00             DT2 CLUSTER
         LI,D0    10
         LI,D1    0
         STD,D0   CSIZE
         STW,D0   SUBTHND           FORCE ADD
         BAL,L1   DADSS
*
AB37     RES      0
         LW,D0    GIV0P
         BNEZ     GV00              GIVE
         LW,D0    FRT0P
         BNEZ     PR00              PARTIAL RESULT
*        SET SWITCHES FOR SPECIAL GIVE
*        SET UP SPECIAL GIVE
AB39     RES      0
         LI,D0    0
         STW,D0   NDESC
         STW,D0   NASC
         STW,D0   NBIN
         STW,D0   NFLS
         STW,D0   NFLL
         STW,D0   NDEC
         STW,D0   MANYOPS
         LI,D0    1
         STW,D0   GIVOP
         STW,D0   NTOT
         LW,R6    CLSHFT          0,1,2,3  B,FLS,FLL,DEC
         STW,D0   NBIN,R6
         STW,D0   SPGIVE
         B        SPGV00
*
*        BAL,L1   R6 LOADED
*        BINARY TO FLOATING OR DECA
BFD00    RES      0
AB70     LI,R7    X'D'              BIN
         LI,D1    X'9D'
         LI,V1    0
         LW,L0    L1                FIXUP
         B        LRR01             BIN TO FLL
*
*        ADD/SUB  BIN,FLS,FLL
*        D0       N0PS THIS TYPE
*        R3       0PNDX             0,1,2
*        BAL,L1   ASBSL
*        BAL,L1   ASBSL6            SPECIAL - NO INITIAL LOAD
ASBSL    RES      0
         BAL,L0   ASBSLY            PARAMS
         BAL,L1   READMCF
         LW,R3    OPNDX             0,1,2
         LH,R6    ASL0D,R3          3,1,2
         BAL,L1   LD00              LOAD
ASBSL5   RES      0
         MTW,-1   ASNTYP
         BNEZ     ASBSL8
ASBSL9   RES      0
         B        *BSLRET
*
ASBSL6   RES      0
         BAL,L0   ASBSLY            PARAMS
*
ASBSL8   RES      0
         BAL,L1   READMCF
         BAL,L1   ARS00
         BAL,L1   BOVSE
         B        ASBSL5
*
*        PARAMETERS
ASBSLY   RES      0
         STW,L1   BSLRET
         STW,D0   ASNTYP            NUMBER OPS THIS TYPE
         STW,R3   OPNDX             0,1,2
         B        *L0
*
ASLOD    RES      0
ASL0D    EQU      ASLOD
         DATA     X'9D008E'
         DATA     X'8F0000'
*        ADD DATA TO REGISTER SIMPLE
*        BIN,FLS, FLL   (D,E,F)
*        STYP  0/1 - ADD/SUB
*        IF SUBTRACT AND NOT SUBTRAHEND GENERATE SUBTRACT
ARS00    RES      0
         STW,L1   ARSRET
*        R2, R5 SET TO DATA CLUSTER
ARS05    BAL,L1   SSB00
*        R3 IS 0,1,2  = BIN, FLS, FLL
         LW,R3    OPNDX             0,1,2  B  FLS  FLL
         LW,R1    STMTYP            0,1  ADD/SUB
         BEZ      ARS10             ADD
*        SUBTRACT
         LW,D0    SRTHND            SUBTRAHEND
         BNEZ     ARS10
*        SUBTRACT
         EXU      ARS65,R3          SUBTRACT
         B        ARS11
ARS10    EXU      ARS60,R3
ARS11    BAL,L1   VRBRC             RESOLVE VAR REC
         BAL,L1   MDF65
         B        *ARSRET
*        ADD STMT  OR SUBTRACT SUBTRAHEND
ARS60    RES      0
         AI,V0    CAW+CRR9
         AI,V0    CFAS+CRR8
         AI,V0    CFAL+CRR8
*
ARS65    RES      0
         AI,V0    CSW+CRR9
         AI,V0    CFSS+CRR8
         AI,V0    CFSL+CRR8
*        DIVIDE CONTROL  4.2
*
DV00     RES      0
*
*
*        MULTIPLY CONTROL  4.2
*        A  BY    B (,C,D) .
*        A BY B   GIVING C,D.
*
MP00     RES      0
*
MP02     RES      0
*
MP025    RES      0
*
MP03     RES      0
*
*
         BAL,L1   READMCF
MP05     RES      0
         LW,R6    RESMOD            8,D,E,F
         AI,R6    X'80'             R8
         BAL,L1   LD00              LOAD
         LD,D0    BSIZE
         STD,D0   DSIZE
         LW,D0    RESMOD
         CI,D0    X'D'
         BNE      MP06              NOT BINARY
         BAL,L1   PIA06
         SAD,R8   -32
MP06     LW,D0    GIVOP
         BEZ      MP20
*
*        GIVING SERIES
MP07     RES      0
         BAL,L1   READMCF
         LW,D0    RESMOD
         CI,D0    8
         BE       MP15
*
         CI,D0    X'F'
         BL       MP10
*        FLOATING LONG B NEED NOT BE FLL
MP08     RES      0
         LW,D0    OPTYP
         CI,D0    X'F'
         BE       MP10
*
MP081    RES      0
*        NOT FLL
*        LOAD R2 FLL
         LI,R6    X'2F'
         LH,V1    4,R5
         BAL,L0   LRD00
*
MP085    RES      0
*
         LW,R1    STMTYP            2,3
         LI,D1    2                 R2
         LH,V0    MDFLX-1,R1        FML,R8 FDL,R8  R2
         BAL,L1   PIA02
         B        MP11
*
MP10     RES      0
         BAL,L1   SSB00
         LW,R3    OPNDX             0,1,2
         LW,R1    STMTYP            2,3
         EXU      SS55,R1
         BAL,L1   VRBRC             RESOLVE VAR REC
         BAL,L1   MDF65
*
MP11     RES      0
         BAL,L1   BOVSE
         B        MP17
*
MP15     RES      0
         BAL,L0   SETDG             DECA GOOD
         BAL,L0   SETDNS            NOT STORED
         STW,R2   SUMSUM
*
MP16     RES      0
         LW,R1    STMTYP            2,3
         CI,R1    2
         BE       MP165
         LW,D0    SMPLOP
         BEZ      MP165
         AI,R1    1                 3 BECOMES 4
*
MP165    RES      0
         EXU      DMDEX-2,R1
         LD,D0    CSIZE
         STD,D0   DSIZE
MP17     RES      0
         B        GV00
*
*        MULTIPLY A BY B (,C,D).
MP20     RES      0
*        PARTIAL RESULT CONTROL     +,-,*,/
         B        PR00
*
*        * / FLL  SIMPLE
MDFLX    GEN,16,16 CFML+CRR8,CFDL+CRR8
DMDEX    BAL,L1   DMD00             MULTIPLY DECA BY B.
         BAL,L1   DDI00             DIVIDE DECA INTO B.
         BAL,L1   DDB00             DIVIDE DECA BY B.
*        NOTE     FOR +,- SUMMATION
*                 DECAGD = 1
*                 DECAST = 0
*                 SUMSUM = 1
*                 FOR  TO  SERIES
*                 DECAGD AND DECAGD WILL REFLECT
*                 ACTUAL CONDITIONS OR PARTIAL RESULT
*                 CSIZ,DP  INPUT UPDATED
*
BBFDAD   RES      0                 EXPRESSION ENTRY
         BAL,R1   XAMD00            EXPRESSION INITIALIZATION
         LI,D0    1                                                     COBOL42F
         STW,D0   AN:EXP
*
DADSS    RES      0                 SPECIAL ENTRY
         BAL,R1   SETDGNS           DECA GOOD NOT STORED
*
*        DECIMAL ADD TO THE DECA
*
DAD00    RES      0
         STW,L1   DADRET
*        B SIZE AND DECP
*        BAL,L1   BSD00             THIS SHOULD BE DONE
*        DECAST   DECAGD
*        DSIZE    DDECP
*        DSZPR
*
*
*
DAD05    RES      0
         LW,D1    BDECP
         SW,D1    CDECP             CURRENT
         STW,D1   SHFT
         BLZ      DAD20
*        LEFT SHIFT THE DECA
         BEZ      DAD10             0 SHIFT
*
*
         BAL,L1   LDB00             LOAD DECA IF BAD
         BAL,L0   SETDG             SET DECA GOOD
*
*
DAD06    RES      0
         LW,D1    SHFT
         AWM,D1   CSIZE
         AWM,D1   CDECP
         LI,V0    CDSA
         BAL,L1   PIA02             DSA N
*
         BAL,L1   DAD30             OVERFLOW TEST
*
DAD10    RES      0
         LW,D0    JDCOMP
         BEZ      DAD15
*        B IS COMP
         BAL,L1   LDB00             LOAD DECA IF BAD
*
DAD11    RES      0
         MTH,DSG  JSAVD
         BAL,L1   SSB00
         MTH,-DSG JSAVD
         AI,V0    CDA               DA
         LW,V1    STMTYP
         BEZ      DAD12             ADD
         LW,V1    SUBTHND
         BNEZ     DAD12             SUBTRAHEND
         AI,V0    CDS-CDA           DS
*
DAD12    RES      0
         LW,V1    BYTSZB            BYTE SIZE OF B OP
         MTW,0    AN:EXP                                                COBOL42F
         BEZ      DAD121            NOT EXPRESSION                      COBOL42F
         CI,V1    16                                                    COBOL42F
         BNE      DAD121            NOT WHOLE DECA                      COBOL42F
         LI,V1    0                                                     COBOL42F
DAD121   RES      0                                                     COBOL42F
         SLS,V1   4
         AW,V0    V1
         BAL,L0   CLRD4
         BAL,L1   VRBAD             RESOLVE VAR REC
         BAL,L1   MDF65
*
DAD13    RES      0
         LW,D0    BSIZE
         CW,D0    CSIZE
         BLE      DAD14
         STW,D0   CSIZE
DAD14    RES      0
         BAL,L1   DAD30
*
DAD149   RES      0
*        ALL DONE
*
         LI,D0    0                                                     COBOL42F
         STW,D0   AN:EXP                                                COBOL42F
         B        *DADRET
*
DAD15    RES      0
*        PARAMETERS FOR DECA LOAD
         LI,R6    X'68'
*
         LW,D0    SUMSUM
         BNEZ     DAD17             IN SUMMATION EXPR  STORE
         LW,D0    DECAST
         BEZ      DAD17             NOT SAVED  SAVE IT
         LW,D0    BDECP
         CW,D0    DDECP
         BNE      DAD17             SAVE DECA ALSO HERE
*
*        USE SAVED DECA AT DDECP IN DT1
DAD16    RES      0
         BAL,L1   LD00              LOAD DECA
         BAL,L1   PRT06
         DA,0     ADT1
         B        DAD13
*
*        SAVE THE DECA
DAD17    RES      0
         MTW,0    AN:EXP            IF IN EXPRESSION                    COBOL42F
         BNEZ     DAD17A            USE OTHER HOLD AREA                 COBOL42F
         BAL,L1   PRT06
         DST,0    ADT2              SAVE
         BAL,L1   LD00              LOAD DECA WITH OP
         BAL,L1   PRT06
         DA,0     ADT2
         B        DAD13
DAD17A   RES      0                                                     COBOL42F
         BAL,L1   PRT06                                                 COBOL42F
         DST,0    ADT1                                                  COBOL42F
         BAL,L1   LD00                                                  COBOL42F
         BAL,L1   PRT06                                                 COBOL42F
         DA,0     ADT1                                                  COBOL42F
         B        DAD13
*
*        MUST LOAD AND SHIFT THE B FIELD LEFT
DAD20    RES      0
*        NOTE     THIS CANNOT HAPPEN IN A SUMMATION
*                 BECAUSE THEY ARE  ASCENDING
*                 IT CAN WITH BIN,DEC
*        IN A SUMMATION OR COMPUTE THE DECA WILL NOT BE STORED
*        SO SAVING IT HERE AND USING IT IS GOOD.
*
*        IN AN ADD TO A RECEIVING SERIES IF THE DECA IS STORED
*        IT IS AT DSIZE  DDECP  THIS IS #  CZIZ  CDECP  BECAUSE OF THE
*        ADS00 SUBROUTINE  SO OK TO USE FROM DT1
*        IF THE DECA IS NOT STORED  STORING IT IN ADT1 IS GOOD ALSO
         LW,D0    DECAST
         BNEZ     DAD205            ALREADY STORED
         BAL,L1   PRT06
         DST,0    ADT1
*        DONT SET THE DECA GOOD HERE
*        LOAD B
DAD205   RES      0
         LW,D0    BYTSZB
         BNEZ     DAD21
*        SPECIAL FLAG  DT2 FULL DECA  BINARTY  AND DECIMAL
*        SPECIAL FOR BINARY IN ADT2
*        AND FOR EXPRESSIONS        DL,0  AND SHIFT
         BAL,L1   SSB00
         AI,V0    CDL               DL,0
         BAL,L1   VRBAD             RESOLVE VAR REC
         BAL,L1   MDF65
         LCW,D1   SHFT              + N
         LI,V0    CDSA
         BAL,L1   PIA02
         B        DAD22
*
*
DAD21    RES      0
         LI,R6    X'68'
         LW,V1    BDECP
         SW,V1    SHFT              LET LOAD SHIFT
         BAL,L0   LD05              V1 LOADED  VIA L0
*
DAD22    RES      0
         LCW,D1   SHFT              +N
         AW,D1    BSIZE             B SHIFTED SIZE
         CW,D1    CSIZE             CURRENT
         BLE      DAD225
         STW,D1   CSIZE             NEW CURRENT
DAD225   RES      0
         CI,D1    31
         BLE      DAD23
         BAL,L1   BOVT
DAD23    RES      0
DAD24    RES      0
         BAL,L1   PRT06
         DA,0     ADT1
         B        DAD14             NEW CURRENT SIZE OK
*
*        BAL,L1
DAD30    RES      0
         LW,D1    OSE0
         BEZ      *L1
         LW,D0    CSIZE
         CW,D0    DSZPR
         BLE      *L1
         B        BOVT
*
*        ROUND    NOT FOR DMD
*        DUBL     0,NON-ZERO
*        RSHFT
*        DECAST   YES/NO
*        DECAGD   YES/NO
*        DSIZE    DECA   BSIZE  OPERAND
*        DDECP    DECA   BDECP
*        CSIZE                      OUTPUT
*        CDECP                      OUTPUT
*
*        DECIMAL MULTIPLY THE DECA  BY DEC  OR BIN FIELD
*
*
BBFDMD   RES      0                 EXPRESSION ENTRY
         BAL,R1   XAMD00            EXPRESSION INITIALIZATION
*
*
DMD00    RES      0
         STW,L1   DMDRET
*        IF THE CSIZE IS GR THAN 31 ON DOUBLE PRECISION
*        BOVT IS EXECUTED
*
*
DMD03    RES      0
         LCW,D1   RSHFT             IN TO -N
         AND,D1   K3FF
         SLS,D1   4
*
         STW,D1   DPMP1
*
DMD04    RES      0
         LW,D1    BSIZE
         AW,D1    DSIZE
         SW,D1    RSHFT
         STW,D1   CSIZE
*
         LW,D1    BDECP
         AW,D1    DDECP
         SW,D1    RSHFT
         STW,D1   CDECP
*
DMD05    RES      0
         LW,D0    JDCOMP
         BEZ      DMD20
*
*        B IS COMP
DMD10    RES      0
         BAL,L1   LDB00             LOAD DECA IF BAN
DMD11    RES      0
         LW,D0    DUBL
         AW,D0    KDUBLI
         BNEZ     DMD13
*        SINGLE PRECISION
         MTH,DSG  JSAVD             SET SUBSCRIPT SAVE SWITCH           COBOL42F
         BAL,L1   SSB00
         MTH,-DSG JSAVD             RESET SUBSCRIPT SAVE SWITCH         COBOL42F
         LW,D0    BYTSZB            BYTE SIZE OF B OP
         BNEZ     DMD12
*        BYTE SIZE 0 FROM EXPRESSIONS
         AI,D3    8                 RT HALF OF STORED DECA
         LI,D0    8                 8 BYTES
DMD12    RES      0
*
         SLS,D0   4
         AI,D0    CDM
         AW,V0    D0
         BAL,L0   CLRD4
         BAL,L1   VRBAD             RESOLVE VAR REC
         BAL,L1   MDF65
         B        DMD17
*        DOUBLE PRECISION
DMD13    BAL,L1   NCSUB             CHECK NC SUB AND VAR REC            COBOL42F
         LW,D1    BYTSZB
         AW,D1    V0
         AW,D1    DPMP1
DMD15    LI,V0    CLI+CP1
         BAL,L1   PIA02             LI,P1   R,SH,BS (4,8,4)
         BAL,L1   PIX06
         TEXT     ':DPM'
*
DMD16    RES      0
         LW,D1    CSIZE
         CI,D1    31
         BLE      DMD17
*        SIZE IS GR THAN 31
         BAL,L1   BOVT
*
DMD17    B        *DMDRET
*        B IS NOT COMP (DISPLAY OR BINARY)
DMD20    LW,D0    DECAST            DECA STORED
         BNEZ     DMD21
*        STORE DECA
         BAL,L1   PRT06
         DST,0    ADT1
         BAL,L0   SETDST            SET STORED
*        LOAD B INTO DECA
DMD21    RES      0
         LI,R6    X'68'             DECA
         LW,V1    BDECP             DEC PT
         BAL,L0   CLRD0             SET SAVE VAR PARAM FLAG
         BAL,L0   LRD00
*
         LW,D0    DUBL
         AW,D0    KDUBLI
         BNEZ     DMD25
*        SINGLE PRECISION
         BAL,L1   PRT06
         DM,8     ADT1+2
         B        DMD17
*        DOUBLE
DMD25    RES      0
         LW,D3    DMD90
         BAL,L1   PID16
         LI,R2    0                 LI,R2   BA(DT1)
         LW,D1    DPMP1
         AI,D1    X'2000'           REGISTER 2
         B        DMD15
*        4.2
*        DIVIDE DECA INTO OPERAND
*        DSIZ,DP  INPUT
*        CSIZ,DP  OUTPUT
*
BBFDDI   RES      0                 EXPRESSION ENTRY
         BAL,R1   XAMD00            EXPRESSION INITIALIZATION
*
DDI00    RES      0
DD00     RES      0
         STW,L1   DDRET
*
DD05     RES      0
         BAL,L1   DDCP1             PAR DPD CSIZE,DP
*        RESULT SIZE AND DEC PT
DD07     RES      0
         LW,D0    BSIZE
         AW,D0    RSHFT             REALLY LEFT
         STW,D0   CSIZE             RESULT
         LW,D0    BDECP
         AW,D0    RSHFT             REALLY LEFT
         SW,D0    DDECP
         STW,D0   CDECP
*
*
DD10     RES      0
         LW,D0    DECAST
         BNEZ     DD11
         BAL,L1   PRT06
         DST,0    ADT1
         BAL,L0   SETDST            SET DECA SFORED
*
DD11     RES      0
         LI,R6    X'68'
         LW,V1    BDECP
         BAL,L0   CLRD0             SET SAVE VAR PARAM FLAG
         BAL,L0   LRD00             LA LOAD DECA
*
         LW,D0    DUBL
         AW,D0    KDUBLI
         BNEZ     DD15              DOUBLE
*
*        SINGLE
DD12     RES      0
         BAL,L1   DDLS              LEFT SHIFT THE DECA
*
DD13     RES      0
         BAL,L1   PRT06
         DD,8     ADT1+2
*
*        ZERO OUT D0 D1
DD135    RES      0
         BAL,L1   BOVT
*
         BAL,L1   PRG06
         INT,D0   DGFZ+1
*
DD14     RES      0
         B        *DDRET
*
DD15     RES      0
         BAL,L1   DPMSV2
         LW,D3    DMD90
         BAL,L1   PID16
         LI,R2    0                 LI,R2  BA(DT1)
         LW,D1    DPDP1
         AI,D1    X'2000'           REGISTER 2
         BAL,L1   DDPCS             DPD CALLING SEQ
*
DD17     RES      0
*        BAL,L1   BOVT   ---DONE IN DDPCS
         B        DD14
*
*
*        DIVIDE OPERAND INTO DECA
BBFDDB   RES      0                 EXPRESSION ENTRY
         BAL,R1   XAMD00            EXPRESSION INITIALIZATION
*
DDB00    RES      0
         STW,L1   DDBRET
*
DDB05    RES      0
         BAL,L1   DDCP1             DPD PARAM,CSIZE,DP
*        COMPUTE RESULT SIZE, DP
DDB07    RES      0
         LW,D0    DSIZE
         AW,D0    RSHFT
         STW,D0   CSIZE
         LW,D0    DDECP
         AW,D0    RSHFT
         SW,D0    BDECP
         STW,D0   CDECP
*
DDB10    RES      0
         LW,D0    JDCOMP
         BEZ      DDB20
*        DEN IS COMP
         LW,D0    DUBL
         AW,D0    KDUBLI
         BNEZ     DDB15
*        SINGLE PRECISION
         BAL,L1   DDLS              LEFT SHIFT
         MTH,DSG  JSAVD             SET SUBSCRIPT SAVE SWITCH           COBOL42F
         BAL,L1   SSB00
         MTH,-DSG JSAVD             RESET SUBSCRIPT SAVE SWITCH         COBOL42F
         LW,D0    BYTSZB
         BNEZ     DDB11
*        BYTE SIZE OF 0 FROM EXPRESSIONS
         AI,D3    8                 RT HALF OF STORED DECA
         LI,D0    8
DDB11    RES      0
*
         SLS,D0   4
         AI,D0    CDD
         AW,V0    D0
         BAL,L1   VRBAD             RESOLVE VAR REC
         BAL,L1   MDF65
*
*        ZERO OUT D0 D1
DDB13    RES      0
         BAL,L1   BOVT
         BAL,L1   PRG06
         INT,D0   DGFZ+1
*
DDB14    RES      0
         B        *DDBRET
*
DDB15    RES      0
         BAL,L1   DPMSV1
         BAL,L1   NCSUB             CHECK NC SUB AND VAR REC            COBOL42F
         LW,D1    V0                R000
         AW,D1    DPDP1
         AW,D1    BYTSZB
DDB17    RES      0
         BAL,L1   DDPCS             DPD CALLING SEQ
*
*        BAL,L1   BOVT --- DONE IN DDPCS
         B        DDB14
*        DEN IS NOT COMP
DDB20    RES      0
         BAL,L1   PRT06
         DST,0    ADT2              SAVE NUM.
*        LOAD DENOMINATOR
         LI,R6    X'88'             DECA
         LW,V1    BDECP
         BAL,L0   CLRD0
         BAL,L0   LRD00
         LW,D0    KDUBL
         AW,D0    KDUBLI
         BNEZ     DDB25
*        SINGLE PRECISION
DDB21    RES      0
         BAL,L1   PRT06
         DST,0    ADT3
         BAL,L1   RDIVR0            SAVE DIVISOR FOR ROUNDED
         BAL,L1   PRT06
         DL,0     ADT2
         BAL,L1   DDLS              LEFT SHIFT THE DECA
         BAL,L1   PRT06
         DD,8     ADT3+2
*
         B        DDB13
*
DDB25    RES      0
         LW,D3    DBADT2            BA (DT2)
         BAL,L1   PID16
         LI,R2    0                 LI,R2  BA(DT2)
         BAL,L1   DPMSV1
         LW,D1    DPDP1
         AI,D1    X'2000'           REGISTER 2
         LI,V0    X'8'               REVERSE DIVIDE
         STW,V0   REVDIV
         B        DDB17
RDIVR0   MTW,0    RMRND
         BEZ      *L1               NO ROUNDED
         STW,L1   DDPCSR
         LW,D1    RDVSV
         BEZ      RDIVR1
         LBAL     PRA01,CDST+0      SAVE DIVISOR
         B        *DDPCSR
RDIVR1   RES      0
         LBAL     PRA00,CDST+0      SAVE DIVISOR
         LW,D1    GADNO
         STW,D1   RDVSV
         AI,D1    16
         STW,D1   GADNO
         B        *DDPCSR
DPMSV1   LW,D0    DDECP             SAVE DECP OF DIVIDEND
         B        DPMSV3
DPMSV2   LW,D0    BDECP
DPMSV3   STW,D0   RDECP
         B        *L1
NCSUB    STW,L1   SAVL1             SAVE LINKAGE                        COBOL42F
         BAL,L0   SETDNS            CLEAR DECA SAVED FLAG               COBOL42F
         LH,R4    1,R2              SUB DISP                            COBOL42F
         BEZ      NCSUB1            NO SUBSCRIPT                        COBOL42F
         AI,R4    -1                                                    COBOL42F
         AW,R4    R2                                                    COBOL42F
         LH,R4    0,R4              SUBSCRIPT CLASS                     COBOL42F
         SLS,R4   -12                                                   COBOL42F
         AND,R4   K30F              MASK CLASS                          COBOL42F
         CI,R4    X'B'                                                  COBOL42F
         BNE      NCSUB1            NOT NC SUBSCRIPT                    COBOL42F
         BAL,L0   SETDST            SET DECA SAVED FLAG                 COBOL42F
         BAL,L1   PRT06                                                 COBOL42F
         DST,0    ADT1              WRITE DST,0  ADT1                   COBOL42F
NCSUB1   BAL,L1   SSL00             CHECK SUBSCRIPT                     COBOL42F
         BAL,L0   VRAAD             RESOLVE VAR REC                     COBOL42F
         SLS,V0   8                 REGISTER                            COBOL42F
         MTW,0    DECAST                                                COBOL42F
         BEZ      *SAVL1            RETURN                              COBOL42F
         BAL,L1   PRT06                                                 COBOL42F
         DL,0     ADT1              WRITE DL,0  ADT1                    COBOL42F
         B        *SAVL1            RETURN                              COBOL42F
*
*        BAL,L1   CONSTRUCT PARAMETER 1
DDCP1    RES      0
         LW,D0    RSHFT             LEFT SHIFT
         AND,D0   K3FF
         SLS,D0   4
         STW,D0   DPDP1
*        LD,D0    RESIZE
*        STD,D0   CSIZE             RESULT OF DIVIDE
*
         B        *L1
*        D1 IS PAR1
*        BAL,L1
DDPCS    RES      0
         STW,L1   DDPCSR
         LI,V0    CLI+CP1
         AW,V0    REVDIV
         MTW,0    REMBIT
         BEZ      DDPCS1            NO REMAINDER REQUESTED
         LW,L1    DPDSA
         AWM,L1   DSIZE
         AWM,L1   DDECP
         AI,V0    1                 SET REMAINDER BIT
         MTW,0    RMRND
         BEZ      DDPCS1            NOT ROUNDED
         AI,V0    2                 SET ROUNDED PARAM
DDPCS1   BAL,L1   PIA02             LI,P1  RM,R,SH,BS
         LW,D1    DPDSA             BDECP - CLDECP
         MTW,0    REMBIT
         BEZ      DDPCS3            NO REMAINDER
         AND,D1   L(X'FF')
         LW,D0    TYPBTS
         SW,D0    RDECP             BDECP - CDECP
         AND,D0   L(X'FFF')
         SLS,D0   8
         OR,D1    D0
DDPCS3   OR,D1    L(X'22300000')    FORM LI,R3  --
         LI,D0    DAIA
         BAL,L1   PIA08+2           **** WRITE LI,R3  (BDECP - CLDECP)
         BAL,L1   PIX06
         TEXT     ':DPD'
         LI,D0    0
         STW,D0   REVDIV
         BAL,L1   BOVT
         B        *DDPCSR
*
*        ALWAYS FOLLOW DIVIDE BY BOVT
*
*        BAL,L1
DDLS     RES      0
         LW,D1    RSHFT             +N
         BEZ      *L1
         LI,V0    CDSA              DSA  N CLEFT
         B        PIA02
*
*        INITIALIZATION FOR EXPRESSION ENTRY FOR ARITHMETIC DECA
*        BAL,R1
XAMD00   RES      0
         LD,D0    CSIZE
         STD,D0   DSIZE             THIS IS OK FOR ADD (UNNECESSARY)
*        SET DECA GOOD NOT STORED
*        BAL,R1
SETDGNS  RES      0
         BAL,L0   SETDG             SET DECA GOOD
         BAL,L0   SETDNS            SET DECA NOT STORED
         B        *R1
*
*        P4.2F INITIALIZATION
*        BAL,L1
IN00     RES      0
         LH,D0    1,R5
         AND,D0   L(X'400')         REMAINDER BIT
         STW,D0   REMBIT
         MTW,0    CORESF
         BNEZ     IN01              CORRESPONDING
         MTW,-1   JSXR
IN01     LI,D0    0
         STW,D0   SCCBD             CLEAR SHIFT COUNT (IF ANY LEFT)     COBOL42F
         STW,D0   JUNSD
         STW,D0   SZECLUP           SIZE ERROR CLEANUP FLAG
         STW,D0   SPGIVE
         STW,D0   COMPFLG           COMPUTE EXP FLAG
         STW,D0   KDUBLI            FOR COMPUTE
         STW,D0   OSEIX
         STW,D0   DECBINF           DEC TO BINARY FLAG
         STW,D0   DECFLF            DEC FLOATING FLAG
         STW,D0   DPDSA
         STW,D0   REG28
         STW,D0   RCONV
         STW,D0   REMSTF
         STW,D0   NOARTF
         LW,R1    MCBUF
         STW,R1   SUMSUM            SET COMPUTATUION FLAG
         SLS,R1   -15
         AND,R1   K301
         STW,R1   CORESF            CORRESPONDING FLAG
         B        UC03
*
*
*        BAL,L1   PUT EXP RESULT IN GOOD REGISTER
EXR00    RES      0
         LW,R1    RESMOD            8,D,E,F
         AI,R1    -X'D'
         BLZ      EX10
*        0,1,2    B,FS,FL
         LW,D1    CLSHFT            COMP REG EXP 6,7,8,9 ETC
         CH,D1    EXREG,R1          0,1,2
         BE       EX10
         LH,V0    EXRLD,R1          LW,R9 LW,R8 LD,R8
         B        PIA02
EX10     RES      0
*
         LW,D0    CLSIZ             RESULT
         LW,D1    CLDECP            OF EXPRESSION
         STD,D0   DSIZE             DSIZE DDECP
         B        *L1
*
EXRLD    RES      0
         GEN,16,16 CLW+CRR9,CLW+CRR8  LW,R9 LW,R8
         GEN,16,16 CLD+CRR8,0         LD,R8
EXREG    RES      0
         GEN,16,16 9,8
         GEN,16,16 8,0
*
*        GIVE
GV00     RES      0
*
*        PARTIAL RESULT
PR00     RES      0
PR02     RES      0
         BAL,L1   BAA46             SAVE VAR FLAG
         BAL,L1   UC00
SPGV00   RES      0                 SPECIAL +,- GIVE
*
         LW,D0    COMPFLG
         BEZ      PR03
*        COMPUTE   CHECK FOR GOOD EXP REG RESULT
         BAL,L1   EXR00
PR03     RES      0
PR05     RES      0
         BAL,L1   ZOVF00            ZERO OVER FLAG
         LI,D0    0
         STW,D0   SUMSUM
         STW,D0   SMANY
         STW,D0   COMPFLG
         LW,D0    RESMOD
         CI,D0    X'D'
         BL       DP00              DECIMAL
         BE       BP00              BINARY
         CI,D0    X'F'
         BL       FSP00             FLS
*        FLOATING LONG
         B        FLP00             FLL
*        DECIMAL PARTIAL
DP00     RES      0
*
DP02     RES      0
         LD,D0    DSIZE
         STD,D0   CSIZE
         BAL,R1   SETDGNS           DECA GOOD NOT STORED
*
*        DECA AT DSIZ, DDECP
DP03     RES      0
         LW,D0    NTOT
         CI,D0    1
         BLE      DP04              ONE REC OP
         STW,D0   DECAST
         BAL,L1   PRT06
         DST,0    ADT1              SAVE DECA
DP04     RES      0
         LW,D0    NDEC
         BEZ      DP10
*
         LW,D0    GIVOP
         BNEZ     DP07              GIVING
*        +,-,*,/
*        SERIES   ADD TO,SUB FROM, MULT BY DIV INTO - STORE
*        +,*,/
         BAL,L1   ADS00
         B        DP10
DP07     RES      0
*
         STW,D0   SMANY
         BAL,L1   SD00              STORE
*
*
DP10     RES      0
         LW,D0    NFLL
         AW,D0    NFLS
         BEZ      DP15
         STW,D0   DECFLF            NON ZERO
*        IF FLP FINDS BINARY RECEIVING OPS IT WILL RETURN HERE
*        TO DP15
         MTW,0    REMSTF
         BEZ      DP11              DECA GOOD
         MTW,1    RCONV
         LW,R6    CLDECP
         STW,R6   DDECP             SET RESULT DECP
         LI,L1    DP11
         STW,L1   SAVL1
         B        LDECA1            RELOAD DECA
DP11     LI,R6    X'8F'
         BAL,L1   LDR67
*        V1 IS SIZE - DECP
         CI,V1    74
         BL       DP12
         BAL,L1   BOVSE
*
DP12     RES      0
         B        FLP10             FLOATING LONG
*
DP15     RES      0
         LW,D0    NBIN
         BEZ      DP20
         STW,D0   NDEC              NBIN TO NDEC FOR SD00
         STW,D0   DECBINF           FLAG FOR SD00
         LW,D1    GIVOP
         BNEZ     DP16              GIVING
*        TO A SERIES
         STW,D1   SMANY             STORE SINGLE OP
*        +,-,*,/ TO A SERIES OF BINARY OPS
         BAL,L1   ADS00
         B        DP20
DP16     RES      0
*        STORE DECA IN BINARY RECEIVING FIELSDS
         STW,D0   SMANY             STORE MANY
         BAL,L1   SD00
         B        DP20
*
*
DP20     RES      0
         B        AREXIT
*
*        FLOATING SHORT PARTIAL
FSP00    RES      0
FSP10    RES      0
         LW,D0    NFLS
         BEZ      FSP15
         LI,R3    1                 FLS
         BAL,L1   SS00
         STW,D0   NFLS              ZERO OUT
FSP15    RES      0
         LW,D0    NTOT              REMAINING
         BEZ      AREXIT            ALL DONE
         BAL,L1   PIA06
         LI,R9    0
         B        FLP10
*
*        FLOATING LONG
FLP00    RES      0
FLP10    RES      0
         LW,D0    NFLL
         BEZ      FLP15
FLP11    RES      0
         LI,R3    2                 FLL
         BAL,L1   SS00
         STW,D0   NFLL
FLP15    LW,D0    NFLS
         BEZ      FLP20
         BAL,L1   PIA06             WRITE FLL TO FLS
         LI,P1    R8
         BAL,L1   PIX06
         TEXT     ':CFE'
         LW,D0    NFLS
         LI,R3    1                 FLS
         BAL,L1   SS00
         STW,D0   NFLS
*
FLP20    RES      0
         LI,D0    0
         STW,D0   FLPRX
         LW,D0    NBIN
         BEZ      FLP30
*        RETURN TO DP15 IF ORIGINAL WAS DECIMAL
         LW,D1    DECFLF
         BNEZ     DP15
         LW,D1    GIVOP
         BNEZ     FLP205            GIVING
         LI,R3    2                 FLL
         STW,R3   FLLBFLG
         BAL,L1   SS00
         LI,D0    0
         STW,D0   NBIN
         STW,D0   FLLBFLG
         B        FLP30
FLP205   RES      0
*
         LW,D0    NDEC
         BEZ      FLP21
*
         LI,D0    X'20'
         STW,D0   FLPRX
         BAL,L1   PIA06
         LD,R2    R8
*
FLP21    RES      0
         LI,R6    X'9D'
         LI,R7    X'F'
         LI,D1    X'80'
         BAL,L0   LRR01
*
*
FLP22    RES      0
         LW,D1    OSE0
         BEZ      FLP25             NO SIZE ERROR
         LW,D0    NDEC
         BEZ      FLP24             NO DECIMAL
*        THERE IS DEC
*        IT IS GIVING HERE
*        GIVING AND THERE IS DECIMAL
         BAL,L1   BOVT              BOV OSEI
         B        FLP25
*
*        GIVING
*
FLP24    LI,V0    CBOV
         BAL,L1   PII02             BOV OSE0
*
*
FLP25    RES      0
         LW,D0    NBIN
         LI,R3    0                 BIN
         BAL,L1   SS00
         STW,D0   NBIN
*
FLP26    RES      0
*
         LW,D0    OSE0
         BEZ      FLP30
*        GIVING
         BAL,L1   JNOVT
FLP30    RES      0
         LW,D0    NDEC
         BEZ      AREXIT
*        DECIMAL FOLLOW
FLP31    RES      0
         BAL,L1   FD00              FLOATING  -- DECIMAL
         B        AREXIT
*
*
*        BINARY RESULT GIVING OR FROM/TO
BP00     RES      0
BP10     RES      0
         LW,D0    NBIN
         BEZ      BP15
         LI,R3    0                 BINARY
         BAL,L1   SS00
         STW,D0   NBIN
BP15     RES      0
         LW,D0    NFLL
         AW,D0    NFLS
         BEZ      BP20
*
*
BP16     RES      0
         MTW,0    REMBIT
         BEZ      BP161             NO REMAINDER
         MTW,-7   RCONV             SET FOR REMAINDER
         LW,R6    REG28
         LH,D1    REGNO2,R6
         LI,V0    CLW+CRR6
         BAL,L1   PIA02             **** WRITE LW,R6  FR
BP161    LI,R6    X'8F'
         BAL,L1   BFD00             CONVERT TO FLL
         B        FLP10
*
BP20     RES      0
         LW,D0    NDEC
         BEZ      AREXIT
*        BIN - DEC FOR DEC REC
*
BP21     RES      0
         MTW,0    REMBIT
         BEZ      BP23              NO REMAINDER
         MTW,1    RCONV
         MTW,0    REMSTF
         BNEZ     BP23              REMAINDER STORED
         LW,R6    NTOT
         CI,R6    1                 FOR REMAINDER
         BLE      DP04
BP23     LI,R6    X'8'
         BAL,L1   BFD00             BINARY TO DECA INTEGER
*
         LI,D0    10
         LI,D1    0
         STD,D0   DSIZE
         B        DP00
VRBRC    CI,R3    2
         BNE      VRWAD             WA
VRDAD    MTW,1    VBIDX             DA
VRWAD    MTW,2    VBIDX
VRBAD    STD,L0   VRSAV
         MTW,0    NOVF
         BNEZ     VRBAD1            LITERAL
         BAL,L0   VPP30             VAR INDEX
VRBAD1   LD,L0    VRSAV
         B        *L1
VRSAD0   CI,V0    X'E'
         BANZ     *L1
VRSAD    MTW,0    RFLDF
         BGEZ     VRBRC             PARAM NOT SAVED
         STD,L0   VRSAV
         BAL,L0   VPP50
         B        VRBAD1
VRAAD    MTW,0    LITF
         BNEZ     *L0               LITERAL
         STW,V0   VRSAV
         STW,L0   VRSAV+1
         SLS,V0   -4
         BAL,L0   VPP10             RESOLVE VAR ADDR
         LW,V0    VRSAV
         B        *VRSAV+1
CLRD0    STD,L0   VRSAV
         BAL,L1   CLRD3
         STW,L0   ARTHF
         B        CLRD2
CLRD4    MTW,0    NOARTF
         BEZ      *L0
CLRD1    STD,L0   VRSAV
         BAL,L1   CLRD3
         STW,L0   RFLDF
CLRD2    LW,L1    VRSAV+1
         B        *VRSAV
CLRD3    LW,L0    COMPFLG
         OR,L0    GIVOP
         BNEZ     CLRD2
         LI,L0    1
         B        *L1
*
*        STORE THE DECA             (110)
*        DECA AT CSIZ ,CDECP
*        IF DECA NO GOOD IS AT DSIZ ,DECP
*
*        IF SMANY = 0 STORE INTO R2,R5
*        ELSE READ NDEC FROM MCF    (DECA STORED IF MORE THAN 1)
*
*
SD00     RES      0
         STW,L1   SDRET
*
*
SD01     RES      0
         LW,D0    SMANY
         BEZ      SD03              STORE A SINGLE OP  ALREADY READ
         MTW,-1   NTOT
*
         BAL,L1   READMCF
*        BDECP,BSIZE, JDRND
SD02     RES      0
*        IF THE DECA IS NOT GOOD LOAD IT FROM DT1
*        AT       DSIZ, DDECP
         LW,D0    DECAGD
         BNEZ     SD03              DECA LOADED AT CSIZ,CDECP
*        RELOAD  DECA
SD025    RES      0
         MTW,0    REMBIT
         BNEZ     SD05
         BAL,L1   LDECA             RELOAD DECA
SD03     RES      0
SD04     RES      0
*        THE DECA IS GOOD AT CSIZE, CDECP
*
SD05     RES      0
         LI,D0    0
         STW,D0   JUNSD
         LW,D1    BDECP
         MTW,0    REMSTF
         BEZ      SD050
         LD,D0    DSIZE             SET SIZE, DECP FOR REMAINDER
         STD,D0   CSIZE
         LW,D0    BDECP
         SW,D0    DDECP
         AWM,D0   CSIZE
         AWM,D0   CDECP
         B        SD07
SD050    MTW,0    REMBIT
         BEZ      SD051
         MTW,0    JDRND
         BNEZ     SD23              ROUNDED
         B        SD06
SD051    SW,D1    CDECP
SD052    STW,D1   SDSHFT
         BLZ      SD20              TIGHT SHIFT
         BEZ      SD07              NO SHIFT
*        LEFT SHIFT THE CECA
         AWM,D1   CSIZE             NEW CURRENT
         AWM,D1   CDECP
         LI,V0    CDSA
         BAL,L1   PIA02             DSA N
*
SD06     RES      0
         LW,D1    CSIZE
         CW,D1    DSZPR             D SIZE PRIME  29
         BLE      SD07
         BAL,L1   BOVT
*        THERE IS SIZE ERROR IF SHIFTED
SD07     RES      0
         LW,D0    DECBINF           DECIMAL TO BINARY FLAG
         BEZ      SD079
*        DEC TO BIN OPERANDS
*        CONVERT DECA TO BINARY
         LI,R6    X'9D'             R9 BIN
         LI,R7    X'8'              DECA SOURCE
*        LI,D1    0                 NOT NECESSARY
         LI,V1    0                 DECP OF ZERO
         BAL,L0   LRR01             DECA TO R( BINARY
         BAL,L1   BOVT
*        STORE
SD072    RES      0
         BAL,L1   SSB00
         AI,V0    CSTW+CRR9         STW,R9
         MTW,0    RFLDF
         BGEZ     SD074
         MTW,2    VBIDX             WA
         BAL,L0   VPP50
         B        SD076
SD074    BAL,L1   VRWAD
SD076    BAL,L1   MDF65
         B        SD105
SD079    RES      0
*
         LW,D1    BSIZE
         MTW,0    REMBIT
         BNEZ     %+3
         CW,D1    CSIZE
         BG       SD08
*
         BAL,L1   CSZT
*
SD08     LW,D1    CSIZE
         CW,D1    DSZPR             D SIZE PRIME  29
         BLE      SD09
         LW,D1    OSE0
         BEZ      SD09
         BAL,L0   SETDB             SET DECA NO GOOD
*
SD09     RES      0
         LW,D0    BSIZE             MAYBE
         STW,D0   JDSIZ             THE SAME
         LW,D0    BDECP
         STW,D0   JDECP
*        STORE   THE DECA
SD10     LI,R6    X'08'             DECA
         BAL,L0   LDR00
SD105    RES      0
         LW,D0    SMANY
         BNEZ     SD40
SD11     RES      0
         BAL,L1   JNOVT
         B        *SDRET
*
SD20     RES      0
*        D1 IS -N                   -N
         MTW,0    REMSTF
         BNEZ     SD21
         AWM,D1   CSIZE             NEW CURRENT
         AWM,D1   CDECP
*
         LW,D0    JDRND
         BEZ      SD21              NO ROUND
         MTW,1    CSIZE
         AI,D1    1                 -N+1
         BEZ      SD23
SD21     RES      0
         MTW,0    SCCBD             CHECK SHIFT ADJUST                  COBOL42F
         BEZ      SD211             NO                                  COBOL42F
         SW,D1    SCCBD             ADJUST SHIFT FOR MULTIPLY           COBOL42F
         LI,V0    0                                                     COBOL42F
         STW,V0   SCCBD             CLEAR SHIFT ADJUST                  COBOL42F
SD211    RES      0                                                     COBOL42F
         LI,V0    CDSA
         BAL,L1   PIA02             DSA  -N  (RIGHT)
SD22     RES      0
         LW,D0    JDRND
         BEZ      SD24
SD23     RES      0
         BAL,L1   PIX06
         TEXT     ':RND'
SD24     RES      0
*        LW,D1    BSIZE             NOT
*        CW,D1    CSIZE             NECESSARY
*        BGE      SD25              HERE
*        BAL,L1   CSZT
SD25     RES      0
         B        SD07
*
SD40     RES      0
         MTW,0    REMSTF
         BNEZ     SD401             REMAINDER
         LW,D0    JDRND
         STW,D0   JSRND
         LW,D0    JDSIZ
         STW,D0   JDSIZS            SAVE
SD401    MTW,-1   NDEC
         BEZ      SD11              ALL STORED
*
         BAL,L1   READMCF
         LW,D0    DECBINF           DEC BINARY FLAG
         BEZ      SD405             REGULAR DECIMA
*        DECA STORE TO BINARY
         LW,D0    JDRND
         CW,D0    JSRND
         BE       SD072             STORE AGAIN
         B        SD52              LOOP
SD405    RES      0
*
         LW,D0    DECAGD
         BEZ      SD51              DECA NO GOOD (GR 31)
*        DECA NOT DESTROUYED BY STORE
*
*
SD41     RES      0
*
         LW,D0    BDECP
         CW,D0    CDECP
         BNE      SD45
*
         LW,D0    JDRND
         CW,D0    JSRND
         BNE      SD51
*
         LW,D0    BSIZE
         CW,D0    JDSIZS
         BNE      SD47
*        SAME DP, RND, SIZE
         MTW,-1   NTOT
         MTW,0    REMBIT
         BEZ      SD09              NO REMAINDER
         LW,D1    BSIZE
         BAL,L1   CSZT              C:SZT
         B        SD09              STORE
*
*
SD45     RES      0
         BG       SD50              MUST LEFT SHIFT DECA
*        MUST RIGHT SHIFT DECA
         LW,D0    CSIZE
         CW,D0    DSZPR
         BG       SD51              RELOAD
SD46     RES      0
         LW,D0    JSRND
         BNEZ     SD51              MUST RELOAD
***      OK TO STORE THE CURRENT DECA AT CSIZ ,CDECP
SD47     RES      0
         BAL,L1   JNOVT
         MTW,-1   NTOT
         B        SD05
*
SD50     RES      0
         LW,D0    SDSHFT
         BGEZ     SD46              PREV WAS LEFT
*        RELOAD DECA
SD51     RES      0
         BAL,L1   JNOVT
SD52     RES      0
         MTW,-1   NTOT
         B        SD025
*
*        +,-,*,/  TO,FROM,BY,INTO A SIMPLE SERIES (NOT DECIMAL)
*                 GIVING  SIMPLE SERIES
SS00     STW,L1   SSRET
         STW,D0   SSCNT
         STW,R3   SSOPTYP         /,1,2
SS02     LW,R1    STMTYP            0,1,2,3, +,-*,/
*        R3 CONTAINS 0,1,2   BIN,FLS,FLL
*        SSCNT IS COUNT IN THIS SERIES
*        FOR PSEUDO GIVE NTOT AND SSCNT ARE 1 AND
*        A SWITCH IS SET FOR RDMCF
         LI,D0    0
         STW,D0   NBIN,R3           BIN,FLS,FLL IN THAT ORDER
SS05     RES      0
         BAL,L1   READMCF
         BAL,L1   SSB00
         STW,V0   SSTV0
         STW,D3   SSTD3             D3 FROM SSB00  BASE / DISP
         BAL,L1   SSLR13            LOAD R1 R3
         LW,D0    GIV0P
         BNEZ     SSG00             GIVING - STORE
SS07     RES      0
         LW,D0    OSE0               0, NONZERO
         AW,D0    R1                (0,1) 2,3
         AW,D0    R3                0,1,2
         AW,D0    R3                0,2,4
         CI,D0    1
         BLE      SSAM00            ADD TO BINARY NO SIZE ERROR
         MTW,-1   NTOT
         BEZ      SS20              VERY LAST OP
SS15     RES      0
         LW,D0    FLLBFLG
         BEZ      SS153
*        FLL / BINARY OPERATION
         AI,V0    CLW+CRR2
         BAL,L0   CLRD1
         BAL,L1   VRWAD             RESOLVE VAR REC
         BAL,L1   MDF65
         LI,R6    X'2F'             R2 FLL
         LI,R7    X'D'              BINARY
         LI,D1    X'20'             R2
         BAL,L0   LRR01             BIN TO FLL
         BAL,L1   SSLR13
         B        SS156
SS153    RES      0
*
*        NOT LAST OP - LOAD R3 BIN OR R2 FLOATING
         AH,V0    SSLD,R3
         BAL,L0   CLRD1
         BAL,L1   VRBRC             RESOLVE VAR REC
         BAL,L1   MDF65
         MTW,0    R3
         BNEZ     SS156
         BAL,L1   PIA06
         SAD,R2   -32               **** WRITE SAD,R2  -32
SS156    RES      0
         LW,D1    SSRX,R3
*                                   R6, R7
         EXU      SS50,R1           R1 = A,S,M,D - 0,1,2,3
         BAL,L1   PIA02
         MTW,1    REG28
         BAL,L1   B0VT
         BAL,L1   SSLVD             LOAD V0  D3
         LW,D0    FLLBFLG
         BEZ      SS16              NORMAL
*        FLL TO BINARY
         LI,R6    X'2D'             R2 BIN
         LI,R7    X'F'              FLL
         LI,D1    X'20'             R2
         BAL,L0   LRR01             FLL TO BINARY
         BAL,L1   BOVT
         BAL,L1   SSLVD             V0  D3
         AI,V0    CSTW+CRR2
         BAL,L1   VRSAD
         B        SS17
*
SS16     RES      0
         AH,V0    SSST,R3
         BAL,L1   VRSAD0            RESOLVE VAR REC
SS17     BAL,L1   MDF65
         BAL,L1   JNOVT
*
SS19     MTW,-1   SSCNT
         BNEZ     SS05
         LI,D0    0
         B        *SSRET
*
*        VERY LAST OP
SS20     RES      0
*        DIVIDE IS LIKE NOT LAST EVEN THO LAST
         CI,R1    3
         BE       SS15
         LW,D0    FLLBFLG
         BNEZ     SS15
*
*
SS21     EXU      SS55,R1           0,1,2,3 = +,-,*,/
         BAL,L0   CLRD1
         BAL,L1   VRBRC             RESOLVE VAR REC
         BAL,L1   MDF65
         BAL,L1   BOVT
         LW,V0    SSTV0
         AH,V0    SSSTX,R3
         BAL,L1   VRSAD0            RESOLVE VAR REC
         B        SS17
*
SS50     LH,V0    SSAS,R3           0   ADD
         LH,V0    SSAS,R3           1   SUBTRACT
         LH,V0    SSMP,R3           2   MULTIPLY
         LH,V0    SSDV,R3           3   DIVIDE
*
SS55     AH,V0    SSASX,R3          ADD
         AH,V0    SSASX,R3          SUBTRACT
         AH,V0    SSMPX,R3          MULTIPLY
         AH,V0    SSDVX,R3          DIVIDE
*
*        BAL,L1   LOAD  R1   R3
SSLR13   RES      0
         LW,R1    STMTYP
         LW,R3    SSOPTYP
         B        *L1
*
*        LOAD V0  D3
*        BAL,L1
SSLVD    RES      0
         LW,V0    SSTV0
         LW,D3    SSTD3
         B        *L1
*
*        GIVE
SSG00    RES      0
         AH,V0    SSGIV,R3
SSG10    RES      0
         BAL,L1   VRBRC
         BAL,L1   MDF65
         MTW,-1   NTOT
         B        SS19
SSAM00   RES      0
         AI,V0    CAWM+CRR9
         B        SSG10
*        LOAD RECEIVING
*        BIN,FLS,FLL
SSLD     RES      0                 0,1,2
         GEN,16,16 CLW+CRR2,CLW+CRR2   LW,R2  LW,R2
         GEN,16,16 CLD+CRR2,0          LD,R2
*        STORE
SSST     RES      0
         GEN,16,16 CSTW+CRR3,CSTW+CRR2 STW,R3  STW,R2
         GEN,16,16 CSTD+CRR2,0         STD,R2
*
*
SSAS     RES      0
         GEN,16,16 CAW+CRR3,CFAS+CRR2  AW,R3  FAS,R2
         GEN,16,16 CFAL+CRR2,0         FAL,R2
*
SSMP     RES      0
         GEN,16,16 CMW+CRR3,CFMS+CRR2  MW,R3  FMS,R2
         GEN,16,16 CFML+CRR2,0         FML,R2
*
SSDV     RES      0
         GEN,16,16 CDW+CRR2,CFDS+CRR2  DW,R2  FDS,R2
         GEN,16,16 CFDL+CRR2,0         FDL,R2
*        SIMPLE GIVE/LAST STORE
SSGIV    RES      0
SSSTX    RES      0
         GEN,16,16 CSTW+CRR9,CSTW+CRR8 STW,R9  STW,R8
         GEN,16,16 CSTD+CRR8,0         STD,R8
*
*
SSASX    RES      0
         GEN,16,16 CAW+CRR9,CFAS+CRR8  AW,R9  FAS,R8
         GEN,16,16 CFAL+CRR8,0         FAL,R8
*
SSMPX    RES      0
         GEN,16,16 CMW+CRR9,CFMS+CRR8  MW,R9  FMS,R8
         GEN,16,16 CFML+CRR8,0         FML,R8
*
SSDVX    RES      0
         GEN,16,16 CDW+CRR8,CFDS+CRR8  DW,R2  FDS,R2
         GEN,16,16 CFDL+CRR8,0         FDL,R8
*
SSRX     RES      0
         DATA     9,8,8
*        FLL PARTIAL ---  DECIMAL SERIES
*
FD00     RES      0
         STW,L1   SSRET
*
FD05     RES      0
         MTW,-1   NTOT
         BAL,L1   READMCF           GET DECIMAL OPERAND
         LW,D0    GIVOP
         BNEZ     FD20              GIVING
*
*        DECA --- FLL
         LI,R6    X'6F'             R6 FLL TEMPORARY FOR CONVERTION
*
         LW,V1    BDECP
         BAL,L0   CLRD0             SET SAVE VAR PARAM FLAG
         BAL,L0   LRD00             LOAD DEC OP TO FLL
*
         LW,V1    BSIZE
         SW,V1    BDECP             SIZE - DECP
         CI,V1    73
         BL       FD09              OK
         BAL,L1   BOVT              OVERFLOW TEST
FD09     RES      0
         BAL,L1   PIA06
         LD,R2    R6
FD10     RES      0
         LW,R1    STMTYP
         LI,R3    2                 FLL
         LI,D1    8                 R8
         EXU      SS50,R1
         MTW,1    REG28
         BAL,L1   PIA02             FAL  FML  FDL,R8   R6
         BAL,L1   BOVT
         BAL,L1   PIA06
         LD,R6    R2                **** WRITE LD,R6  R2
         LI,D1    X'60'             GIVING R8 FLL
         B        FD21
*
FD20     RES      0
         LI,D1    X'80'
FD21     RES      0
         LI,R6    8
         LI,R7    X'F'              FLL
         LW,V1    BDECP
         AW,V1    JDRND             0 1
         STW,V1   CDECP
         BAL,L0   LRR01             FLL --- DECA
         BAL,L1   BOVT
*
FD25     RES      0
         LI,D0    30
         STW,D0   CSIZE
         BAL,L1   SD00              STORE THE DECA
*
FD30     RES      0
         MTW,-1   NDEC
         BNEZ     FD05
         B        *SSRET
*
*        ARITHMETIC TO THE DECA
*        ADD TO DECA AND STORE  MULT, DIVIDE  ALSO
ADS00    RES      0
         STW,L1   ADSRET
ADS15    RES      0
         BAL,L1   READMCF
         MTW,-1   NTOT
         LD,D0    DSIZE             PARTIAL  FOR ADD/SUB
         STD,D0   CSIZE             CURRENT
         LW,R1    STMTYP            0,1,2,3
         CI,R1    1
         BG       %+2               MULTIPLY OR DIVIDE
         MTW,1    NOARTF
         LW,R6    ADS90,R1
*        FORCE SUBTRAHEND FOR LOAD POSITIVE  ADDTITION
         STW,R6   SUBTHND
         BAL,L1   *R6
         BAL,L0   SETDG
*                                   DECA IS GOOD AT CSIZ,DP
         BAL,L1   SD00              STORE THE DECA
         BAL,L0   SETDB             NO GOOD
         MTW,-1   NDEC
         BNEZ     ADS15
*
         B        *ADSRET
*
ADS90    RES      0
         DATA     WA(DAD00)
         DATA     WA(DAD00)
         DATA     WA(DMD00)
         DATA     WA(DD00)
*
*        READ MCF OP CLUSTER
*        BAL,L1
READMCF  RES      0
         STW,L1   RDMCRET
         LW,D0    SPGIV
         BNEZ     RDM30
         BAL,L1   BAA46             SAVE VAR FLAG
         LI,L0    0
         STW,L0   LITF              CLEAR LITERAL FLAG
         STW,L0   NOVF
         MTW,0    REMBIT
         BEZ      RDM03
         MTW,0    REMSTF
         BEZ      RMDEC
         LI,L0    0                 RESET REMAINDER BIT
         STW,L0   REMSTF
         LW,D0    RESMOD
         CI,D0    X'D'
         BG       RDM01
         BE       RDM00
         LD,D0    RSIZE
         STD,D0   DSIZE
         MTW,0    RCONV
         BNEZ     RDM020
         BAL,L1   LDECA             RELOAD DECA
         B        RDM03
RDM00    MTW,0    RCONV             BINARY
         BLZ      RDM01             BIN TO FLL
         BEZ      RDM021
         BAL,L1   LDECA             RELOAD DECA
         B        RDM020
RDM01    LW,R6    REG28
         LH,D1    REGNO1,R6
         LH,V0    REGNO5,R6
         AI,V0    CLD               LD,FR1  FR2
         BAL,L1   PIA02
RDM020   LI,L0    0
         STW,L0   RCONV
         B        RDM03
RDM021   BAL,L1   FLPR2
         B        RDM03
LDECA    STW,L1   SAVL1
         MTW,0    REMSTF
         BNEZ     *SAVL1            REMAINDER
LDECA1   BAL,L1   PRT06             LOAD SAVED DECA
         DL,0     ADT1
         LD,D0    DSIZE
         STD,D0   CSIZE
         BAL,L0   SETDG
         B        *SAVL1
RMDEC    LH,D0    1,R5              SECOND BYTE
         AND,D0   L(X'80')
         STW,D0   REMSTF            SET FOR REMAINDER
         BEZ      RDM03             NOT REMAINDER
         LW,D0    RESMOD
         CI,D0    X'D'
         BGE      RMFLP
         BAL,L1   PIA06
         DL,0     0,R3              LOAD LONG REMAINDER
*        THE FOLLOWING CODE WILL SEE IF THE REMAINDER IS COMP           COBOL42F
*        AND GENERATE  CODE TO CONVERT IT TO BINARY IF IT IS            COBOL42F
         LH,D1    0,R2              PICK UP CLNG                        COBOL42F
         AND,D1   =X'000D'                                              COBOL42F
         CI,D1    X'D'              IS IT BINARY                        COBOL42F
         BNE      RMDEC1            NO                                  COBOL42F
         LI,D1    0                                                     COBOL42F
         LI,V0    CLI+CP1                                               COBOL42F
         AI,V0    5                                                     COBOL42F
         BAL,L1   PIA02             GENERATE LI,10   327680             COBOL42F
         BAL,L1   PIX06                                                 COBOL42F
         TEXT     ':CDB'            GENERATE BAL,11  C:CDB              COBOL42F
RMDEC1   RES      0                                                     COBOL42F
         LD,D0    DSIZE
         STD,D0   RSIZE
         BAL,L0   SETDG
         B        RDM03
RMFLP    LW,R6    REG28
         CI,D0    X'E'
         BL       RMBIN             BIN
         MTW,0    NTOT
         BLEZ     RMFLP0            LAST ENTRY
         BAL,L1   FLPR3
RMFLP0   LH,V0    REGNO5,R6
         BAL,L1   FLPR1
         LW,D0    RESMOD
         CI,D0    X'E'
         BE       RDM03             FLS
         AI,V0    X'10'
         BAL,L1   PIA02
         B        RDM03
RMBIN    MTW,0    RCONV
         BEZ      RMBIN1
         BLZ      RMBIN2
         BAL,L1   FLPR2
         MTW,0    R6
         BEZ      RMBIN0
         BAL,L1   PIA06             **** WRITE LW,R9  R3
         LW,R9    R3
RMBIN0   LI,R6    X'8'
         BAL,L1   BFD00             CONVERT REMAINDER
         LI,D0    10
         LI,D1    0
         STD,D0   DSIZE
         B        RDM03
RMBIN2   MTW,0    NTOT
         BLEZ     RMBIN21
         BAL,L1   FLPR3
RMBIN21  LI,D1    R6
         LH,V0    REGNO6,R6
         AI,V0    CLW
         BAL,L1   PIA02             LOAD REMAINDER
         LI,R6    X'8F'
         BAL,L1   BFD00             CONVERT TO FLL
         B        RDM03
RMBIN1   BAL,L1   FLPR2
*        BSIZE, BDECP, JDRND, RSHFT, OPTYP, JDCOMP
*        RESIZE, RESDECP, KDUBLI
*
RDM03    RES      0
         LH,D0    0,R2
         AND,D0   K3FF
         AND,D0   L(X'F0')
         CI,D0    X'90'
         BNE      RDM05
         MTW,1    LITF              SET LITERAL FLAG
         MTW,1    NOVF
         LW,R6    LITGEN                                                COB0L42F
         BAL,L1   LIT00             MAKE DECIMAL - EXPEDIENT
       LH,D0   3,R5                FIX UP LITERAL
       SLS,D0  -1                  BYTE SIZE ERROR
       AI,D0   1
       STH,D0  3,R2                BYTE SIZE
RDM05    RES      0
         BAL,L1   BDS00
         LH,D0    1,R5
         AND,D0   LSOPBIT
         STW,D0   NOARTF            SET SAVE VAR REC PARAM FLAG
         STW,D0   SUBTHND
         BEZ      RDM15
*
*
         BAL,L1   BAA42             SAVE DATA CLUSTER IN MDBUF
RDM15    RES      0
         B        *RDMCRET
*        SPECIAL +,- GIVE REC CLUSTER
RDM30    RES      0
         LI,R2    HA(MDBUF)-1      NOT IS ACTUALLY SROT
         LI,R5    HA(MDBUF)-2
         BAL,L1   BDS00
         B        RDM15
FLPR1    LI,D1    0
         AI,V0    CLI
         B        PIA02             **** WRITE LI,FR  0
FLPR2    LH,D1    REGNO3,R6
         LH,V0    REGNO5,R6
         AI,V0    CXW               XW,FR  FR+1
         B        PIA02
FLPR3    LH,D1    REGNO2,R6
         LH,V0    REGNO4,R6
         AI,V0    CLD
         B        PIA02
REGNO1   DATA     X'20008'          FLOATING REG
REGNO2   DATA     X'80002'
REGNO3   DATA     X'90003'
REGNO4   DATA     X'200080'
REGNO5   DATA     X'800020'
REGNO6   DATA     X'900030'
*
*        LOAD INTERFACE
LD00     RES      0
         LW,L0    L1                FIXUP
         LW,V1    BDECP
*        LH,V1    4,R5              DONE
*        STW,V1   BDECP             BY
*        LH,V0    3,R5              RDMCF
*        AND,V0   K3FF              VIA
*        STW,V0   BSIZE             BSD00
*        LOAD INTERFACE
*        BAL,L0   LD05   IF LINK IS VIA L0  AND V1 IS LOADED
LD05     RES      0
         LW,D0    GIVOP
         OR,D0    COMPFLG
         BNEZ     LD06
         MTW,0    NOARTF
         BEZ      LD06
         LI,D0    1
         STW,D0   ARTHF             SET SAVE VAR PARAM POINTER
LD06     LW,D0    STMTYP
         CI,D0    1
         BNE      LD10              NOT SUBTRACT
         LW,D0    SUBTHND
         BEZ      LRN00             NEGATIVE LOAD FOR SUBTRACT
*        LOAD NEGATIVE
LD10     RES      0
         B        LRD00             STRAIGHT LOAD
*
*        BAL,L1   BSIZE, DECP FROM CLUSTER
BSD00    RES      0
BBFBSD   RES      0                 EXPRESSION ENTRY
BDS00    EQU      BSD00
         LH,D0    3,R5
         AND,D0   K3FF
         STW,D0   BSIZE
         LH,D0    4,R5
         STW,D0   BDECP
         LH,D0    3,R2              BYTE SIZE
         STW,D0   BYTSZB
*
BSD05    RES      0
         LW,D0    COMPFLG
         BNEZ     BSD10             EXPRESSION USE
*
         LH,D0    1,R5
         AND,D0   DBLBIT
         STW,D0   KDUBLI
         LH,D0    1,R5
         AND,D0   RNDBIT
         SLS,D0   -2                0 1
         STW,D0   JDRND
         LH,D0    1,R5
         SLS,D0   -8
         STW,D0   RSHFT
BSD10    RES      0
         LH,D0    0,R2
         AND,D0   K30F
         STW,D0   0PTYP
         STW,D0   JDCOMP            SET YES COMP
         AI,D0    -X'D'             D E F
         STW,D0   OPNDX             0 1 2  GARGABGE
         LW,D0    OPTYP
         CI,D0    8
         BL       BSD15
         CI,D0    X'A'
         BL       BSD20             COMP
BSD15    RES      0
         LI,D0    0
         STW,D0   JDCOMP
BSD20    RES      0
BSD25    RES      0
         B        *L1
*        LOAD DECA TO R6 FLL  R7 BIN
*        DDECP
*        R6 LOADED
*        BAL,L1
LDR67    RES      0
         STW,L1   LDR67R
         BAL,L1   LDB00             LOAD DECA IF BAD
         LI,R7    8                 DECA
         LW,V1    DDECP
         BAL,L0   LRR01
*
         LW,V1    DSIZE             SIZ - DECP
         SW,V1    DDECP
         B        *LDR67R
*
*        LOAD DECA FROM DT1 IF  NO GOOD
*        BAL,L1
LDB00    RES      0
         LW,D0    DECAGD
         BNEZ     *L1
         STW,L1   LBDRET
         BAL,L1   PRT06
         DL,0     ADT1
         B        *LBDRET
*
*        BAL,L0
SETDB    RES      0                 SET DECA BAD
         LI,D0    0
         B        SETDEC
SETDG    RES      0                 SET DECA GOOD
         LI,D0    1
SETDEC   RES      0
         STW,D0   DECAGD
         B        *L0
SETDNS   RES      0                 SET DECA NOT STORED
         LI,D0    0
         B        SETST
SETDST   RES      0                 SET DECA STORED
         LI,D0    1
SETST    RES      0
         STW,D0   DECAST
         B        *L0
*
*        UNPACK MASTER CLUSTER
*        BAL,L1
UC00     RES      0
         LI,V1    0
         STW,V1   VRPMD             RESET VAR TABL POINTER
         STW,V1   VRPPD
UC03     RES      0
         STW,R5   UC90R5
         LI,R6    WA(CLDATA)
         LI,V1    16
UC05     RES      0
         LH,V0    1,R5
         STW,V0   0,R6
         AI,R5    1
         AI,R6    1
         BDR,V1   UC05
         LW,R5    UC90R5
UC10     RES      0
         LW,V0    OSE0
         STW,V0   OSEI
         BEZ      UC11
         MTW,1    OSEI
UC11     RES      0
         LW,V0    STOPT
         AND,V0   GIVBIT
         STW,V0   GIVOP
         LW,V0    STOPT
         AND,V0   FBTBIT
         STW,V0   FBTOP
         LW,V0    STOPT
         AND,V0   DBLBIT
         STW,V0   DUBL
         MTW,0    REMBIT
         BEZ      UC15              NO REMAINDER
         LW,V0    TYPBTS
         SAD,V0   -8
         STW,V0   TYPBTS            SAVE REMAINDER DECP
         SAS,V1   -24
         LI,V0    4
         AND,V0   STOPT             ROUND BIT
         BEZ      %+2
         AI,V1    1                 ROUNDED
         STW,V0   RMRND
         LW,V0    RESMOD
         CI,V0    8
         BG       UC12              NOT DECIMAL
         LI,V0    X'10'
         STW,V0   DUBL              SET DPD FLAG
         LW,V0    CLDECP
         STW,V1   CLDECP
         SW,V1    V0
         STW,V1   DPDSA             BDECP - CLDECP
UC12     LW,V0    L(X'FFFFFBFB')    CLEAR REMAINDER
         AND,V0   STOPT                  AND ROUND BITS
         STW,V0   STOPT
UC15     RES      0
         LW,V0    STOPT
         AND,V0   SMPBIT
         STW,V0   SMPOP
*
         LW,R1    MCBUF
         AND,R1   K260          IS THIS A DEVIDE OR MULTIPLY
         BEZ      LITDET                NO
         LI,R1    8             YES SET LITERAL TYPE TO DECIMAL
         STW,R1   LITGEN
         B        SKIPLITD
LITDET   RES      0
*  GET TYPE BIT  TO DETERMINE  MODE  OF LITERALS                        COB0L42F
*  SIDR  SIG7-0703                                                      COB0L42F
         LI,R1    4                                                     COB0L42F
         LW,D0    TYPBTS            TYPE BITS                           COB0L42F
         SLS,D0   18                SHIFT T0 HIGH P0S                   COB0L42F
         SLS,D0   1                 SHIFT 0FF 1 AT A TIME               COB0L42F
         BOD      %+2               FOUND ONE                           COB0L42F
         BDR,R1   %-2               L00P                                COB0L42F
         AND,R1   L(X'3')           EQUATE FIRST BIT FOUND T0 0         COB0L42F
         LB,D0    LITCTL,R1         GET LIT CONTROL                     COB0L42F
         STW,D0   LITGEN            SAVE IT                             COB0L42F
SKIPLITD RES      0
         LW,D0    NTOT
         AI,D0    -1
         STW,D0   MANYOPS           0 = NO (IE SINGLE OP REC.)
*
         B        *L1
LITCTL   DATA     X'080F0E0D'       DEC,BIN,FLS,FLL                     COB0L42F
LITGEN   RES      1                                                     COB0L42F
*
*        GEN LINKAGE TO SIZE ERRORTEST
*        D1 IS SIZE
*        BAL,L1
CSZT     RES      0
         LW,D0    OSE0
         BEZ      *L1
*        BAL,L1   CSZT
*        D1       SIZE
*        GENERATE SIZE ERROR CALL SEQ
CSZT5    RES      0
         STW,L1   SZTRET
         LCW,D1   D1
         AI,D1    31
         LI,V0    CLI+CP1
         BAL,L1   PIA02
         BAL,L1   PIX06
         TEXT     ':SZT'
         BAL,L1   BOVT
         BAL,L0   SETDB             SET DECA NO GOOD
         B        *SZTRET
*
*        BAL,L1   BOVT
*        GEN      BOV  OSEI (OSE0 IF LAST) IF SIZE ERROR
*
B0VT     RES      0
BOVT     RES      0
*        SET FLAG INDICATING BOVT EXECUTED
         STW,L1   OSEIX             NON ZERO FLAG
         LW,D1    OSEI
BOVT1    RES      0
         BEZ      *L1
         LI,V0    CBOV
         LW,D0    SUMSUM
         BNEZ     BOVT4             OSE0
         LW,D0    NTOT
         BNEZ     BOVT5
BOVT4    LW,D1    OSE0
BOVT5    RES      0
         B        PII02
*
*        BAL,L1   JNOVT
JNOVT    RES      0
         LW,D0    OSE0
         BEZ      *L1
         STW,L1   JNORET            SAVE RETURN
         LW,D0    NTOT
         BEZ      JNOVT5
*
*        NOT LAST
JNOVT3   RES      0
         LW,D0    OSEIX             IF BOVT NOT EXECUTED
         BEZ      JNOVT9            FORGET SIZE ERROR CODE HERE
JNOVT35  RES      0
         BAL,L1   PIL06
         B        2                 B %+2
         LW,D1    OSEI
         LW,D0    NSTAG
         BNEZ     JNOVT4
         LW,D1    OSE0              CORRESPONDING
         STW,D1   SZECLUP           SET SZE CLEANED UP FLAG
JNOVT4   RES      0
         BAL,L1   PPI12             OSE I/O DEF
         BAL,L1   PRT06
         STCF     AOVFLG
         MTW,1    OSEI
         B        JNOVT9
JNOVT5   RES      0
         LW,D1    NSTAG
         BEZ      JNOVT35           CORRESPONDING NOT LAST
         LW,D0    CORESF            CORRESPONDING OR
         AW,D0    MANYOPS           SEVERAL RECEIVING FIELDS
         BNEZ     JNOVT7
*
*        SINGLE RECEIVING
         LI,V0    CB
         B        JNOVT8
JNOVT7   BAL,L1   PRT06
         LC       AOVFLG            LC OFLAG
         LW,D1    NSTAG
         LI,V0    CBNOV
JNOVT8   RES      0
         BAL,L1   PII02             BNO NST
         LW,D1    OSE0
         STW,D1   SZECLUP           SET SZE CLEANUP FLAG ON
         BAL,L1   PPI12             OSE0 DEF
JNOVT9   RES      0
         LI,D0    0
         STW,D0   OSEIX
         B        *JNORET
*
*        OVERFLOW IN COMPUTATION
BVSE0    RES      0
BOVSE    RES      0
B0VSE    RES      0
         LW,D1    OSE0
         B        BOVT1
*
*        ZERO OVER-FLOW FLAG
*        BAL,L1
ZOVF00   RES      0
         LW,D0    OSE0
         BEZ      *L1
         LW,D0    MANYOPS
         BEZ      *L1               SINGLE REC FIELD
         STW,L1   ZOVFRET
         BAL,L1   PIA06
         LI,R1    0
         BAL,L1   PRT06
         STW,R1   AOVFLG
         B        *ZOVFRET
*
*        4.2 CONSTANTS
DSZPR    DATA      X'1D'                  29
K301     DATA     X'01'
K260     DATA     X'6000'
K30F     DATA     X'0F'
K3FF     DATA     X'FF'
LSOPBIT  DATA     X'80'
RNDBIT   DATA     X'4'
CORESBT  DATA     X'8000'
GIVBIT   DATA     X'200'
FBTBIT   DATA     X'100'
DBLBIT   DATA     X'10'
SMPBIT   DATA     X'40'
DMD90    GEN,8,24 6,ADT1*4
DDB90    EQU      DMD90
DBADT2   GEN,8,24 6,ADT2*4          BYTE ADDR DT2
*        4.2 WORKING STORAGE
*        CLUSTER  DATA
CLDATA   RES      0
STOPT    DATA     0
NSTAG    DATA     0
OSE0     DATA     0
CLSIZ    DATA     0
CLDECP   DATA     0
MAXDP    EQU      CLDECP
CLSHFT   DATA     0          CLUSTER SHIFT OR INDEX
RESMOD   DATA     0
NTOT     DATA     0
NTYPS    DATA     0
TYPBTS   DATA     0
NDESC    DATA     0
NASC     DATA     0
NBIN     DATA     0
NFLS     DATA     0
NFLL     DATA     0
NDEC     DATA     0
DUBL     DATA     0
KDUBL    EQU      DUBL
KDUBLI   DATA     0
BYTSZB   DATA     0
REVDIV   DATA     0
DPMP1    DATA     0
DPDP1    EQU      DPMP1
SMPLOP   DATA     0
SMPOP    EQU      SMPLOP
FLPRX    DATA     0
UC90R5   DATA     0
OSEI     DATA     0
*
AN:EXP   DATA     0                 AN EXPRESSION FLAG                  COBOL42F
OSEIX    DATA     0
SZECLUP  DATA     0                 SIZE ERROR CLEANUPFLAG
*
DDPCSR   DATA     0
DDRET    DATA     0
BSLRET   DATA     0
ARSRET   DATA     0
DADRET   DATA     0
SDRET    DATA     0
SSRET    DATA     0
ADSRET   DATA     0
RDMCRET  DATA     0
LDR67R   DATA     0
LBDRET   DATA     0
SZTRET   DATA     0
JNORET   DATA     0
ZOVFRET  DATA     0
DMDRET   DATA     0
DDBRET   DATA     0
         BOUND    8
VRSAV    RES      2
RSIZE    RES      1
RDECP    RES      1
DPDSA    DATA     0
REMBIT   DATA     0
REMSTF   DATA     0
RCONV    DATA     0
REG28    DATA     0
RDVSV    DATA     0
RMRND    DATA     0
DPMSC    DATA     0
NOARTF   DATA     0
SAVL1    RES      1                 SAVE L1
         BOUND    8
CSIZE    DATA     0
CDECP    DATA     0
DSIZE    DATA     0
DDECP    DATA     0
BSIZE    DATA     0
BDECP    DATA     0
CORESF   DATA     0
STMTYP   DATA     0
SUBTHND  DATA     0
SBTHND   EQU      SUBTHND
SRTHND   EQU      SUBTHND
GIVOP    DATA     0
GIV0P    EQU      GIVOP
FRTOP    DATA     0
FBTOP    EQU      FRTOP
FRT0P    EQU      FRTOP
MANYOPS  DATA     0
SPGIVE   DATA     0
SPGIV    EQU      SPGIVE
SMANY    DATA     0
RSHFT    DATA     0
SHFT     EQU      RSHFT
SHIFT    EQU      RSHFT
*        SHIFT FROM SDOO  STORE THE DECA   COMPUTED
SDSHFT   DATA     0
COMPFLG  DATA     0                 EXPRESSION COMPUTE FLAG
JDCOMP   DATA     0
JDRND    DATA     0
JSRND    DATA     0
JDSIZS   DATA     0
SSCNT    DATA     0
SSTV0    DATA     0
SSOPTYP  DATA     0
*        FLAG FOR FFF/BINARY OPERATION
FLLBFLG  DATA     0
*        DECA TO BINARY SERIES FLAG
DECBINF  DATA     0
*        FLAG FOR FLP00  IF BINARY FIELSDS RETURN TO DP15
DECFLF   DATA     0
*        D3 BASE / DISP FROM SSB00
SSTD3    DATA     0
*
ASNTYP   DATA     0
OPNDX    DATA     0
DECAST   DATA     0
DECAGD   DATA     0
OPTYP    DATA     0
0PTYP    EQU      OPTYP
SUMSUM   DATA     0
*        DT2 CLUSTER
DT2CL    RES      0
         DATA     X'0A880000'
         DATA     X'00000600'
         GEN,16,16 ADT2*4,1         N,DSIZ
         DATA     0                 BSIZ,DECP
         DATA     0
*
RECLUS   RES      0                 RECEIVING CLUSTER
JSAVD    EQU      JDECP+14
*
         END
