         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.2 - CONDITIONS'
* 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(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1     AF(3)
         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(3))
         B        DIAG
         ELSE
         DO       NUM(AF(2))
         LI,L1    AF(2)             LOAD LINK REGISTER
         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
* CHECK FLAG                                                             1
CWF      CNAME                                                           2
         PROC                                                            3
* LF     CWC,R-,B-   LINK,FLAG                                           4
         DO       NUM(CF(2))
         DO       NUM(AF(2))                                            APW11
         LW,CF(2) AF(2)             LOAD,CHECK FLAG
         ELSE                                                            7
         LW,CF(2) JCREF             LOAD,CHECK NREF
         FIN                                                             9
         ELSE                                                           12
         DO       NUM(AF(2))                                             5
         LW,L1    AF(2)             LOAD,CHECK FLAG
         ELSE
         LW,L1    JCREF             LOAD,CHECK NREF
         FIN                                                            14
         FIN                                                            APW16
         BGZ      AF(1)             UP.
         PEND
* EXTERNAL REFERENCES
         REF      RDMCF
         REF      BAA02             RETURN
         REF      BAA40,BAA42
         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      PIX02,PIX06,PIX08
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PRB00,PRB02,PRB06,PRB20,PRB22,PRB26
         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,PPI12
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      MTL20
         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      MRR00
         REF      MRR10,MRR11,MRR12
         REF      MRR40,MRR41,MRR42
         REF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
         REF      NRR10,NRR11,NRR12
         REF      NRR40,NRR41,NRR42
         REF      NRR60,NRR61,NRR62
         REF      NRR70,NRR71,NRR72
         REF      NRR80,NRR81,NRR82
         REF      NRD02
         REF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         REF      ORD12,ORD22,ORD23,ORD24
         REF      ORD42,ORD44,ORD48
         REF      MDF01,MDF21,MDF61 ZERO/BLANK FILL
         REF      NDF00,NDF04
         REF      MBS00,MBS01,MBS02
         REF      MBS42,MBS62
         REF      NBS00,NBS02,NBS04
         REF      NBS20,OBS20
         REF      NBS62
         REF      OBS14
         REF      OBS90
         REF      LDR00,LDR20,LDR60,LDR70,LDR80
         REF      MDR00,MDR30,MDR40,MDR50
         REF      MDR60,MDR64,MDR66,MDR68
         REF      MDR80,MDR84,MDR88
         REF      MDR70,MDR74,MDR78
         REF      MDE00
         REF      NDR30,NDR31,NDR32
         REF      NDR38,NDR40
         REF      MDR02
         REF      NDR00
         REF      ODR00
         REF      ODR16
         REF      ODR32,ODR34
         REF      MDS00,MDS01
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      LIT00
         REF      BBB60,BBB62,BBB70,BBB80,BBB88
         REF      BBC12,BBC20,BBC31
         REF      BBC33
         REF      BBC91,BBC92
         REF      BBE53
         REF      EBC02,EBC92
         REF      MCBUF,MDBUF
         REF      JSXSX             GRP SUBSCRIPT SWITCH
         REF      JSXR
         REF      BBCSAV            LINK
         REF      DIAG
         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      LRN00,WRPOF
         REF      BBFDDB,BBFDDI,BBFDMD,BBFDAD,BBFBSD,CDECP,DUBL
         REF      CSIZE,RSHFT,STMTYP,SUBTHND,BOVSE
         REF      NOVF,LITF,BAA48
         REF      VBIDX,VPP30
         DEF      SCCBD             SHIFT COUNT
JSAVD    EQU      JSXR+17
* 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
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
RI       EQU      R7                INDEX
         TITLE    'PHASE 4.2K - EXPRESSION'
RFL      EQU      V0                FLP
RF       EQU      V2                FILE CNTL
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
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
CRE      EQU      RE*16             EVEN
CRO      EQU      RO*16             ODD
CRB      EQU      CRR6              BIN
CRI      EQU      CRB+X'10'         INDEX                                2
CRFL     EQU      CRV0              FLP
CRF      EQU      CRV2              FILE CNTL
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
CSXR     EQU      X'F0000'          SUBSCRIPT FLAG                       2
CSXRS    EQU      X'10000'          SXR SAVED
* OP CODES
CCAL1    EQU      X'0400'           CAL1
CCD      EQU      X'1100'
CLD      EQU      X'1200'                                               C12
CSTD     EQU      X'1500'
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CCI      EQU      X'2100'
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'
CCW      EQU      X'3100'
CLW      EQU      X'3200'                                               C32
CMTW     EQU      X'3300'
CSTW     EQU      X'3500'           STW                                 C35
CFAS     EQU      X'3D00'
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
CLAH     EQU      X'5B00'
CCBS     EQU      X'6000'
CMBS     EQU      X'6100'
CBDR     EQU      X'6400'                                               C64
CAWM     EQU      X'6600'
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
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CPACK    EQU      X'7600'                                               C76
CDA      EQU      X'7900'
CDSA     EQU      X'7C00'
CDC      EQU      X'7D00'
CDL      EQU      X'7E00'
CDST     EQU      X'7F00'
CIND     EQU      X'8000'           INDIRECT BIT                        C900
* 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
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'0415'           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
DADX     EQU      X'0328'           EXTERNAL NAME
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
DGF1     EQU      8                 FL'1.E0'
* 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
DTX      EQU      27                INDEX
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
DTSXR    EQU      26                SXR
DTWA     EQU      28                WA TMP WORK AREA
DTBA     EQU      DTWA*4            BA TMP WORK AREA                    22
* ENTRY POINTS
         DEF      BDE00
*
*        BDE00 -- ROUTINE TO GENERATE CODE FOR ARITHMETIC EXPRESSIONS.
*        THIS ROUTINE IS DRIVEN BY THE E CLUSTERS OUTPUT BY ADE00 IN PHASE 4.1.
*        THE BULK OF THE CODE GENERATION IS ACTUALLY ACCOMPLISHED BY
*        ROUTINES ELSEWHERE IN PHASE 4.2. THE JUMP VECTOR AT JTBL SELECTS
*        WHICH OF THE ROUTINES ELSEWHERE IN PHASE 4.2 WILL BE GIVEN CONTROL.
*        REGISTERS 1,3,4, AND 6-15 ARE PRESERVED. REGISTERS 2 AND 5 UPON
*        EXIT POINT TO A CLUSTER DESCRIBING THE RESULT OF THE ARITHMETIC
*        EXPRESSION.
BDE00    RES      0
         LCI      15
         STM,1    SAVVV
         BAL,11   BAA42
         STW,2    SAVVV+1
         STW,5    SAVVV+4
         LI,0     0                    CLEAR OLD DATA CLUSTER
         STW,0    SAVED
         STW,0    SCCBD
NX       RES      0
REPEATT  BAL,11   RDMCF
         LW,3     BASAVED              SET UP REGISTERS FOR MOVE AND FOR R
*        SET UP 2 AND 3 TO MOVE CLUSTER TO SAVED.
         LB,7     0,2
         SLS,7    1
         STB,7    3
         AI,2     1
         LB,7     0,2                  TEST CONTROL BYTE
         AND,7    HI4
         CI,7     X'80'
*        ALLOW '80' THROUGH 'EF'.
         BCS,1    BADCB
         CI,7     X'E0'
*        SELECT SUBROUTINE TO BE PERFORMED.
         BCR,1    TRYE
*        THIS BRANCH TAKEN FOR DATA REFERENCE TYPE CLUSTERS '8X', '9X',
*        'AX', 'BX'.
         AI,2     1
         LB,11    0,2
         AI,2     -2
         AND,11   BIT8
*        IF THIS BIT IS 0 THE CLUSTER IS SKIPPED.
         BCR,3    REPEATT
         MBS,2    0                    SAVE DATA CLUSTER
         CI,R7    X'90'
         BL       BDEVR
         MTW,1    NOVF              SET LITERAL FLAG
         MTW,1    LITF
         B        REPEATT
BDEVR    LI,R7    0
         STW,R7   NOVF              RESET LITERAL FLAG
         STW,R7   LITF
         LW,2     HASAVED           HA OF SAVED DATA CLUSTER
         BAL,L1   BAA48             RESOLVE VAR REC
         B        REPEATT
TRYE     BCS,3    BADCB
         LW,1     2
         SLS,1    -1                   HA OF E CLUSTER TO R6
         LB,7     0,2
         AND,7    LO4
         LW,2     HASAVED
         LW,5     HASAVMW
*        SET 2 TO HA OF SAVED CLUSTER. SET 5 TO HA-1 OF SAVED CLUSTER. SET
*        6 FROM SECOND HW OF CLUSTER. SET 9 FROM THIRD HW OF CLUSTER.
*        SET 13 FROM FOURTH HW OF CLUSTER. SAV1 TO HA+1 OF E CLUSTER.
         LH,9     1,1
         AI,1     1
         STW,1    SAV1
         LH,13    1,1
         LH,6     0,1
         B        JTBL,7
BADCB    RES      0
         LI,1     506
         BAL,11   DIAG              COMPILER ERROR 06
         B        NX                IF CONTINUE
JTBL     B        BADCB
*        JUMP VECTOR.
         B        LITXX
         B        LRDXX
         B        LRNXX
         B        LRRXX
         B        SSBXX
         B        KERRY
         B        BOVXX
         B        BADCB
         B        BADCB
         B        BADCB
         B        POFABS
         B        POFLIT
         B        POFXX
         B        EXPXX
*        RESTORE REGISTERS AND EXIT.
L10      LCI      15
         LM,1     SAVVV
         B        *EXXIT
*        GENERATE OVERFLOW TEST INSTRUCTION FOR ON SIZE ERROR.
BOVXX    RES      0
         BAL,11   BOVSE
         B        NX
*        GENERATE LITERAL FOR SAVED AND SET SAVED TO ITS LOCATION.
LITXX    BAL,11   LIT00
         LI,8     0
         STW,8    SX8
         B        NX
*        GENERATE LOAD OF DATA ITEM DESCRIBED AT SAVED TO REGISTER, COMPUTING
*        SUBSCRIPT AND CONVERTING IN THE PROCESS.
LRDXX    BAL,10   LRD00
         B        NX
*        SAME AS LRD BUT NEGATIVE.
LRNXX    BAL,10   LRN00
         B        NX
*        GENERATE CODE TO CONVERT FROM REGISTER TO REGISTER.
LRRXX    LW,7     13
         AND,7    LO4
         AND,13   HI4
         STW,9    SCCBD             SHIFT COUNT                         COBOL42K
         BAL,10   LRR01
         B        NX
*        COMPUTE SUBSCRIPT. SAVE JSAVD AND JSXR.
SSBXX    AH,6     JSAVD
         STH,6    JSAVD
         LW,11    JSXR
         STW,11   KJSXR
         STW,9    JSXR
         BAL,11   SSB00
*        SAVE REGISTER IN WHICH SUBSCRIPT INDEX IS PLACED--OR 0 IF NO SUBSCRIPT.
         STW,8    SX8
         LW,1     SAV1
         LW,11    KJSXR
         STW,11   JSXR
         LH,6     JSAVD
         SH,6     0,1
         STH,6    JSAVD
         B        NX
*        LOAD INSTRUCTION REFERENCING BASE AND OFFSET SHOWN IN 9, 13.
POFABS   STW,9    ABSWRD
         STH,6    ABSWRD
         BAL,11   PIA06
ABSWRD   DATA     0
         B        NX
POFXX    LH,8     0,1               LOAD INSTR
POFX2    STW,13   ABSWRD
POF      STH,9    ABSWRD
         LW,15    ABSWRD
         MTW,0    NOVF
         BNEZ     POF04             LITERAL
         LI,11    X'7F00'
         AND,11   8
         LI,2     6
POF01    CH,11    DWTBL,2
         BE       POF02             DOUBLE WORD
         BDR,2    POF01
         B        POF03
POF02    MTW,1    VBIDX             DOUBLE WORD
POF03    MTW,2    VBIDX             WORD
         BAL,10   VPP30
         LI,10    0
         STW,10   VBIDX
POF04    BAL,11   MDF65
         B        NX
POFLIT   LH,13    2,2
         LH,9     2,5
*        PICK UP LEFT HALF OF INSTRUCTION. ADD SUBSCRIPT INDEX INDICATION.
         LH,8     0,1
         AW,8     SX8
         B        POFX2
*        GENERATE BAL,11 TO EXTERNAL REFERENCE.
EXPXX    LI,3     BA(KAIXF1)+6
         LW,2     SAV1
         SLS,2    1
         LB,1     0,2
         AI,1     1
         STB,1    3
         MBS,2    0
         LI,4     BA(KAIXF1)
         BAL,11   WRPOF
         B        NX
KERRY    STW,9    CSIZE
         STW,13   CDECP
         CI,6     1                                                     COBOL42K
         BG       KERRY1            NOT ADD, SUBTRACT                   COBOL42K
         LI,1     1                                                     COBOL42K
         LB,11    SAVED,1           SECOND BYTE - CBYT                  COBOL42K
         CI,11    X'A8'                                                 COBOL42K
         BNE      KERRY1            NOT INTERMEDIATE RESULT             COBOL42K
         LI,1     16                FULL DECA SIZE                      COBOL42K
         STH,1    SAVED+3             IN CLUSTER                        COBOL42K
KERRY1   RES      0                                                     COBOL42K
*        LOAD KERRY'S PARAMETERS SO HE CAN GENERATE DECIMAL ARITHMETIC.
         BAL,11   BBFBSD
         LW,1     SAV1
         LH,15    2,1
         STW,15   DUBL
         AI,1     1
        LH,15     1,1
         STW,15   RSHFT
         LW,1     SAV1
         LH,1     0,1
         STW,1    STMTYP
         LI,11    0                                                     COBOL42K
         STW,11   SUBTHND                                               COBOL42K
         CI,1     2                                                     COBOL42K
         BE       KERRY2            NOT MULTIPLY                        COBOL42K
         STW,11   SCCBD             MULTIPLY EXCESSIVE SHIFT            COBOL42K
KERRY2   RES      0                                                     COBOL42K
         LI,11    NX                RETURN ADDR                         COBOL42K
*        BRANCH ON ARITH OPERATION TO BE GENERATED.
         B        ARITH,1
ARITH    B        BBFDAD            ADD
         B        BBFDAD            SUBTRACT
         B        BBFDMD            MULTIPLY
         B        BBFDDB            DIVIDE
BASAVED  DATA     BA(SAVED)
HI4      DATA     X'F0'
SAVED    RES      14
RRORR    DATA     0
BIT8     DATA     8
LO4      DATA     X'F'
HASAVED  DATA     HA(SAVED)
HASAVMW  DATA     HA(SAVED)-1
KAIXF1   GEN,16,16  DAIX+X'600',CBAL
         GEN,16,8,8  0,6,C'L'
TEXT     TEXT     ':DLO'
         TEXT     'G   '
SX8      DATA     0
KJSXR    DATA      0
SCCBD    DATA     0                 SHIFT COUNT IN C:CBD                COBOL42K
SAV1     DATA      0
SAVVV    RES      10
EXXIT    RES      1
         RES      4
EXPK     DATA      0
DWTBL    DATA     X'1000'
         DATA     X'18001C00'
         DATA     X'1D001E00'
         DATA     X'1F000000'
*                                                                       88
         REF      KBKON,K4BAS,K6BAS
K30E     EQU      KBKON
K3E0     EQU      KBKON+1
K30F     EQU      KBKON+2
K3F0     EQU      KBKON+3
K3FF     EQU      KBKON+4
K2FFFF   EQU      KBKON+5
KF00F0   EQU      KBKON+8
K303     EQU      KBKON+9
K201     EQU      KBKON+10
K4SPAC   EQU      K4BAS+1
K4AST    EQU      K4BAS+2
KUNPKA   EQU      K6BAS+1
KUNPK4   EQU      K6BAS+2           UNPKA+1
KMSG     EQU      K6BAS+3           MSG AREA
         END
