         SYSTEM   SIG7FDP
         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      WRPOF
         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      OIX02,OIX06
         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      MDF65,LNKSF
         REF      SLNKF
         REF      NDR06,NDR18
         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      BDE00
         REF      MCBUF,MDBUF
         REF      JSXSX             GRP SUBSCRIPT SWITCH
         REF      JSXR
         REF      BBCSAV            LINK
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      VBIDX,CONDF,NOVF
         REF      VPP00,VPP05,VPP10
         REF      VPP20,VPP30,MBS70
         REF      DGSRD,RLNTH,BAA46
         REF      SAVV0,MAREF,LITF
         REF      VPLIT,LADJ,BADJ
         REF      SVARF,VARF,LITVR
         REF      VMAD,VAM60,BAA48
         DEF      CONDB,DIFLG
         DEF      SFLCF                                                 COBOL42I
         REF      NRR22                                                 COBOL42I
* 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
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
CSW      EQU      X'3800'           SW
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
CUNPK    EQU      X'7700'
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'0414'           GLOBAL LITERALS
DARL     EQU      X'0418'           LOCAL LITERALS
DART     EQU      X'0416'           TMP 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      10                FL'0' - NORMALIZED
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      BCB00,BCC00
         DEF      BCA12,BCA20,BCA40
         DEF      BCB30
         DEF      BCA94
         DEF      NCB50
         DEF      OCB30
         DEF       NCB40                                                COBOL42I
*
*
* DATA CLUSTER CLNG,CNTL EQUIVALENCES
CJIFC    EQU      X'0390'           FIGCON
CJINC    EQU      X'0988'           NC
* SUBJECT/OBJECT TYPE CODES
CJUN     EQU      -9                UNKNOWN
CCCX     EQU      -8                EXPRESSION - NC
CCFLX    EQU      -6                EXPRESSION - FLL
CCFSX    EQU      -5                EXPRESSION - FLS
CCBX     EQU      -4                EXPRESSION - BIN
CJANL    EQU      -3                ANLIT/FIGCON                        ADG 01
CJAG     EQU      -2                GRP                                 ADG 02
CJAN     EQU      -1                AN/ANE                              ADG 03
CJAC     EQU      0                 NC/NE                               ADG 10
CJAD     EQU      1                 ND                                  ADG 11
CJAFL    EQU      2                 FLL                                 ADG 12
CJAFS    EQU      3                 FLS                                 ADG 13
CJAB     EQU      4                 BIN                                 ADG 14
CJAX     EQU      5                 INDEX                               ADG 15
CJAL     EQU      6                 NLIT                                ADG 16
CJAZ     EQU      7                 ZERO                                ADG 17
CJAO     EQU      9                 UP/DOWN BY 1
* AN SUBJECTS
DSAL     EQU      CJANL+3            ALL '>1 CHAR'
DSAF     EQU      CJANL              FIGCON/ALL '1 CHAR'
DSAN     EQU      CJAN              AN/ANLIT
DSAG     EQU      CJAG              GRP
* RFLD TYPES                                                            ADG 2
DJAX     EQU      -2                INDEX                               ADG 21
DJAD     EQU      -1                NC/NE/ND - DESCENDING               ADG 22
DJAC     EQU      0                 NC/NE/ND - ASCENDING                ADG 23
DJAFL    EQU      1                 FLL                                 ADG 31
DJAFS    EQU      2                 FLS                                 ADG 32
DJAB     EQU      3                 BIN                                 ADG 33
DJAN     EQU      4                 AN/ANE                              ADG 34
DJAG     EQU      5                 GRP                                 ADG 35
DJZF     EQU      6                 ZERO/BLANK FILL                     ADG 36
DJAXM    EQU      6                 INDEX
DJAEX    EQU      7                 EXPRESSION
*                                                                       84
DWCA     EQU      X'629CA'          AN         - 6 1 2 3 4 5            314E5
DWCN     EQU      X'239CA'          NC/ND/NLIT - 2 1 6 3 4 5
DWCFL    EQU      X'394AC'          FLL        - 3 4 5 1 2 6            1CA56
DWCFS    EQU      X'474AC'          FLS        - 4 3 5 1 2 6            23A56
DWCB     EQU      X'570AC'          BIN        - 5 3 4 1 2 6            2B856
DWIN     EQU      X'17280'          NC/ND/NLIT - 1 3 4 5 8
DWIFL    EQU      X'4A0A0'          FLL        - 4 5 8 1 2
DWIFS    EQU      X'3A0A0'          FLS        - 3 5 8 1 2
DWIB     EQU      X'380A0'          BIN/INDEX  - 3 4 8 1 2
*
DCCN     EQU      X'800'            CONDITION NAME
DCMN     EQU      X'100'            MNEMONIC NAME (SWITCH STATUS)
DCSC     EQU      X'2000'           ZERO/SIGN/CLASS TEST
DCBM     EQU      X'F0000'          BC-,- MODIFY MASK
DCBT     EQU      X'20000'          TEST ONLY FLAG
DCBR     EQU      X'100'            BC- REVERSE MASK
DCRV     EQU      5                 REVERSE %+ VALUE
DCNI     EQU      4                 NREF(0) WORD OFFSET
DTBSN    EQU      X'0300'           TTBS MASK - NUMERIC
DTBSA    EQU      X'0500'           TTBS MASK - ALPHABETIC
         TITLE    'PHASE 4.2 - SIMPLE CONDITIONS'
*                        D1 = CONDITION TYPE,OPTION                      1
BCC00    RES      0
         BAL,L1   INC00
         CI,D1    DCMN              CHECK TYPE                           5
         BL       BCA00             SIMPLE RELATION                      6
         CI,D1    DCCN                                                   7
         BG       BCC10             ZERO/SIGN/CLASS TEST                 9
* MNEMONIC NAME (SWITCH STATUS) TEST
*                        D1 = SET(=1)/RESET(=2),SWITCH NO.
         LH,D3    1,R2              LOAD,MASK SWITCH NO.
         AND,D3   K3FF
         LBAL     PIA22,CLI+CRR6    WRITE LI,R6 SWITCH NO.
         BAL,L1   PIX08             WRITE
         TEXT     ':TSS'            ****  BAL,L1 L:TSS
         CI,D1    X'100'            CHECK RESET FLAG
         BAZ      BAA02             DOWN.
         LAB,V0   BCC28,DCBR+DCBM   WRITE REVERSED BC-,3 TP/FP
* NUMERIC TEST - ND/AN/GRP
*                        V1 = BSIZS-1
BCC06    RES      0
         MTW,1    LITF
         STW,R6   BBCSI             UNS FLAG
         LW,R7    R6                SET UP SFLD CLASS FOR 42S           COBOL42I
         AI,R7    1                 ADJUST BACK TO ORIGINAL CLASS       COBOL42I
         LBAL,L0  NDR32,CRO         CHECK SUBSCRIPTS
*                                   WRITE ADCON BSIZ-1,BA(SFLD)
*                                   ****  LW/AW,RO  ADCON
         LI,R6    -1                RAISE NUMERIC FLAG
         BAL,L0   BCC11             CHECK,GENERATE TTBS TABLE
*                        R1 = RPTCNT                                     3
         LW,V0    BBCSI             UNS
         BNEZ     BCC15             YES.
* NDS
         LI,V0    X'C0020'          LOAD MODIFY, REVERSE FLAGS          21
         LI,V1    0                 PSIZ = 0
         CI,R1    0                 CHECK RPTCNT                         4
         BEZ      BCC08             = 0                                  5
* RPTCNT > 0                                                            20
         LI,R2    0                 BA(NLOC) = 0                        22
         LI,D1    X'200'+15         LOAD REVERSE %+ VALUE
         BAL,L0   NCB11+1           CHECK REVERSE                       24
         B        BCC09
* RPTCNT = 0                                                            11
BCC08    RES      0
         LI,D1    11                LOAD REVERSE %+ VALUE
         BAL,L1   NXMCF
         BAL,L1   OCB10             MODIFY,WRITE BC-,1 %+ OR TP/FP      15
BCC09    RES      0
         LBAL,L0  OIX06,CMTW+X'10'  WRITE
         TEXT     ':TRN'            ****  MTW,1 C:TRN
         BAL,L1   PIA26             WRITE
         LI,R3    0                 ****     CLEAR REGISTER
* ** R3(=RSXR) IS NOT DESTROYED DURING LOAD ****
*                        R6 = 0(1 CHAR) OR -1(> 1 CHAR)
         CI,R6    -1                CHECK CHAR FLAG
         BE       BCC090            >1 CHAR
* 1 CHAR
         LW,V0    JSFLDS            LOAD SXR
         LW,D3    JSFLD             LOAD BASE,DISPL
         AI,V0    CPACK+X'10'       FORM PACK,1 -(,SXR)
         BAL,L0   VPP30             RESOLVE VAR REC
         LI,L1    BCC092            RETURN ADDRESS
         B        MDF65
* >1 CHAR
BCC090   RES      0
         LI,V0    RO
         BAL,L0   VPP10             RESOLVE VAR REC
         BAL,L1   PIA26             WRITE                               40
         PACK,1   0,RO              ****     PACK LAST DIGIT            41
BCC092   RES      0
         LBAL,L0  OIX06,CSTW+CRR3   WRITE
         TEXT     ':TRN'            ****  STW,R3  C:TRN  (R3=0)
         BAL,L1   PIL06             WRITE
         BID      5                 ****  BID  %+5
         CI,R6    -1                CHECK CHAR FLAG
         BE       BCC094            >1 CHAR
* 1 CHAR
*                        D3 = BASE,DISPL
         LW,V0    JSFLDS            LOAD SXR
         BAL,L0   VPP10
         AI,V0    CLB+CRR3          FORM LB,R3  -(,SXR)
         LI,L1    BCC096            RETURN ADDRESS
         B        MDF65
* >1 CHAR
BCC094   RES      0
         BAL,L1   PIA26             WRITE
         LB,R3    0,RO              ****      LOAD BYTE
BCC096   RES      0
         BAL,L1   PIA26             WRITE
         CI,R3    X'20'             ****     CHECK SIGN
         BAL,L1   PIA08             WRITE
         BAZ      2                 ****  BAZ  %+2
         BAL,L1   PIA28             WRITE
         CI,R3    X'EF'             ****     CHECK VALUE
         LI,V0    X'80'+DCBM        LOAD MODIFY FLAG
         LAB,L1   OCB12,BAA02       WRITE BC-,8 TP/FP
* SIGN/CLASS TEST                                                        0
BCC10    RES      0                                                      1
         AI,D1    -DCSC-X'300'      ADJUST,CHECK TYPE                    2
         CI,D1    X'300'                                                 3
         BL       BCC20             ZERO/SIGN TEST                       4
* CLASS TEST                                                             5
         BANZ     BCC18             NUMERIC TEST                         6
* ALPHABETIC TEST                                                        7
         MTW,1    LITF
         LW,R7    R6                SET UP SFLD CLASS FOR 42S           COBOL42I
         BAL,L0   NDR31             CHECK SUBSCRIPTS                     2
         LI,R6    0                 LOWER NUMERIC FLAG
         LI,L0    BCC15             LOAD LINK REGISTER
*                                   WRITE ADCON L,BA(RFLD)               9
*                                   ****  LW,R1 ADCON                   10
*                        R1 = RPTCNT                                    11
*                        R6 = NUMERIC FLAG
*                        L0 = LINK REGISTER                             12
BCC11    RES      0                                                     13
         LH,D1    JTTBS+1           LOAD,CHECK TTBS FLAG                14
         BNEZ     BCC14             UP. TTBS TABLE GENERATED            15
* GENERATE TTBS TABLE                                                   16
         LH,D3    PDBS              LOAD GLIT DISPL                     17
         LI,R3    6                 LOAD GRP CNT(I)
         LI,R4    BA(JTTBS)         LOAD BA(TTBS TABLE)                 19
*                        R3 = GRP CNT(I)                                20
*                        V1 = RPT CNT(RCNT)(J)                          21
BCC12    RES      0                                                     22
         EXU      ECC12-1,R3        EXU ON J                            23
BCC13    RES      0                                                     24
         STH,D3   JTTBS+1           STORE GLIT DISPL                    25
         BAL,L1   WRPOF             WRITE TTBS CLUSTER                  26
         AI,D3    X'10'             GLIT DISPL = GLIT DISPL+16          27
         BDR,V1   BCC13             RCNT(J) = RCNT(J)-1                 28
* RCNT(J)  </= 0                                                        30
         BDR,R3   BCC12             I = I-1                             31
* I = 0                                                                 32
         MTB,1    PDBS              UPDATE GLIT DISPL                   33
         AI,D3    -X'100'           OBTAIN TTBS TABLE DISPL             21
* ** TTBS TABLE GENERATED                                               36
*                        D3 = TTBS TABLE DISPL                          37
         OR,D3    K4BAS             FORM TTBS TABLE BASE,DISPL          39
         LBAL     PDD00,DTBSN       WRITE NUMERIC(N) TTBS ADCON         31
         LBAL     PDD03,DTBSA       WRITE ALPHABETIC(A) TTBS ADCON      32
         SLS,D1   -2                BA DISPL TO WA                      33
         STH,D1   JTTBS+1           RAISE TTBS FLAG(=A TTBS ADCON NO.)  34
*                        D1 = A ADCON NO.(=N ADCON NO.+1)
BCC14    RES      0                                                     36
         AW,D1    R6                ADJUST ADCON NO.
         LBAL     PRA02,CLW+CRE     WRITE LW,RE A/N ADCON
         STW,L0   TMPL0
         LI,V0    RO                                                    COBOL42I
         BAL,L0   VPP10             RESOLVE VAR REC
         BAL,L1   PIA26             WRITE
         TTBS,RE  0                 ****     TTBS SFLD
         B        *TMPL0
* ALPHABETIC
*                        R1 = RPTCNT                                    11
BCC15    RES      0
         LI,V0    X'20'+DCBM        LOAD BC-,1 MASK
         CI,R1    0                 CHECK RPTCNT                        43
         BEZ      BCC28             = 0, WRITE BC-,1 TP/FP              44
* RPT CNT >/= 1                                                         45
         AI,V0    -X'30000'         LOWER MODIFY/TEST ONLY FLAGS
         LAB,L0   NCB10+1,BAA02     WRITE REPEATED TTBS
* I = 1                                                                 41
         MTW,3    JTTBS+1           RAISE F0 NUMERIC FLAG               42
* I = 3                                                                 44
BCC16    RES      0                                                     71
         AI,V1    2                 J = J+2                             51
         LW,D1    JTTBS+3           SET ALPHABETIC/NUMERIC MASK         52
         AW,D1    D1                                                    53
         STD,D1   JTTBS+2                                               54
         STB,D1   JTTBS+4                                               74
         B        *L1               RETURN                              76
* I = 4                                                                 80
BCC17    RES      0                                                     81
         LI,V1    7                 LOAD RCNT(4)                        82
         MTW,-1   JTTBS+1           RAISE & NON-ALPHABETIC FLAG         61
         B        *L1               RETURN                              84
* TTBS TABLE ADJ. - GRP CNT(I)                                          88
ECC12    RES      0                                                     89
         BAL,L1   BCC16-1           1                                   65
         MTB,-1   JTTBS+2           2 RAISE E1 NON-ALPHABETIC FLAG      66
         BAL,L1   BCC16             3                                   67
         BAL,L1   BCC17             4                                   94
         MTW,1    JTTBS+1           RAISE SPACE ALPHABETIC FLAG         71
         LI,V1    4                 6 LOAD RCNT(6)                      96
* NUMERIC
BCC18    RES      0
         BDR,R6   BAA02             SFLD TYPE = SFLD TYPE-1
* *** NOP IF SFLD = INDEX/BIN/FLP
* SFLD = AN/GRP/NC/ND
         CI,R6    CJAC-1            CHECK SFLD TYPE
         BE       BCC19             SFLD = NC
* SFLD = GRP/AN/ND
         LH,V1    3,R2              LOAD,CHECK BSIZS
         CI,R6    0                 AN/GRP
         BNEZ     BCC06             YES
* ND
         LH,R6    0,R2              NDU
         AND,R6   K301
         BNEZ     BCC06             YES
* NDS
         BDR,V1   BCC06             BSIZS > 1
* BSIZ = 1
         BAL,L1   SSB00             CHECK SUBSCRIPTS
         STW,V0   JSFLDS            SAVE SXR
         STW,D3   JSFLD             SAVE BASE,DISPL
         LI,V0    X'E0020'          LOAD MODIFY,TEST FLAG
         B        BCC08+1
BCC19    RES      0
         LBAL,L0  OIX06,CMTW+X'10'  WRITE
         TEXT     ':TRN'            ****  MTW,1 C:TRN
         BAL,L1   PIA26             WRITE
         LI,R3    0                 ****     CLEAR REGISTER
* ** R3(=RSXR) IS NOT DESTROYED DURING LOAD ****
         LI,R6    CRB+X'8'          SET RREG,RFLD CLASS(=NCS)
         LH,V1    4,R5              LOAD DECPS
         BAL,L0   LRD00             'LOAD' SFLD - TRAP TEST
         LBAL,L0  OIX06,CSTW+CRR3   WRITE
         TEXT     ':TRN'            ****  STW,R3  C:TRN  (R3=0)
         LAB,V0   BCC28,X'B0'+DCBM  WRITE BC-,8  TP/FP
* ZERO/SIGN TEST                                                         1
BCC20    RES      0                                                      2
         STH,D1   BCARI             SAVE RELATION CODE                   3
         CI,R6    0                 CHECK SFLD TYPE                      4
         BGE      BCC21             SFLD NUMERIC
         CI,R6    CJANL
         BL       BCC30             SFLD = EXPRESSION
* SFLD NON-NUMERIC
         CI,D1    0                 CHECK RELATION CODE
         BNEZ     BAA02             NOT = ZERO TEST - NOP
* ZERO TEST
         LW,D3    K4BAS             LOAD,STORE SFLD(=C'0') BASE,DISPL
         STW,D3   JSFLD
         MTH,1    JCREF             NREF = 1
         LAB,R7   BCA14+2,1         CLASS = AN
* SFLD NUMERIC
BCC21    RES      0
         LI,L0    BCC26             SET LINK REGISTER                    6
*                        R1 = RFLD TYPE                                  7
*                        L0 = LINK REGISTER                              8
BCC22    RES      0                                                      9
         CI,R6    CJAX              CHECK RFLD TYPE                     11
         BNE      BCC24             NOT= INDEX                          12
* SFLD = INDEX                                                          13
         LAB,R6   BCC25,CRI+X'C'    LOAD RREG,RFLD CLASS                14
* SFLD NOT= INDEX                                                       15
BCC24    RES      0                                                     16
         EXU      EBC92,R6          EXU ON SFLD TYPE                    20
*                        R6 = RREG,RFLD CLASS                           21
BCC25    RES      0                                                     22
         LI,V1    0
         STW,V1   LITF
         LH,V1    4,R5              LOAD DECPS                          23
         B        LRD00             LOAD SFLD                           24
BCC26    RES      0                                                     25
         LB,V0    BCARI             LOAD,CHECK RELATION CODE            26
         BEZ      BAA02             = ZERO TEST. JT/JF SET PROPERLY     27
* POSITIVE/NEGATIVE                                                     28
         SLS,V0   4                 POSITION CC MASK                    11
         AI,V0    DCBR+DCBM         SET REVERSE BCR/BCS MASK            29
* MODIFY,WRITE BCS/BCR,- TP/FP                                          10
*                        V0 = BC-,3 MODIFY MASK                         11
BCC28    RES      0                                                     22
         BAL,L1   NXMCF
         LAB,L1   OCB10,BAA02       MODIFY,WRITE                        24
* SFLD = EXPRESSION
BCC30    RES      0
         LW,R1    R6                LOAD RFLD TYPE
         LAB,L0   BCA16+1,BCC26     EVALUATE EXPRESSION
         TITLE    'PHASE 4.2 - COMPLEX RELATIONS'
* MULTIPLE OBJECTS                                                       1
*                        R6 = SFLD TYPE                                  2
*                        R3 = HA(MCBUF)-1                                4
*                        D1 = TYPE BITS,NTYP                             3
*                        V1 = 0(ON ENTRY)                               11
BCB00    RES      0
         STW,V1   JCSAV             CLEAR CONDITION MODE SAVE F         13
         STH,R6   BCASI             SAVE SFLD TYPE                       K
         STH,D1   BCANT             SAVE TYPE BITS,NTYP                  4
         BAL,L1   INC00
         LI,V0    X'F'              MASK NTYP                           11
         AND,V0   D1                                                    12
         STB,V0   MCBUF             SAVE NTYP
         STW,V0   JSFLDS            LOWER SUBSCRIPT FLAG
         LH,R3    2,R3              LOAD, SAVE NREF
         STH,R3   JCREF                                                 02
         CI,R3    1
         BLE      %+2
         MTW,1    MAREF             SET GROUP COMPARE FLAG
         CI,R6    CJAC              CHECK SFLD TYPE                     10
         BGE      BCB10             SFLD = NUMERIC/ZERO                 UU
         CI,R6    CCBX                                                  12
         BLE      BCB01
         BAL,L1   SFLDF
         B        BCB06             SFLD NOT EXPRESSION
BCB01    RES      0
* SFLD = EXPRESSION                                                      0
         AI,R6    8                                                     42
         BDR,R6   BCB03                                                 421
* SFLD = NC/ND                                                          422
         LW,R1    R6                RFLD TYPE = SFLD TYPE               423
         BAL,L1   BBB70+1           CHECK,SET DECA SAVE FLAG            424
BCB03    RES      0                                                     425
         AI,R6    1                 RESET SFLD TYPE                     426
         LW,R1    R6                RFLD TYPE = SFLD TYPE               427
         BAL,L0   BCA02             PROCESS EXPRESSION                  428
*                        R1 = RFLD TYPE(=SFLD,TYPE)                     45
*                        R7 = SFLD CLASS                                46
*                        V1 = DECPS                                     47
*                        D0 = DSIZS                                     48
*                        D1 = SREG                                      49
         LAB,L0   BBB88,BCB94       CHECK SAVE DECA
* SFLD = ND, RFLD = GRD/AN/ANLIT/ZERO                                   30
BCB05    RES      0                                                     31
         BAL,L0   NCB50             CHECK, ZONE ND SFLD                 32
* ND SFLD TO AN                                                         33
* SFLD = NON-NUMERIC                                                    20
BCB06    RES      0
         LI,R1    CJUN              LOAD UNKNOWN RFLD TYPE CODE         2
         BAL,L0   BCA06             LOAD,CHECK FIRST RFLD               II
* SFLD = AN/GRP/ALL'>1 CHAR'/FIGCON/ALL'1 CHAR'
         LH,R6    BCASI             LOAD SFLD TYPE
         CI,R6    DSAF              CHECK SFLD TYPE
         BE       BCB12             SFLD = FIGCON/ALL ' 1 CHAR
* SFLD = AN/GRP/(ALL) ANLIT
         BAL,L1   OCB01             SET RFLD TYPE
         LH,D0    3,R2              LNTH OF RFLD
         CI,D0    255
         BG       %+2               RLNTH > 255
         LI,D0    0
         STW,D0   RLNTH             SET RLNTH FLAG
BCB08    RES      0
         LW,D0    JBSIZ             LOAD BSIZS
         B        BBC33             CHECK,CBS RFLD
* SFLD = NUMERIC/ZERO                                                    0
BCB10    RES      0                                                      1
         CI,R6    CJAL              CHECK SFLD TYPE                      3
         BLE      BCB90             SFLD = NLIT/NUMERIC DATA
* SFLD = ZERO/ZERO LIT
         LI,R1    CJUN              LOAD  RFLD TYPE
         BAL,L0   BCA11             ZERO CHECK
* SFLD = ZERO/FIGCON/ALL '1 CHAR'
* ***  IF SFLD = FIGCON/ALL '1 CHAR', RFLD MUST BE NON-NUMERIC
BCB12    RES      0
         MTW,1    LITF
         BAL,L1   OCB01             CHECK RFLD TYPE
         LH,R7    0,R2              LOAD, MASK RFLD CLASS
         AND,R7   K30F
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         B        BCA12+1           CHECK RFLD
* RFLD = ZERO
BCB14    RES      0
         LH,R1    BBCSI             LOAD ORIGINAL SFLD TYPE
         LI,L0    BCA08             SET LINK REGISTER
         BAL,L1   OCB92             CHECK VALUE AVAILABILITY
*                        CC2 SET - SFLD IN TMP
*                        CC2 RESET - SFLD IN REGISTER
         BAZ      BCB16             VALUE IN REGISTER
* VALUE IN TMP
*                        D1 = TMP WA DISPL
         CI,R6    CJAFL             CHECK SFLD TYPE
         BAZ      NCB98             SFLD NOT= FLS/FLL
* SFLD = FLS/FLL
         LH,V0    KSLDR,R6          LOAD LW/LD,RFL
         LBAL     PRG22,DGFZ,D3     WRITE LW/LD,RFL FL'0'
         AI,V0    CFAS-CLW          FORM FAS/FAL,RFL
         B        NCB98+1           WRITE FAS/FAL,RFL TMP
* VALUE IN REGISTER
BCB16    RES      0
         LW,R1    R6                RFLD TYPE = SFLD TYPE
         B        BCA17+1           ZERO TEST
* RFLD = ZERO/FIGCON/ALL 'ANLIT'
*                        R7 = LIT CLASS
*                        V0 = SUBSCRIPT FLAG(SAVED)
*                        D0 = BSIZS
*                        D3 = SFLD BASE,DISPL(SAVED
* ** ALL 'ANLIT' NOT POOLED*********
BCB30    RES      0
         LW,D3    JSFLD
         MTW,1    LITF
         LW,V0    JSFLDS            LOAD SUBSCRIPT FLAG                 COBOL42I
         CI,R7    2                 CHECK LIT CLASS                     10
         BAZ      BCB34             = ZERO/FIGCON                       11
* = ALL'ANLIT'                                                          12
         BAL,L1   LIT00             POOL LIT
         LW,V1    D3                SAVE BASE,DISPL                     13
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL                14
         CI,R7    3                 CHECK LIT CLASS                     15
         BNE      BCB35             = ALL '1CHAR'                       16
* = ALL '>1CHAR'                                                        17
         LH,D0    3,R2              LOAD ALLSIZ
         XW,V1    D0                EXCHANGE BSIZS,BASE,DISPL           18
         CI,V0    X'F0000'          CHECK SUBSCRIPT FLAG                19
         LI,V0    CRO               LOAD RO                             20
         BANZ     BCB36             SUBSCRIPT FLAG UP.                  22
* SFLD NOT SUBSCRIPTED                                                  25
         BAL,L0   NDR32+2           WRITE ADCON L,BA(SFLD)              26
*                                   WRITE LW,RO ADCON
         LW,D3    D0                LOAD RFLD BASE,DISPL                28
*                        D3 = RFLD BASE,DISPL                           29
* **                     RO = L,BA(SFLD)
BCB32    RES      0                                                     31
         BAL,L1   PIA06             WRITE                               32
         LI,RE    0                 ****     CLEAR RE                   33
         LH,D0    3,R2              LOAD ALLSIZ
         LW,V1    JBSIZ             LOAD BSIZS-ALLSIZ                   35
         SW,V1    D0                                                    36
         LI,V0    R5
         BAL,L1   LITVC             RESOLVE VAR REC
         LAB,V0   BCA22,CCBS+CRE    WRITE CBS,RE BA(RFLD)               37
*                                   ****  BC-,- TP/FP/REVERSE %+ VALUE  38
*                                   ****  CBS,RO -ALLSIZ                38
* ZERO/FIGCON                                                           38
*                        D0 = BSIZS                                     38
*                        D3 = SFLD BASE,DISPL                           39
BCB34    RES      0                                                     41
         LW,V1    K4BAS             LOAD GLIT BASE                      42
         CI,R7    4                 CHECK LIT CLASS                     43
         BANZ     BCB35             = ZERO                              44
* = FIGCON                                                              44
         LH,R4    1,R2              LOAD,POSITION FIGCON NO.(=DISPL)    45
         SLS,R4   -8                                                    46
         AW,V1    R4                FORM FIGCON BASE,DISPL              47
*                        V1 = BASE,DISPL                                48
BCB35    RES      0                                                     49
         XW,V1    D0                EXCHANGE BSIZS,BASE,DISPL           50
         CI,V0    X'F0000'          CHECK SUBSCRIPT FLAG                51
         LI,V0    CRR1              LOAD RO(=R1)                        52
         BAZ      BCB38             DOWN. NOT SUBSCRIPTED               53
* SFLD SUBSCRIPTED                                                      54
*                        V0 = RO(=R1/R5)                                60
*                        V1 = BSIZS/ALLSIZ                              55
BCB36    RES      0                                                     62
         AI,V0    CLI               FORM LI,RO                          63
         MTW,0    LNKSF
         BNEZ     %+2               IN LINKAGE SECTION
         BAL,L1   PID10             WRITE LI,RO BA(SFLD)                64
         AI,V0    CAW-CLI           FORM AW,RO                          65
         LW,D3    D0                LOAD RFLD BASE,DISPL                28
         BAL,L1   OCB06+1           WRITE AW,RO R2                      66
         LW,D0    D1                SAVE AW,RO
         BAL,L0   NDR30             OBTAIN RPTCNT                       68
*                                   WRITE LI,V2 L                       69
         LH,V0    D0                LOAD -,RO                           70
         BAL,L1   OBS14+1           WRITE STB,V2 RO                     71
*                        D1 = RO                                        72
         CI,D1    6                 CHECK RO                            73
         BAZ      BCA15             = R1, CBS ZERO/FIGCON/ALL '1CHAR'   74
         B        BCB32
* SFLD NOT SUBSCRIPTED                                                  80
BCB38    RES      0                                                     82
         BAL,L0   NDR32+2           WRITE ADCON L,BA(SFLD)              83
*                                   WRITE LW,R1 ADCON                   83
         LW,D3    D0                LOAD RFLD BASE,DISPL                84
*                        R1 = RPTCNT                                    85
*                        D3 = RFLD BASE,DISPL                           86
* **                     R1 = L,BA(SFLD)                                87
         B        BCA15             WRITE CBS,0 BA(RFLD)                89
* GRP/AN/ANLIT RFLDS
*                        V1 = DECPS
*                        D0 = DSIZS
BCB50    RES      0
         XW,R6    BBCSI             LOAD,CHECK SFLD CLASS
         CI,R6    8
         BANZ     BCB56             SFLD = NC
* SFLD = ND
         CI,D0    1                 CHECK DSIZS
         BANZ     BCB56             DSIZS ODD
* DSIZS EVEN
         CI,R6    1
         BANZ     BCB52             SFLD = NDU
* SFLD = NDS                                                            01
* **                     RO = BA(UNPKA)+BSIZ                            02
         BAL,L1   PIA06             WRITE                               03
         AI,RO    -1                ****     RO = BA(UNPKA)+BSIZ-1      04
         BAL,L1   PIA06             WRITE                               05
         LB,V2    0,RO              ****     LOAD LAST DIGIT            06
         BAL,L0   NDR18+2           WRITE OR,V2 C'---0' FORCE ZONE      07
*                                   ****  STB,V2 0,R5                   08
BCB52    RES      0                                                     09
* ***                    ADCON(CURRENT) FOR MBS,RE UNPKA = BSIZ,BA(UNPKA11
         LBAL,L1  PRA00,CLW+CRO     WRITE LW,RO ADCON
         BAL,L1   PIA06             WRITE                               12
         AI,RO    DTBA-1            ****  AI,RO (AN AREA-UNPKA)-1       13
         BAL,L1   PIA06             WRITE                               14
         MBS,RO   1-DTBA            ****  MBS,RO 1-(AN AREA-UNPKA)      15
BCB54    RES      0                                                     16
         LW,D3    KMSG              LOAD,STORE BASE,DISPL               163
         STW,D3   JSFLD                                                 164
         LI,V0    CRR2              LOAD,STORE SUBSCRIPT FLAG           161
         STW,V0   JSFLDS                                                162
         LBAL,L1  PID10,CLI+CRR2    WRITE LI,R2 BA(ZONED UNPKA)         165
         LW,V1    JDECP             RELOAD DECPS,DSIZS                  17
         LW,D0    JDSIZ                                                 18
         STW,D0   JBSIZ             BSIZS = DSIZS
         LW,R6    BBCSI             LOAD SREG,SFLD CLASS
         LAB,L0   BCA94,BCB94       RELOAD SREG,SFLD CLASS              19
* SFLD = NC/ND(DSIZS ODD)
BCB56    RES      0
         LW,V1    D0                LOAD DSIZS
         LW,D3    KMSG              LOAD ZONED UNPKA BASE,DISPL
         LBAL     ORD12+1,CUNPK     WRITE UNPK,DSIZS/2+1 ZONED UNPKA
         BAL,L0   NDR06             SET ZONE OP
*                        V0 = STS,V2
* *** NON-SUBSCRIPTED ODD DIGIT ZONING BY STS,V2 ***
         BAL,L1   PID12             WRITE STS,V2 ZONED UNPKA(+OFFSET)
         LW,D0    JDSIZ             LOAD,CHECK DSIZS
         CI,D0    1
         BANZ     BCB54             DSIZS ODD
* DSIZS EVEN
         LW,D3    KMSG              LOAD AN BASE,DISPL
         AI,D3    1
         B        BCB54+1
* SFLD = NUMERIC
*                        R3 = NREF                                      91
*                        V0 = NTYP                                      90
*                        D1 = TYPE BITS,NTYP                             0
BCB90    RES      0
         BNE      BCB92             SFLD NOT= NLIT                      92
* SFLD = NLIT                                                            5
         MTW,1    LITF
         CI,D1    X'F800'           CHECK TYPE BITS
         BANZ     BCB91             NC/ND RFLDS
* INDEX/BIN/FLP RFLDS ONLY                                               8
         SCS,D1   2                 POSITION TYPE BITS                   9
         BAL,L1   BBB60             CHECK,SET NLIT CONVERSION CODE      10
BCB91    RES      0                                                     93
         BAL,L1   LIT00             POOL LIT                            12
         BAL,L1   BBB62             SET NLIT TYPE CODE
BCB92    RES      0                                                     10
         BDR,R6   BCB93             SFLD TYPE = SFLD TYPE-1             51
* SFLD = NC/ND                                                          52
         LW,R1    R6                RFLD TYPE = SFLD TYPE               53
         BAL,L1   BBB70+1           CHECK,SET DECA SAVE FLAG            54
         CI,D1    X'21'             BOTH OBJECTS = 0 S10879             COBOL42I
         BE       %+3               BOTH ARE 0                          COBOL42I
         CI,D1    X'1FC0'           CHECK RFLD TYPE FLAGS               24
         BAZ      BCB05             NUMERIC TYPE FLAGS DOWN             25
         LH,R4    0,R2              LOAD,SAVE SFLD CLASS
         STW,R4   BBCSI
*                        R6 = SFLD TYPE-1
BCB93    RES      0                                                     55
         AI,R6    1                 RESET SFLD TYPE                     56
         LW,R1    R6                RFLD TYPE = SFLD TYPE                2
         STH,R1   BCARI             SAVE RFLD TYPE
         BAL,L0   BCA92             LOAD SFLD                           58
*                        R1 = RFLD TYPE(=SFLD,TYPE)                     59
*                        R7 = SFLD CLASS                                60
*                        V1 = DECPS                                     61
*                        D0 = DSIZS                                     62
*                        D1 = SREG                                      63
         LH,R4    BCANT             LOAD,CHECK NTYP FLAGS               281
         CI,R4    X'E000'           CHECK AN TYPE FLAGS                 282
         BANZ     BCB50             GRP/AN/ANLIT TYPE FLAGS UP          283
* NUMERIC/ZERO RFLD= ONLY                                               284
BCB94    RES      0
         LI,L0    BCB95   *********** SET LINK REGISTER
         STW,L0   BCASAV
         STH,R1   BBCSI             SAVE ORIGINAL SFLD TYPE
         BAL,L1   OCB90             SET MODE INDICATOR
BCB95    RES    0
         BAL,L1   OCB01             OBTAIN RFLD TYPE
         STH,R1   BBCRI             SAVE ORIGINAL RFLD TYPE
         CI,R1    CJANL             CHECK RFLD TYPE
         BL       BCA72             RFLD = EXPRESSION
         CI,R1    0
         BL       BCB08             RFLD = GRP/AN/ANLIT
         CI,R1    CJAL              CHECK RFLD TYPE
         BG       BCB14             RFLD = ZERO
         BL       BCB96             SFLD = DATA
* RFLD = NLIT
         MTW,1    NOVF
         LH,R6    BBCSI             LOAD ORIGINAL SFLD TYPE
         LB,R6    KSCLAS,R6         LOAD SFLD CLASS
         BAL,L1   LIT00             POOL LIT
         BAL,L1   BBB62             OBTAIN SFLD TYPE
         CI,R6    5                                                     COBOL42I
         BNE      %+2               SFLD NOT INDEX                      COBOL42I
         MTW,1    SIDXL             SET SFLD INDEX FLAG                 COBOL42I
         LW,R1    R6                RFLD TYPE = SFLD TYPE
         STH,R1   BBCRI             ORIGINAL RFLD TYPE = RFLD TYPE
BCB96    RES      0
         BAL,L0   NCB80             PERFORM AVAILABILITY,LOAD CHECK
         B        BCA54             SFLD = NC, IN TMP - NO LOAD
* **                     CC2 RESET - VALUE AVAILABLE IN REGISTER
* **                     CC2 SET - VALUE AVAILABLE IN TMP
         BAZ      BCB97             SFLD IN REGISTER
* SFLD STILL IN TMP
         BAL,L0   NCB98             LOAD SFLD
BCB97    RES      0                                                     90
         MTW,0    SIDXL                                                 COBOL42I
         BEZ      BCB971            SFLD NOT INDEX                      COBOL42I
         LW,D0    V0                SAVE RREG                           COBOL42I
         LW,V0    D1                LOAD SREG                           COBOL42I
         BAL,L0   NRR22             CONVERT INDEX                       COBOL42I
         MTH,-1   BBCRI             RFLD TYPE TO BIN                    COBOL42I
         LI,R7    X'D'              RFLD CLASS TO BIN                   COBOL42I
         MTW,-1   SIDXL             RESET SFLD INDEX FLAG               COBOL42I
BCB971   RES      0                                                     COBOL42I
         LH,R1    BBCRI             LOAD RFLD TYPE
         B        BCA96             COMPLETE SFLD:RFLD
BCB98    RES      0
         LH,D2    BCANT             LOAD,CHECK NLIT,ZERO FLAGS
         CI,D2    X'60'
         BAZ      BCB99             DOWN. NO NLIT/ZERO FLDS REMAIN.
         LCH,R6   BBCSI             LOAD -ORIGINAL SFLD TYPE
         LI,D3    X'1000'           POSITION MODE BIT
         SLS,D3   0,R6
         OR,D2    D3
BCB99    RES      0
         LI,D3    X'8280'           MASK ODD TYPE BIT
         AND,D3   D2
         AW,D3    D3                POSITION,RAISE PAIRED EVEN FLAG
         OR,D2    D3
         LI,D3    X'14100'          MASK EVEN TYPE BIT
         AND,D3   D2
         SLS,D3   -1                POSITION,RAISE PAIRED ODD FLAG
         OR,D2    D3
         AND,D2   JSAVD             SET/RESET MODE FLAGS
         STW,D2   JSAVD
         B        BCB95
         TITLE    'PHASE 4.2 - SIMPLE RELATIONS'
INC00    STW,L1   TMPL1
         LI,L1    0
         STW,L1   DIFLG
         STW,L1   CONDF
         STW,L1   SLITF
         STW,L1   RLNTH
         STW,L1   MAREF
         STW,L1   BCART                                                 COBOL42I
         B        *TMPL1
* SIMPLE RELATION                                                        1
*                        D1 = RFLD TYPE                                  3
BCA00    RES      0                                                      4
         LW,R1    D1                LOAD RFLD TYPE(I)                    5
         LI,R3    1                 NREF(I) = 1                          7
         STH,R3   JCREF             NREF = 1
*                        R1 = RFLD TYPE                                 11
*                        R3 = NREF(I)                                   12
*                        R6 = SFLD TYPE                                 13
*                        L0 = LINK REGISTER                             14
* FIRST(/ONLY) COMPARE                                                  16
         CI,R6    0                 CHECK SFLD CLASS
         BGE      BCA10             SFLD = NUMERIC
         CI,R6    CJANL
         BL       BCA01
         BAL,L1   SFLDF
         B        BCA06
BCA01    RES      0
* SFLD = EXPRESSION
         AI,R6    8                 ADJUST SFLD TYPE                     3
         LI,L0    BCA96             SET LINK REGISTER                    4
         STH,R6   MDBUF-1           SAVE SFLD TYPE
BCA02    RES      0                                                     17
         STH,R6   BCASI             SAVE SFLD TYPE                       7
         STH,R1   BCARI             SAVE RFLD TYPE                       8
         LBAL     BBC92,DJAEX,R1    SAVE SFLD PARAMETERS                 9
         BAL,L1   BDE00             EVALUATE EXPRESSION
         LH,D1    1,R2              LOAD SREG                           12
         SLS,D1   4
*                        R6 = SFLD TYPE                                 13
         LB,R7    KSCLAS,R6         LOAD SFLD CLASS CODE                13
         MTW,1    JSXR              SET SXR FOR RFLD                    14
         BAL,L1   BAA46             SAVE VAR FLAG
*                        R7 = SFLD CLASS                                96
*                        V1 = DECPS                                     97
*                        D0 = DSIZS                                     98
*                        D1 = SREG                                      99
*                        L0 = LINK REGISTER
         LH,R1    BCARI             LOAD,CHECK RFLD TYPE
         BLZ      BCA70             RFLD = EXPRESSION                    7
         CH,R1    BCASI                                                 151
         BE       *L0               RFLD TYPE = SFLD TYPE
         CI,R1    CJAL              CHECK RFLD TYPE
         BE       BCA95             RFLD = NLIT                         19
         BL       BCA04             RFLD = DATA
* RFLD = ZERO
         LW,V0    D1                LOAD SREG
         LAB,L0   BCA17,BCA08       ZERO TEST
* RFLD TYPE NOT= SFLD TYPE
BCA04    RES      0
         LH,R1    BCASI             LOAD SFLD TYPE
         BAL,L1   OCB90             SET MODE FLAG
         LH,R1    BCARI             LOAD RFLD TYPE
         LAB,L0   NCB80,BCA96-1     SET LOAD MODE
* SFLD = ND, RFLD = GRP/AN/ANLIT
BCA05    RES      0
* ND SFLD TO AN
         BAL,L0   NCB50             CHECK, ZONE ND SFLD                 16
         LH,R1    BCARI             LOAD RFLD TYPE
* SFLD NOT= NUMERIC
BCA06    RES      0
         STW,L0   BCASAV            SAVE LINK REGISTER                  22
         STH,R1   BCARI             SAVE RFLD TYPE
         EXU      ECA06+3,R6        EXU ON SFLD TYPE                    25
* READ,WRITE BCR/BCS,- TP/FP, TP/FP DEF'S                               30
BCA08    RES      0                                                     31
         MTH,-1   JCREF             NREF = NREF-1                       32
         BEZ      BAA02             = 0, E-O-CONDITIONAL                33
* NREF > 0                                                              34
         LI,R5    -1                LOAD INDEX                          35
         BAL,L1   NXMCF
         LW,R4    R2                SAVE BA(CLOC)                       37
         SLS,R2   -1                BA(CLOC) TO HA                      38
         LH,D1    0,R2              LOAD,CHECK CNTL                     40
         LB,D1    D2,R5                                                 41
         CI,D1    X'41'                                                 43
         BG       BCA09             NOT POF CLUSTER                     44
* POF CLUSTER                                                           45
         BDR,L1   WRPOF             WRITE POF CLUSTER                   46
* **                     L1 = LINK REGISTER                             47
* NOT POF CLUSTER                                                       48
BCA09    RES      0                                                     49
         AW,R5    R2                SET HA(CLOC)-1                      50
         LW,D0    SLITF
         STW,D0   LITF
         LH,D0    0,R2
         AND,D0   L(X'F0')
         CI,D0    X'90'
         BNE      *BCASAV
         MTW,1    LITF
         B        *BCASAV           RETURN                              51
* FIRST(/ONLY) COMPARE - SFLD TYPE                                      250
ECA06    RES      0
         BAL,L0   BBC20             ANLIT/FIGCON                        251
         BAL,L0   BBC31             GRP
         BAL,L0   BBC31             AN
* SFLD = NUMERIC
*                        R1 = RFLD TYPE                                  2
BCA10    RES      0                                                      3
         CI,R6    CJAL              CHECK SFLD TYPE
         BLE      BCA90             SFLD NOT= ZERO                       5
* SFLD = ZERO/ZERO LIT                                                   6
BCA11    RES      0
         STW,L0   BCASAV            SAVE LINK REGISTER
         B        BBC12             INITIALIZE ZERO TEST
*
* SFLD = ZERO/ZERO LIT/FIGCON/ALL '1 CHAR' ANLIT                         1
*                        R1 = RFLD TYPE                                  2
*                        R6 = SFLD TYPE                                  3
*                        R7 = RFLD CLASS                                 4
*                        D0 = BSIZS(SAVED)                               5
*                        D3 = SFLD BASE,DISPL(SAVED)                     6
* ** RFLD CLUSTER READ *************                                     7
BCA12    RES      0                                                      9
         BAL,L1   OCB00+1           CHECK,SET RFLD TYPE
         MTW,1    LITF
         CI,R1    CJAC              CHECK RFLD TYPE                     10
         BL       BCA14             RFLD = AN/GRP                       11
*        THE NEXT FOUR INSTRUCTIONS WILL ALLOW FOR SFLD = ND            COBOL42I
*        AND RFLD = FIGCON ( NOT ZERO) TO BE COMPARED AS AN             COBOL42I
*        NOTE THAT THE SFLD AND RFLD HAVE BEEN REVERSED BY COBOL41L     COBOL42I
         CI,R6    CJANL           SFLD = FIGCON                         COBOL42I
         BNE      BCA12A                                                COBOL42I
         CI,R1    CJAD            RFLD = ND  (REALLY SFLD)              COBOL42I
         BE       BCA14                                                 COBOL42I
BCA12A   RES      0                                                     COBOL42I
* RFLD = NUMERIC                                                        12
* ** SFLD = ZERO/ZERO LIT, LOAD,CHECK ONLY                              13
         LW,R6    R1                SFLD TYPE = RFLD TYPE
         LAB,L0   BCC22,BCA58       LOAD RFLD
*                                   CHECK,REVERSE BC-,- TP/FP
* RFLD = EXPRESSION/AN/GRP                                               1
BCA14    RES      0                                                      2
         CI,R1    CJANL             CHECK RFLD TYPE                     30
         BL       BCA16             RFLD = EXPRESSION                    4
* RFLD = AN/GRP                                                          5
* *** RFLD CANNOT BE ANLIT/FIGCON****                                    6
* ***  ENTRY POINT FOR 'AN/GRP IS (NOT) ZERO' ****
         LBAL,L0  NDR31+1,CRR1      WRITE ADCON DSIZR,BA(RFLD)           7
*                                   ****  LW,R1 ADCON                    8
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL                 9
*                        D3 = SFLD/RFLD BASE,DISPL
BCA15    RES      0
         STW,D3   TMPV0
         LI,V0    R1
         BAL,L1   LITVC             RESOLVE VAR REC
         LW,D3    TMPV0
         BAL,L1   PID16             WRITE                               11
         CBS,0    0                 ****  CBS,0 BA(SFL0)                11
         MTW,0    VARF
         BGEZ     BCA155            NO VAR LNTH
         MTW,-1   CONDF
BCA152   LI,V0    DCBR
         LI,V1    0
         LI,D1    DCRV+3
         MTW,0    RLNTH
         BNEZ     BCA153            RLNTH > 255
         AI,D1    -4
         B        BCA154
BCA153   AI,D1    3
BCA154   BAL,L1   NXMCF
         BAL,L1   OCB10
         BAL,L1   VPLIT
         BAL,L1   PID16
         CBS,0    0                 **** WRITE CBS,0  BA(SFLD)
         XW,D1    R1
         BAL,L1   BADAD
         LAB,L0   NCB16,BCA08
BCA155   RES      0
         LAB,L0   NCB10,BCA08       CHECK,WRITE REPEATED CBS
* RFLD = EXPRESSION                                                      1
BCA16    RES      0                                                      2
         LI,L0    BCA58             SET LINK REGISTER(REVERSE)
         AI,R1    8                 SAVE RFLD TYPE                       3
         STH,R1   MDBUF-1                                                4
         BAL,L1   BDE00             EVALUATE EXPRESSION                  6
         LH,V0    1,R2              LOAD RREG
         SLS,V0   4
* ZERO TEST - EXPRESSION(SUBJ/OBJ)
*                        V0 = RREG/SREG
*                        L0 = LINK REGISTER
BCA17    RES      0
         LH,R1    MDBUF-1           LOAD RFLD TYPE
         CI,R1    CJAFL             CHECK RFLD TYPE
         BGE      BCA18             RFLD = BIN/FLP
* RFLD = NC                                                              8
         BAL,L1   PRG06             WRITE                                9
         DC,1     DGDZ              ****  DC,1 D'+0'                    10
         B        *L0               RETURN
* RFLD = BIN/FLP                                                        20
BCA18    RES      0                                                     21
         EXU      ECA18-2,R1        EXU ON RFLD TYPE
* RFLD = FLS/FLL                                                        23
         LBAL     PRG02,DGFZ,D1     WRITE FAS/FAL,RREG FL'+0.E8'
         B        *L0               RETURN
*                        V0 = FAS/FAL,RREG
* RFLD = INDEX/BIN
BCA19    RES      0
         AI,V0    CCI               FORM CI,RREG
         LBAL     PIA02,0,D1        WRITE CI,RREG  0
         B        *L0               RETURN
ECA18    RES      0
         AI,V0    CFAL              FLL
         AI,V0    CFAS              FLS
         B        BCA19             BIN
         B        BCA19             INDEX
* SFLD = ALL 'AN LIT'                                                    1
* ** ALL 'AN LIT' POOLED                                                 2
*                        V1 = PSIZ(=DSIZR-ALLSIZ)
*                        D0 = ALLSIZ(SAVED)
*                        D3 = SFLD BASE,DISPL(SAVED)                     4
* **                     R2 = 0                                          5
* **                     R3 = ADCON ALLSIZ,BA(RFLD)                      6
BCA20    RES      0                                                     10
         BAL,L1   OCB00             CHECK,SET RFLD TYPE
         LI,V0    CCBS+CRR2         LOAD CBS,R2
*                        V0 = CBS,RE
*                        D3 = SFLD/RFLD BASE,DISPL
BCA22    RES      0
         MTW,0    SLNKF
         BEZ      BCA21             NOT IN LINKAGE SECTION
         LI,D3    0
         LAB,L1   PIA22,BCA23       WRITE MBS,RE 0
BCA21    RES      0
         BAL,L1   PID10             WRITE CBS,RE BA(SFLD/RFLD)
* ***                    BA(ALL'ANLIT') ALWAYS USED                     13
BCA23    LH,V0    D2                FORM,STORE CBS,RO -(ALLSIZ)
         AI,V0    X'1F'
         LCW,D3   D0                LOAD -ALLSIZ                         2
         STH,V0   D3
         LI,R1    1                 SET RPTCNT = 1                      20
         LI,D1    DCRV-3            LOAD REVERSE %+ VALUE               2
         CI,V1    X'FF'             CHECK PSIZ                          22
         BLE      BCA24             </= 255.  NO REPEAT
* > 255, REPEAT NECESSARY                                               24
         AI,D1    4                 %+ VALUE = %+ VALUE+4               25
         MTW,0    VARF
         BGEZ     BCA24             NO VAR LNTH
         AI,D1    -1
         MTW,0    RLNTH
         BEZ      BCA24             RLNTH < 256
         AI,D1    7
BCA24    RES      0
         BAL,L1   NXMCF
         LBAL     OCB10,DCBR        REVERSE,WRITE BC-,-
         MTW,0    VARF
         BGEZ     BCA25             NO VAR LNTH
         MTW,-1   CONDF
         BAL,L1   VPLIT
         LW,D0    D1
         B        BCA26
BCA25    RES      0
*                        D1 = BE,BNE FLAG                               30
         LW,D0    D1                SAVE BE,BNE FLAG                    32
         BAL,L0   NDR30             OBTAIN L,RPTCNT                     33
*                                   WRITE LI,V2 L                       34
*                        R1 = RPTCNT                                    35
BCA26    RES      0
         LI,L0    BCA08             SET LINK REGISTER
         LI,V1    0                 PSIZ = 0                             1
         LI,D2    DAIA              LOAD ABS, CNTL
         MTW,0    VARF
         BGEZ     BCA27             NO VAR LNTH
         XW,D0    R1
         BAL,L1   BADAD
         B        NCB14+1
BCA27    RES      0
         XW,D0    R1                EXCHANGE,CHECK RPTCNT, BE/BNE FLAG   4
         BEZ      NCB14             RPTCNT = 0
         AI,R1    X'100'            RAISE ALL FLAG
         CI,D0    1                 CHECK RPTCNT                         6
         BE       NCB14             = 1.
* > 1. LOOP NECESSARY                                                   10
         LW,D1    D0                LOAD RPTCNT                         11
         LBAL     PIA02,CLI+CRL1    WRITE LI,L1 RPTCNT                  12
         BAL,L1   PIY31             WRITE                               13
         STB,V2   R3                ****     STORE L                    14
         BAL,L1   PIY31             WRITE                               15
         LI,V2    X'FF'             ****     LOAD MAX.L                 16
         AI,R1    X'80'-6           RAISE LOOP FLAG, ADJUST %+ VALUE
         B        NCB14+1
SFLDF    CI,R6    -3
         BG       SFLDF1
         MTW,1    SLITF             SFLD LITERAL
         B        *L1
SFLDF1   LH,D0    3,R2
         STW,D0   DIFLG             SFLD LNTH
         B        *L1
BADAD    AI,R1    X'180'-3          LOOP AND ALL LITERAL FLAG
         MTW,0    RLNTH
         BEZ      *L1               RLNTH < 256
         AI,R1    -3
         B        *L1
LITVC    MTW,0    SLITF
         BNEZ     LITVR             SFLD LITERAL
         MTW,-1   CONDF
         B        LITVR
* RFLD = AN/GRP
*                        R1 = RPTCNT
*                        V1 = PSIZ: < 0 BSIZS < BSIZR
*                                   = 0 BSIZS = BSIZR
*                                   > 0 BSIZS > BSIZR
*                        D3 = SFLD BASE,DISPL(SAVED)
*                        V0 = SUBSCRIPT FLAG,RE(SAVED)
* **                     RO = MIN(BSIZS,DSIZR),BA(RFLD)
BCA40    RES      0
         LW,D2    R1                SAVE RPTCNT
         BAL,L1   OCB00             CHECK RFLD TYPE
         LI,V0    CRR2              LOAD RE
         BAL,L1   OCB06             CHECK,SAVE,RESTORE SXR
         LW,R1    D2                RESTORE RPTCNT
         LW,V0    JSFLDS            LOAD SUBSCRIPT FLAG
         STW,V1   DGSRD
         AI,V0    CCBS              FORM CBS,RE
         STW,V0   TMPV0
         BLEZ     BCA41
* NOT SUBSCRIPTED
         MTW,0    SLNKF
         BNEZ     BCA41             IN LINKAGE SECTION
         AI,V0    CLI-CCBS          FORM LI,RE
         BAL,L1   PID10             WRITE LI,RE BA(SFLD)
         AI,V0    CCBS-CLI          FORM CBS,RE
         STW,V0   TMPV1
BCA41    LI,L0    X'F0'
         AND,L0   V0
         STW,L0   SAVV0             RE FOR CBS
         MTW,0    LITF
         BNEZ     BCA411
         MTW,1    CONDF
         BAL,L1   MBS70             RESOLVE VAR REC
         B        BCA415
BCA411   MTW,0    SLITF
         BEZ      BCA412            SFLD NOT LITERAL
         LI,V0    R3
         BAL,L1   LITVR             RESOLVE VAR REC
         MTW,0    VARF
         BGEZ     BCA415            NO VAR LNTH
         MTW,1    VLITF
         B        BCA415
BCA412   MTW,-1   CONDF
         BAL,L1   MBS70             RESOLVE VAR REC
         LW,L0    SVARF
         STW,L0   VARF
         BGEZ     BCA415            NO VAR LNTH
         BAL,L1   PIA06
         LB,L0    R3                **** WRITE LB,L0  R3
         LI,V0    R3
         BAL,L1   VAM60
         MTW,1    VLITF
         BAL,L1   PIL06
         BGEZ     2                 **** WRITE BGEZ  %+2
         BAL,L1   PIA06
         STB,V0   R3                **** STB,V0  R3
         BAL,L1   PIA06
         SW,V0    L0                **** WRITE SW,V0  L0
BCA415   LI,L1    BCA42
         LW,V0    TMPV0
         MTW,0    SLNKF
         BNEZ     BCA416            IN LINKAGE SECTION
         AI,V0    0
         BLEZ     PID10             SUBSCRIPTED, WRITE CBS,RE
         LW,V0    TMPV1
BCA416   RES      0
         LBAL     PIA22,0,D3        WRITE CBS,RE 0
*                        L0 = LINK REGISTER                              0
BCA42    RES      0
         LI,L0    BCA08             SET LINK REGISTER
         CI,V1    0                 CHECK PSIZ                           2
         BE       NCB10             = 0. BSIZS = BSIZR                   3
         LW,V0    JSALL             CHECK ALL FLAG
         BEZ      BCA421            NOT ALL LITERAL
         MTW,0    CONDF
         BGEZ     NCB10             NO VAR REC
         B        BCA23
BCA421   RES      0
         LI,V0    DCBT+X'10'        LOAD BC-,1 MASK
         CI,V1    0                 CHECK PSIZ
         BG       BCA43             > 0. BSIZS > BSIZR                   4
         AI,V0    X'10'             SET  BC-,2 MASK                      7
* < 0, BSIZS < BSIZR                                                     6
BCA43    RES      0                                                     10
         BAL,L1   NXMCF
         BAL,L1   OCB10             TEST BC-,-                          13
         CI,V0    X'30'             CHECK BC-,-
         LI,V0    DCBR              LOAD REVERSE FLAG                   15
         BAZ      NCB10+2           = BC-,1(BL/BGE), PAD CHECK UNNECS.  16
* PAD CHECK REQUIRED                                                    17
         MTW,0    VLITF
         BGZ      NCB21             PAD NECESSARY
         CI,R1    0                 CHECK RPTCNT
         BGZ      NCB11             >/= 1, COMPLETE CBS
* RPTCNT = 0
         B        NCB21
*                                   ****  BAL,L1 C:CBP
*                                   ****  BC-,-  TP/FP
* RFLD =  ND                                                             0
*                        V1 = DECPS(<DECPR)                              1
*                        D0 = DSIZS                                      2
* **                     DECA = SFLD                                     3
BCA50    RES      0                                                     10
         BAL,L0   NDR00             ALIGN DECPS,DECPR                   11
BCA52    RES      0                                                     10
         LI,R1    CJAC              SFLD TYPE = NC/ND
         LB,D1    BCART,R1          HAS LOCATION X'1C' BEEN USED        COBOL42I
         CI,D1    X'1C'                                                 COBOL42I
         BE       BCA53             YES                                 COBOL42I
         LBAL     OCB91,DTD4,D1     SAVE SFLD PARAMETERS
         LBAL     PRT02,CDST        WRITE DST,0 TMP
         B        BCA54                                                 COBOL42I
BCA53    RES      0                                                     COBOL42I
         LBAL     OCB91,DTWA,D1                                         COBOL42I
         LBAL     PRT02,CDST                                            COBOL42I
BCA54    RES      0
         LBAL,L0  LRD00,CRD0+X'8',R6   PACK/DL RFLD
* SFLD,RFLD ALIGNED                                                     18
BCA56    RES      0
         LB,D1    BCART             FIRST BYTE OF BCART (NC/ND)         COBOL42I
         CI,D1    X'1C'                                                 COBOL42I
         BE       BCA57             USE X'1C' FOR TEMP STORAGE          COBOL42I
         BAL,L1   PRT06             WRITE                               20
         DC,0     DTD4              ****     COMPARE SFLD,RFLD          21
         B        BCA58                                                 COBOL42I
BCA57    RES      0                                                     COBOL42I
         BAL,L1   PRT06                                                 COBOL42I
         DC,0     DTWA                                                  COBOL42I
* REVERSE BC-,- TP/FP
BCA58    RES      0
         BAL,L1   NXMCF
         LI,V0    X'30030'          LOAD MODIFY,REVERSE CC FLAGS
         BAL,L1   OCB10             CHECK BC-,- TP/EP
         LI,L1    BCA08             SET LINK REGISTER
*                        R4 = ORIGINAL BC-,-
         CI,V0    X'30'             CHECK BG,BL BITS
         BAZ      OCB16             = BE/BNE
         B        OCB13             = BC-,1/2
* RFLD =  NC                                                            50
*                        V1 = DECPS(<DECPR)                             51
*                        D0 = DSIZS                                     52
* **                     DECA = SFLD                                    53
BCA60    RES      0                                                     55
         CH,V1    4,R5              COMPARE DECPS,DECPR                 56
         BG       BCA52             <. ALIGN RFLD                       57
* DECPS </= DECPR, ALIGN SFLD
         BAL,L0   NDR00+1           ALIGN DECPS,DECPR                   61
         LI,R1    CJAC              SFLD TYPE = NC/ND
         BAL,L1   OCB91+1           SAVE MODE,DECPS,DSIZS
* SFLD,RFLD ALIGNED                                                     62
BCA62    RES      0                                                     63
         MTH,DSG  JSAVD             RAISE SAVE DECA FLAG                64
         BAL,L1   SSB00             CHECK SUBSCRIPTS                    65
         MTH,-DSG JSAVD             LOWER SAVE DECA FLAG                66
         AI,V0    CDC-CDL           FORM DC(-DL),- -(,SXR)              70
         LAB,L1   ORD22,BCA08       WRITE DC,L RFLD(,SXR)               71
* RFLD = EXPRESSION
*                        R1 = RFLD EXPRESSION TYPE
*                        R7 = SFLD CLASS
*                        V1 = DECPS
*                        D1 = SREG
BCA70    RES      0
         LH,R1    BCASI             LOAD SFLD
         BAL,L1   OCB90             SET MODE INDICATOR
         LH,R1    BCARI             LOAD RFLD TYPE
BCA72    RES      0
         AI,R1    8                 LOWER EXPRESSION FLAG
         BAL,L0   NCB80             SET LOAD MODE
         LI,L1    0      ****NOP****
         LI,L0    0                                                     COBOL42I
         STW,L0   SFLCF             RESET SFLD CONVERSION FLAG          COBOL42I
         BAL,L0   NCB70             CHECK,SAVE REGISTERS
         BAL,L1   BDE00             PROCESS EXPRESSION
*                        R2 = HA(CLOC)
*                        R5 = HA(CLOC)-1
*                        V1 = DECPS
         LH,R1    BCARI             LOAD RFLD TYPE
         CI,R1    CJAFL             CHECK RFLD TYPE
         BGE      BCA74             RFLD = BIN/FLP
* RFLD = NC
* ***                    DECPS >/= DECPR
         LW,D3    V1                LOAD DECPS
         SH,D3    4,R5              DECPS = DECPS-DECPR
         BEZ      BCA56             DECPS = DECPR
* DECPS > DECPR, ALIGN RFLD
         LBAL,L1  PIA22,CDSA        WRITE DSA  DECPS-DECPR
         B        BCA56
* RFLD(=SFLD) = BIN/FLP
BCA74    RES      0
         LH,V0    1,R2              LOAD,FORM CW,REG
         SLS,V0   4
         AI,V0    CCW
         CI,R1    CJAFL             CHECK RFLD TYPE
         BNE      BCA76             RFLD NOT= FLL
* RFLD = FLL
         AI,V0    CCD-CCW           FORM CD,RREG
BCA76    RES      0
*                        R1 = RFLD TYPE(= SFLD TYPE)
         LB,D3    BCART,R1          LOAD TMP WA DISPL
         LAB,L1   PRT22,BCA58       WRITE CW/CD TMP
* RFLD = DATA (/EXPRESSION)/NLIT                                        75
BCA90    RES      0                                                     76
         LI,L0    BCA96             SET LINK REGISTER                   90
         STH,R1   BCARI             SAVE RFLD TYPE
         CI,R1    CJANL             CHECK RFLD TYPE
         BL       BCA901            RFLD = EXPRESSION                   COBOL42I
         CI,R1    0
         BL       BCA05             RFLD = AN
         CI,R1    CJAL
         BL       BCA91             RFLD = DATA
         BG       BCA99             RFLD = ZERO
* RFLD = NLIT
         LW,R1    R6                RFLD TYPE = SFLD TYPE               92
         CI,R6    CJAX              CHECK SFLD TYPE
         BNE      BCA92             SFLD NOT= INDEX
* SFLD = INDEX
         LAB,R1   BCA92,CJAB        RFLD TYPE = BIN
* RFLD = EXPRESSION                                                     88
BCA901   AI,R1    8                 LOWER EXPRESSION FLAG               COBOL42I
         CW,R1    R6                                                    COBOL42I
         BE       BCA91                                                 COBOL42I
         MTW,1    SFLCF             SET SFLD CONVERSION FLAG            COBOL42I
BCA91    RES      0                                                     80
         CI,R6    CJAL              CHECK SFLD TYPE
         BNE      BCA92             SFLD NOT= NLIT
* SFLD = NLIT
         MTW,1    LITF
         LB,R6    KSCLAS,R1         LOAD RFLD CLASS CODE                91
         BAL,L1   LIT00             POOL LIT                            93
         BAL,L1   BBB62             SET LIT TYPE
*                        R6 = LIT(=SFLD TYPE)
BCA92    RES      0                                                     85
         STH,R6   BCASI             SAVE SFLD TYPE                       K
         CI,R1    CJAX              CHECK RFLD TYPE
         BNE      BCA93             RFLD NOT= INDEX
* RFLD = INDEX                                                          83
         LI,R1    DJAXM+1           SET INDEX RFLD TYPE
BCA93    RES      0                                                     91
         AI,R1    -1                ADJUST RFLD TYPE                    92
         B        BBC91             LOAD SFLD                           COBOL42I
* ** SFLD (CONVERTED,)LOADED********                                    94
*                        R6 = RREG,RFLD CLASS                           95
*                        R7 = SFLD CLASS                                96
*                        DECPS,DSIZS,BSIZS SAVED                        97
*                        L0 = LINK REGISTER
BCA94    RES      0
         LW,R7    R6                LOAD RREG,RFLD CLASS
         LI,D1    X'F0'             MASK RREG,RFLD CLASS
         AND,D1   R7
         EOR,R7   D1
         LH,R1    BCARI             LOAD,CHECK RFLD TYPE                 5
         CI,R1    CJANL             CHECK RFLD TYPE
         BL       BCA70             RFLD = EXPRESSION
* RFLD NOT= EXPRESSION
         CI,R1    CJAL              CHECK RFLD TYPE                      9
         BNE      *L0               RFLD NOT= NLIT                      93
* RFLD = NLIT
BCA95    RES      0
         MTW,1    NOVF
         LW,R6    R7                LOAD SFLD CLASS
         BAL,L1   LIT00             POOL LITERAL
         BAL,L1   BBB62             LOAD RFLD TYPE
*                        R6 = LIT(=RFLD) TYPE
         LW,R1    R6                LOAD RFLD TYPE
*                        D1 = SREG
BCA96    RES      0
         LW,D2    D1                SAVE SREG
         EXU      ECA96,R1          EXU ON RFLD TYPE
* RFLD = BIN/FLP
*                        V0 =  0,0 -(,SXR)
         AW,V0    D2                FORM CW,RREG -(,SXR)
         AI,V0    CCW
         CI,R7    X'F'              CHECK RFLD CLASS
         BNE      BCA97             RFLD NOT= FLL
* RFLD = FLL
         MTW,1    VBIDX             DA
         AI,V0    CCD-CCW           FORM CD,RREG -(,SXR)
BCA97    RES      0
         STW,L0   TMPL0
         MTW,0    NOVF
         BNEZ     BCA971
         MTW,2    VBIDX             WA
         BAL,L0   VPP30             RESOLVE VAR REC
BCA971   LI,L0    0
         STW,L0   NOVF
         STW,L0   VBIDX             RESET VBIDX
         LW,L0    TMPL0
         LAB,L1   MDF65,BCA08       WRITE CW/CD,RREG 0/RFLD(,SXR)
* RFLD = INDEX
BCA98    RES      0
         BAL,L0   MRR00             ADJUST SUBF
         LAB,L1   SSB01,BCA96+2     CHECK SUBSCRIPT
* RFLD = NUMERIC DATA - RFLD TYPE
ECA96    RES      0
         B        BCA60             NC
         B        BCA50             ND
         BAL,L1   SSB00             FLL
         BAL,L1   SSB00             FLS
         BAL,L1   SSB00             BIN
         B        BCA98             INDEX
* RFLD = ZERO
BCA99    RES      0
         LAB,L0   BCC22,BCA08       LOAD ZERO TEST
* CHECK,GENERATE RPT TESTS                                               1
*                        R1 = RPT CNT                                    2
*                        D2 = ---,R- IF D3 = BASE,DISPL  OR              3
*                        D3 = ---,R-                                     4
NCB10    RES      0                                                      5
         LI,V0    DCBR              LOAD REVERSE BC- MASK                6
         LI,R2    0                 BA(NLOC) = 0                         7
         LI,V1    0                 CLEAR PSIZ                           1
NCB11    RES      0                                                     24
         LI,D1    DCRV              LOAD REVERSE %+ VALUE               13
*                        R2 = 0/BA(NLOC)                                 8
*                       V0 = BC-(,-) REVERSE (,MODIFY) MASK             9
*                        V1 = PSIZ                                       2
*                        D1 = REVERSE %+ VALUE                           3
         MTW,0    LADJ
         BEZ      NCB110            NO VAR LNTH
         MTW,0    RLNTH
         BEZ      NCB110            RLNTH < 256
         AI,D1    1
         B        NCB111
NCB110   RES      0
         CI,R1    1                 CHECK RPT CNT                       10
         BL       NCB24             = 0, NO ADDITIONAL.                 11
* RPTCNT >/= 1                                                          12
NCB111   RES      0
         CI,R2    0                 CHECK BA(CLOC)                      10
         BNEZ     NCB12             NOT= 0, BC-,- TP/FP READ            11
* BA(NLOC) = 0, BC-,- TP/FP NOT READ                                    20
         BAL,L1   NXMCF
         LAB,L1   OCB10,NCB12+1     CHECK,REVERSE(,MODIFY) BC-,-        12
* BA(NLOC) NOT= 0, BC-,- TP/FP READ                                     16
NCB12    RES      0                                                     13
         BAL,L1   OCB12             CHECK,REVERSE(,MODIFY) BC-,-        14
*                        D1 = BE/BNE FLAG
         XW,D1    R1                LOAD RPTCNT,SAVE BE/BNE FLAG        24
         CI,D1    1                 CHECK RPTCNT                        25
         BE       NCB13             = 1.                                26
* > 1                                                                   30
         LBAL,L1  PIA02,CLI+CRL1    WRITE LI,L1 RPTCNT                  31
         MTW,0    LADJ
         BEZ      NCB127            NOT VAR REC
         MTW,0    RLNTH
         BEZ      NCB127            RLNTH < 256
         BAL,L1   PIA06
         SW,L1    V1                **** WRITE SW,L1  V1
         AI,R1    -1
         BAL,L1   PIL06
         BLEZ     6                 **** WRITE BLEZ  %+6
NCB127   AI,R1    X'80'-5           RAISE LOOP FLAG
NCB13    RES      0                                                     33
         BAL,L1   PIA06             WRITE                               36
         LI,V2    X'FF'             ****  LI,V2 MAX.L                   37
         LH,D1    D2                LOAD,CHECK ---,R-                   40
         BEZ      NCB14             = 0, ---,R- (0) IN D3               41
* NOT= 0, ---,R-                                                        42
         BAL,L1   OBS14+1           WRITE STB,V2 RO                     43
         LI,D1    DAID              LOAD DREF CLNG,CNTL                 44
         WPOF     ,CBD1+2,NCB16     WRITE C--,R- BA(SFLD)               45
* = 0, ---,R- 0                                                         46
NCB14    RES      0                                                     47
         BAL,L1   OBS14             WRITE STB,V2 RO                     48
         WPOF     ,CBD2+2           WRITE C--,12- 0                     49
*                        R1 = BE,BNE,LOOP FLAG                          50
*                        R2 = BA(CLOC)                                  61
*                        V1 = PSIZ                                      19
NCB16    RES      0                                                     66
         LH,V0    R1                LOAD BE,BNE FLAG                    52
         CI,R1    X'80'             CHECK LOOP FLAG                     53
         BAZ      NCB20             DOWN. ONE ADD&TIONAL ONLY.          54
* LOOP FLAG UP, RPTCNT > 1                                              55
         CI,V0    X'100'            CHECK BE FLAG                       56
         BANZ     NCB17             UP. ORIGINAL = BCR,-                20
* DOWN. ORIGINAL = BCS,-                                                21
         LW,R4    R2                LOAD BA(CLOC)                       62
         LAB,L1   WRPOF,NCB18       WRITE BCS,- TP-FP                   22
* ORIGINAL = BCR,-, WRITE BCS,- REVERSE %+ VALUE(=JT/JF+1)              23
*                        R1 = REVERSE %+ VALUE                          30
*                        V0 = BCS,-                                     65
NCB17    RES      0                                                     68
         LI,D1    X'7F'             MASK REVERSE %+ VALUE
         AND,D1   R1
         BAL,L1   PIL02             WRITE BCS,- REVERSE %+ VALUE        33
NCB18    RES      0                                                     71
         CI,R1    X'100'            CHECK ALL FLAG
         BAZ      NCB19             DOWN. NOT CBS ALL 'ANLIT'
* CBS ALL 'ANLIT'
         MTW,0    CONDF
         BGEZ     NCB185            NO VAR LNTH
         MTW,0    RLNTH
         BEZ      NCB24
         MTW,1    CONDF
         BAL,L1   PIA06
         LW,L1    V1                **** WRITE LW,L1  V1
         BAL,L1   PIL06
         BLEZ     6                 **** WRITE BLEZ  %+6
         AI,R1    -2
         B        NCB13
NCB185   RES      0
         BAL,L1   PIL06             WRITE
         BDR,L1   X'FFFC'           ****  BDR,L1 %-4
         B        NCB24
NCB19    RES      0                                                     77
         BAL,L1   PIL06             WRITE                               69
         BDR,L1   X'FFFD'           ****  BDR,L1 %-3                    70
         MTW,0    BADJ
         BNEZ     NCB22             PAD ADJUSTMENT
         CI,V1    0                 CHECK PSIZ                          34
         BEZ      NCB24             = 0, NO PAD.                        35
         B        NCB22             NOT= 0, PAD CHECK NECESSARY.        36
* LOOP FLAG DOWN. ONE ADDITIONAL ONLY                                   40
*                        V0 = BE/BNE FLAG                               70
NCB20    RES      0                                                     41
         CI,R1    X'100'            CHECK ALL FLAG
         BANZ     NCB26             UP. CBS ALL 'ANLIT'
         MTW,0    BADJ
         BNEZ     NCB201
         CI,V1    0                 CHECK PSIZ                          42
         BEZ      NCB24             = 0. NO PAD                         43
* NOT= 0, PAD CHECK NECESSARY                                           44
NCB201   CI,V0    X'100'            CHECK BE FLAG
         BANZ     NCB21             UP. ORIGINAL = BCR,-                46
* DOWN. ORIGINAL = BCS,-                                                47
         LW,R4    R2                LOAD BA(CLOC)                       48
         LAB,L1   WRPOF,NCB22       WRITE BCS,- TP-FP                   49
* ORIGINAL = BCR,-, WRITE BCS,- REVERSE %+ VALUE(=JT/JF+1)              50
NCB21    RES      0                                                     51
         STW,V1   TMPV1
         LI,D1    3
         MTW,0    BADJ
         BEZ      NCB211            NO PAD ADJUST
         AI,D1    1
NCB211   LI,V0    X'6930'           BNE
         BAL,L1   PIL02             **** WRITE BNE  %+N
         LW,V1    TMPV1
* CHECK PAD                                                             53
*                        V1 = PSIZ                                      54
NCB22    RES      0                                                     55
         MTW,0    VLITF
         BEZ      NCB221
         BAL,L1   PIA06
         LW,L0    V0                **** WRITE LW,L0  V0
         B        NCB235
NCB221   RES      0
         LI,V0    CLI+CP1           LOAD LI,P1                          56
         LW,D1    V1                LOAD,CHECK PSIZ                     57
         BGZ      NCB23             > 0. BSIZS > BSIZR                  58
* < 0. BSIZS < BSIZR                                                    59
         LI,V0    CLI+CP1+X'F'      LOAD LI,P1 -(PSIZ)                  60
NCB23    RES      0                                                     61
         BAL,L1   PIA02             WRITE LI,P1 +/-PSIZ                 62
         MTW,0    BADJ
         BEZ      NCB235            NO PAD ADJUST
         MTW,0    CONDB
         BEZ      NCB232
         BAL,L1   PIA06
         LW,L0    V0                **** WRITE LW,L0  V0
         B        NCB235
NCB232   BAL,L1   PIA06
         LW,L0    R6                **** WRITE LW,L0  R6
NCB235   RES      0
         BAL,L1   PIX06             WRITE                               63
         TEXT     ':CBP'            **** BAL,L1 C:CBP                   64
NCB24    RES      0                                                     65
         CI,R1    X'200'            CHECK NUMERIC TEST FLAG
         BANZ     NCB25
         LW,R4    R2                LOAD BA(CLOC)                       78
         BEZ      NCB25
         BAL,L1   WRPOF             WRITE BC-,- TP/FP                   79
NCB25    LI,L1    0                 CLEAR FLAGS
         STW,L1   LADJ
         STW,L1   BADJ
         STW,L1   VLITF
         STW,L1   CONDF
         STW,L1   CONDB
         B        *L0               RETURN                              80
* CBS ALL 'ANLIT'
NCB26    RES      0
         LBAL     OCB15,DCBR-3,D1   WRITE BC-,- REVERSE %+/TP/FP
* ***                    D1 = REVERSE %+ VALUE-C  FOR RPTCNT ADJ.(R1>1)
         LAB,R1   NCB13,0           LOWER BE,ALL FLAGS
*       SFLD AN--CHECK IF RFLD IS EXPRESSION                            COBOL42I
NCB40    RES       0                                                    COBOL42I
         LH,R1    BCARI             RFLD TYPE                           COBOL42I
         CI,R1    CJANL             IS THIS EXPRESSION                  COBOL42I
         BGE      NCB50             NO                                  COBOL42I
         CI,R1    CJUN              UNKNOWN                             COBOL42I
         BE       NCB50                                                 COBOL42I
         STW,L0   BCASAV+1          SAVE LINK                           COBOL42I
*       EXPRESSION                                                      COBOL42I
         BAL,L1   BDE00             EVALUATE                            COBOL42I
         LH,D1    1,R2              SREG                                COBOL42I
         SLS,D1   -4                                                    COBOL42I
         LBAL,L0  LRR01,CRR6+X'8',R6                                    COBOL42I
*   SET RFLD  SIZE EQUAL TO SFLD SIZE                                   COBOL42I
         LI,R1     1                                                    COBOL42I
         LH,V1     JDSIZ,R1        DSIZ SFLD                            COBOL42I
         STH,V1    3,R5            DSIZ RFLD                            COBOL42I
         LI,R2     HA(JDAN)        HA(AN CLOC)                          COBOL42I
         LH,V1     JBSIZ,R1        BSIZ SFLD                            COBOL42I
         STH,V1    3,R2            BSIZ RFLD                            COBOL42I
         B        NCB56                                                 COBOL42I
*                                                                       391
* CHECK, ZONE ND SFLD                                                   40
NCB50    RES      0                                                     44
         STW,L0   BCASAV+1          SAVE LINK REGISTER                  491
         STH,V1   4,R5              DECPS = 0
         LH,R7    0,R2              LOAD,CHECK SFLD CLASS
         LW,R6    R7                                                    COBOL42I
         AND,R6   =X'FF'            MASK OFF SFLD CLASS                 COBOL42I
         CI,R6    X'80'             SEE IF GROUP ITEM                   COBOL42I
         BE       NCB51             YES                                 COBOL42I
         CI,R7    1
         BAZ      NCB54             SFLD = NDS/NCS
         CI,R7    8
         BANZ     NCB54             SFLD = NCU
* SFLD = NDU                                                            461
NCB51    RES      0                                                     COBOL42I
         AI,R7    -6                SFLD CLASS = AN
        STH,R7   0,R2
NCB52    RES      0                                                     464
         LI,R6    CJAN              SFLD TYPE = AN
         B        *BCASAV+1         RETURN                              465
* SFLD = NC/NDS
NCB54    RES      0
         CI,R7    X'10'             CHECK TYPE
         BAZ      NCB55             DATA
* SFLD = NLIT
         BAL,L1   LIT00             POOL NLIT
         MTW,1    NOVF
NCB55    RES      0                                                     493
         LBAL,L0  LRD00,CRR6+X'8',R6                                    COBOL42I
* **                     DECA LOADED                                    492
NCB56    RES      0                                                     COBOL42I
         LH,D0    3,R5              LOAD DSIZ
         LI,R2    HA(JDAN)          LOAD HA(AN CLOC),HA(AN CLOC)-1
         LI,R5    HA(JDAN)-1
         STH,D0   JDAN+3            STORE BSIZ
         OR,D0    K301              FORCE DSIZ ODD
         STW,D0   JDAN+2            STORE DSIZ
         LI,D1    DTBA              LOAD,STORE DISPL
         STH,D1   JDAN+2
         LBAL,L0  MDR02,7,R7        SFLD TO ZONED NDU
         LH,V1    3,R2              COMPARE BSIZ,DSIZ
         SH,V1    3,R5
         BEZ      NCB52             = 0. BSIZ ODD                       52
* NOT= 0. BSIZ EVEN, FORCED ODD                                         53
         AI,V1    X'10000'          DSIZ=DSIZ-1, DISPL = DISPL+1
         AWM,V1   JDAN+2
         B        NCB52                                                 56
* CHECK,SAVE REGISTERS
*                        R2,R5 = HA(CLOC),HA(CLOC)-1
*                        L0 = LINK REGISTER
*                        R4,V0,D2,D3 VOLATILE
NCB70    RES      0
         LI,R7    -6                SET MODE INDEX(I), FLAG
         LW,R5    JSAVD
NCB71    RES      0
         CI,R5    X'1000'           CHECK MODE FLAG
         BANZ     NCB73             UP. CHECK,SAVE.
NCB72    RES      0
         AW,R5    R5                POSITION NEXT MODE FLAG
         BIR,R7   NCB71             I = I+1
* E-O-SAVE
         STH,R7   JSAVD             CLEAR DECA SAVE FLAG
         B        *L0               RETURN
NCB73    RES      0                                                     10
         LI,R4    6                 SET TYPE CODE
         AW,R4    R7
         LB,V0    BCART,R4          LOAD,CHECK MODE CNTL                11
         CI,V0    X'F'                                                  12
         BANZ     NCB72             SAVED.                              13
* SAVE                                                                  20
         LB,D3    KSTMP,R4          LOAD STANDARD TMP SAVE WA DISPL     21
         STB,D3   BCART,R4                                              22
         EXU      ECB73,R4          EXU ON MODE                         23
         LAB,L1   PRT22,NCB72       WRITE STW/STD,SREG OR DST,0 TMP     25
* FLS                                                                   30
NCB74    RES      0                                                     31
         AI,V0    CSTW              FORM STW,SREG                       33
         CI,R5    X'2000'           CHECK FLL FLAG                      34
         BAZ      *L1               DOWN. FLS ONLU                      35
         B        NCB72             UP. FLL SAVED                       36
NCB741   AI,V0    CSTD              FLL                                 COBOL42I
         CI,V0    X'F0'                                                 COBOL42I
         BANZ     *L1               NOT SAVED DEC                       COBOL42I
         B        NCB743                                                COBOL42I
NCB742   AI,V0    CSTW              INDEX                               COBOL42I
         CI,V0    X'F0'                                                 COBOL42I
         BANZ     *L1                                                   COBOL42I
NCB743   AI,R4    1                                                     COBOL42I
         LB,R4    BCART,R4                                              COBOL42I
         BNEZ     NCB744            IF SET OK                           COBOL42I
         LI,R4    X'80'             IF NOT SET USE DEFUALT REG 8        COBOL42I
*                                   THIS IS AN ASSUMPTION THAT EVERYBODYCOBOL42I
*                                   USES R8 IF ITS NOT SET              COBOL42I
NCB744   RES      0                                                     COBOL42I
         OR,V0    R4                SET SREG                            COBOL42I
         B        *L1                                                   COBOL42I
* ND                                                                    37
NCB75    RES      0                                                     38
         CI,R5    X'2000'           CHECK NC FLAG                       39
         BANZ     NCB73             UP. NC SAVED.                       40
* NC(/ND)                                                               41
NCB76    RES      0                                                     42
         CI,R5    X'C'              CHECK DECA SAVED FLAG               43
         BANZ     NCB73             UP. DECA SAVED                      44
* SAVE DECA                                                             45
         LI,D3    DTWA              USE TMP WK AREA 1C
******* PRECEDING INSTR MAY BE AN ERROR
         STB,D3   BCART,R4                                              COBOL42I
         LAB,V0   *L1,CDST          WRITE  DST,0 TMP                    46
ECB73    RES      0
         BAL,L1   NCB76             NC
         BAL,L1   NCB75             ND
         BAL,L1   NCB741            FLL                                 COBOL42I
         BAL,L1   NCB74             FLS
         BAL,L1   NCB742            BIN
         BAL,L1   NCB742            INDEX                               COBOL42I
* AVAILABILITY, MODE CHECK
*                        R1 = RFLD TYPE
*                        L0 = LINK REGISTER
* *** RETURNS: *L0 - SFLD TYPE (=NC/ND)=RFLD TYPE, SFLD IN TMP
*                        DECPS > DECPR, LOAD,ALIGN RFLD
*                        RFLD TYPE = ND. PACK(,ALIGN) RFLD
*            : *L1+1  CC2 RESET - SFLD IN REGISTER
*                     CC2 SET   - SFLD IN TMP
NCB80    RES      0
         STW,L0   BCASAV+1          SAVE LINK REGISTER                  76
         STH,R1   BCARI             SAVE RFLD TYPE                      84
         BAL,L1   OCB92             CHECK MODE AVAILABILITY
*                        R6 = SFLD TYPE                                 83
         LB,R7    KSCLAS,R6         LOAD SFLD CLASS
         BAZ      NCB90             AVAILABLE IN REG.
* AVAILABLE IN TMP
         STH,R6   BCASI             SAVE SFLD TYPE                       7
*                        D1 = TMP WA DISPL                               5
         CW,R6    R1                COMPARE SFLD,RFLD TYPE               7
         BE       NCB88             SFLD TYPE = RFLD TYPE
* SFLD TYPE NOT= RFLD TYPE                                              10
         AW,R1    R6                RFLD TYPE = RFLD TYPE+SFLD TYPE     11
         BDR,R1   NCB84             RFLD,SFLD NOT= NC(/ND),ND(NC)       12
* SFLD(,RFLD) = NC(/ND)(,ND(/NC))                                       13
*                        V1 = DECPS                                     14
NCB82    RES      0
         CH,V1    4,R5              COMPARE DECPS,DECPR                 16
         BG       *L0               DECPS > DECPR - LOAD,ALIGN RFLD     17
         BE       NCB83             DECPS = DECPR                       10
* DECPS < DECPR - LOAD,ALIGN SFLD                                       11
         LAB,L0   NCB98,NCB92       LOAD,ALIGN SFLD
* DECPS = DECPR                                                         20
NCB83    RES      0                                                     21
         CI,R1    CJAC-1            CHECK RFLD TYPE                     22
         BNE      *L0               RFLD = ND - PACK RFLD               23
* SFLD = NC, LOAD UNNECESSARY                                           24
         B        NCB89                                                 25
* RFLD,SFLD NOT= NC(/ND),ND(/NC)                                        30
NCB84    RES      0
         SW,R1    R6                RFLD TYPE = RFLD TYPE-1             32
         CI,R6    CJAFL             CHECK SFLD TYPE                     33
         BAZ      NCB85             SFLD NOT= FLS/FLL                   30
* SFLD = FLS/FLL                                                        31
         LH,R4    BCARI             LOAD, CHECK RFLD                    32
         CI,R4    CJAFL                                                 33
         BANZ     NCB89             SFLD,RFLD = FLS/FLL - LOAD UNNECS.
* SFLD,RFLD NOT= FLS/FLL                                                34
NCB85    RES      0                                                     35
         CI,R6    CJAX              CHECK SFLD TYPE                     36
         BNE      NCB86             SFLD NOT= INDEX                     37
* SFLD = INDEX                                                          38
         CI,V1    -1                CHECK SUBFS                         39
         BNE      NCB86             SUBFS NOT= -1(INTEGER)              40
* SUBFS = -1                                                            41
         CI,R1    CJAB-1            CHECK RFLD TYPE                     42
         BE       NCB89             RFLD = BIN.- LOAD UNNECESSARY       43
* LOAD,CONVERT SFLD                                                     44
*                        D1 = TMP WA(DISPL)                             45
NCB86    RES      0
         BAL,L0   NCB98             LOAD SFLD                           46
         B        NCB93+1
* SFLD TYPE = RFLD TYPE
NCB88    RES      0
         AI,R1    -1                RFLD TYPE = RFLD TYPE-1
         BLEZ     NCB82             RFLD = NC/ND
* SFLD(,RFLD) = INDEX/BIN/FLP
         LCI      4                 SET CC4
*                        CC2 SET - SFLD IN TMP
NCB89    RES      0                                                     52
         LI,R4    1                 SET LINK INDEX
         B        *L0,R4            RETURN
* AVAILABLE IN REG                                                      86
*                        R6 = SFLD TYPE
NCB90    RES      0
         STH,R6   BCASI             SAVE SFLD TYPE
         CW,R6    R1                COMPARE SFLD,RFLD TYPE              60
         BE       NCB96             SFLD TYPE = RFLD TYPE               61
* SFLD TYPE NOT= RFLD TYPE                                              62
         AW,R1    R6                RFLD TYPE = RFLD TYPE+SFLD TYPE     63
         BDR,R1   NCB93             SFLD,RFLD NOT= NC(/ND),ND(/NC)      64
* SFLD(,RFLD) = NC (/ND),ND(/NC)                                        65
*                        V1 = DECPS                                     61
NCB91    RES      0                                                     65
         CH,V1    4,R5              COMPARE DECPS,DECPR                 66
         BGE      NCB97             DECPS >/= DECPR - ALIGN RFLD        67
* DECPS < DECPR - ALIGN SFLD                                            68
NCB92    RES      0
         STW,V1   JDECP             SET DECPS                           70
         BAL,L0   NDR00             SET MAX(DECP,DECPS)
         STH,V1   BCDECP,R6         STORE ADJUSTED DECPS                73
         B        NCB97
* SFLD,RFLD NOT= NC(/ND),ND(/NC)
NCB93    RES      0                                                     80
         SW,R1    R6                RESTORE RFLD TYPE
         LI,L0    NCB95             SET LINK REGISTER                    6
         CI,R1    0                 CHECK RFLD TYPE
         BG       NCB94             RFLD = INDEX/BIN/FLP
* *** USE DECP MAX FOR C:C-D *******
         LH,V1    MCBUF+2           LOAD DECP MAX.
         BAL,L0   BBE53             LOAD NC/ND                          COBOL42I
         MTW,0    SFLCF                                                 COBOL42I
         BEZ      NCB95             NOT EXPRESSION                      COBOL42I
         LW,V1    JDECP             RECOVER SFLD DECPS                  COBOL42I
         B        NCB95                                                 COBOL42I
* SFLD = INDEX/BIN/FLP
NCB94    RES      0
         CI,R1    CJAX-1            CHECK RFLD TYPE
         BNE      NCB942            NOT= INDEX
         LAB,R1   BBE53,DJAXM       LOAD INDEX
NCB942   RES      0
         CI,R1    CJAFS-1           CHECK RFLD TYPE
         BNE      BBE53             NOT= FLS
* RFLD = FLS
         STH,R1   BCARI             RFLD TYPE = FLL
         BDR,R1   BBE53             RFLD TYPE = RFLD TYPE-1 (=FLL-1)
*                        R6 = SREG,SFLD CLASS                           89
NCB95    RES      0
         LI,D1    X'F0'             MASK SREG                           91
         AND,D1   R6                                                    92
         LH,R1    BCARI             LOAD RFLD TYPE
         LAB,L1   OCB90,NCB97       SET MODE FLAG
* SFLD TYPE = RFLD TYPE
NCB96    RES      0
         AI,R1    -1                RFLD TYPE = RFLD TYPE-1
         BLEZ     NCB91             RFLD = NC/ND
* RFLD = INDEX/BIN/FLP
NCB97    RES      0
         MTW,1    BCASAV+1          SET LINK
         B        *BCASAV+1         RETURN
*                        CC2 RESET - SFLD IN REGISTER
*
* LOAD SFLD                                                             90
*                        R6 = SFLD TYPE                                 91
*                        D1 = TMP WA(DISPL)                             92
*                        V0,D0,D1 VOLATILE                              93
NCB98    RES      0
         LH,V0    KSLDR,R6          LOAD DL,0 OR LD/LW,SREG(STANDARD    95
         BAL,L1   PRT02             WRITE DL,0 OR LD/LW,SREG TMP        96
*        NOTE THE FOLLOWING TWO INSTRUCTIONS REPLACED WHAT USED TO BE   COBOL42I
*        AND,V0   K3F0                                                  COBOL42I
*        STB,V0   BCART,R6                                              COBOL42I
*        THIS WAS DONE BY C.W. IN ORDER TO FIX A COMPLEX IF PROBLEM     COBOL42I
*        THIS WILL LET NCB73 KNOW THAT SFLD IS ALREADY IN TMP           COBOL42I
         AND,D1   K3FF                                                  COBOL42I
         STB,D1   BCART,R6                                              COBOL42I
         LW,D1    V0                LOAD SREG/L                         98
         B        *L0               RETURN                              99
*                        V0,D1 = SREG/L                                 99
*                        CC3: SET - SFLD = INDEX/BIN/FLP(SREG NOT= 0)   99
*                             RESET - SFLD = NC (L = 0)                 99
* CHECK,SET RFLD TYPE                                                    1
*                        R1,R4 VOLATILE
* ***                    R1 = RFLD TYPE ON EXIT(SAVED)
OCB00    RES      0                                                      2
         LH,R1    BCARI             LOAD CHECK RFLD TYPE                 3
         CI,R1    CJUN              CHECK RFLD TYPE
         BG       *L1               > KNOWN
* UNKNOWN                                                               13
OCB01    RES      0
         LH,R4    0,R2              LOAD,MASK CLASS                      2
         LI,R1    X'F'                                                   3
         AND,R1   R4                                                     4
         LB,R1    KRTYP,R1          LOAD RFLD TYPE                      18
         CI,R1    7                 CHECK TYPE CODE
         BE       OCB03             = ZERO
         BL       OCB02             = NUMERIC
* NON-NUMERIC
         AI,R1    -X'B'             SET AN/GRP RFLD TYPE
         CI,R4    X'10'             CHECK ANLIT/FIGCON FLAG
         BAZ      OCB03             DOWN. DATA.
         LAB,R1   OCB03,CJANL       RFLD TYPE = ANLIT/FIGCON
* NUMERIC
OCB02    RES      0                                                     14
         CI,R4    X'30'             CHECK NLIT/EXPRESSION FLAGS
         BAZ      OCB03             DOWN. DATA
         CI,R4    X'20'             CHECK EXPRESSION FLAG               11
         BAZ      OCB03-1           DOWN. NLIT.
* EXPRESSION                                                            20
         AI,R1    -8                ADJUST TYPE
         STH,R1   BCARI             STORE NEW RFLD TYPE
         MTH,-1   MCBUF+DCNI+8,R1   NREF(I) = NREF(I)-1                 33
         BNEZ     *L1               NOT= 0,MORE I REMAIN                34
* NREF(I)= 0                                                            35
         LCW,R4   R1                LOAD -I+8                           36
         AI,R4    X'BFFFC'-8
         B        OCB04
* NLIT
         LI,R1    CJAL              RFLD TYPE = NLIT
* DECREMENT NREF(I)                                                     30
OCB03    RES      0                                                     22
         STH,R1   BCARI             STORE NEW RFLD TYPE
         MTH,-1   MCBUF+DCNI,R1     NREF(I) = NREF(I)-1                 32
         BNEZ     *L1               NOT= 0. MORE I REMAIN.              33
* NREF=(I) = 0                                                          34
         LCW,R4   R1                LOAD -I                             51
         AI,R4    X'BFFFC'          -I = -I-4                           52
OCB04    RES      0                                                     31
         SLS,R4   14,R4             POSITION,MASK -TYPE BIT,-1          53
         AND,R4   KF00F0                                                54
         AWM,R4   BCANT             TYPE BIT(I) = 0, NTYP = NTYP-1      55
         B        *L1               RETURN                              40
*
* CHECK,SAVE, RESTORE SXR
* *** IF NOT SUBSCRIPTED - NOP
* *** IF SUBSCRIPTED: SXR NOT SAVED  R-=SXR - NOP, SXR SAVED IF NREF>0
* ***                                R-NOT= SXR - OP/LW,R- SXR
* ***                 SXR SAVED      OP/LW,R- SXR SAVE
*                        V0 = OP,R-
*                        R4,V0,D0,D1 VOLATILE                            3
*                        L1 = LINK REGISTER                              2
OCB06    RES      0                                                     50
         LW,D3    JSFLD             LOAD SFLD BADE,DISPL                11
         LW,D1    JSFLDS            LOAD,CHECK SUBSCRIPT FLAG           12
         BGZ      *L1               DOWN. NOT SUBSCRIPTED.              13
* SUBSCRIPTED                                                           14
         AI,V0    CSXR              RAISE SUBSCRIPT FLAG                15
         CI,D1    CSXRS             CHECK SAVED FLAG                    16
         BANZ     OCB07             DOWN(=SET VALUE). NOT SAVED.        17
* SAVED                                                                 20
* *** SXR IS SAVED JUST PRIOR TO FIRST USE ***                          21
         LI,D1    DTSXR             LOAD SXR SAVE DISPL                 22
         CI,V0    X'FF00'           CHECK OP                            23
         BANZ     PRT02             NOT= 0. WRITE OP,R- SXR SAVE        24
* OP = 0.                                                               25
         AI,V0    CLW               FORM LW,R-                          26
         B        PRT02             WRITE LW,R- SXR SAVE                27
* NOT SAVED                                                             40
OCB07    RES      0                                                     41
         AI,D1    X'10000'          -CSXR LOWER SUBSCRIPT FLAG
         LI,R4    X'F0'             MASK,CHECK SXR                      43
         AND,R4   V0                                                    44
         CW,R4    D1                                                    45
         BE       OCB08             R- = SXR. CHECK,SAVE SXR            46
* R- NOT= SXR                                                           50
         CI,V0    X'FF00'           CHECK OP                            51
         BAZ      ORR06+2           = 0. WRITE LW,R- SXR                52
         B        ORR07             NOT= 0. WRITE OP,R- SXR             53
* CHECK,SAVE SXR                                                         1
OCB08    RES      0                                                      5
         LH,R4    JCREF             LOAD,CHECK NREF                     60
         CI,R4    1                                                     61
         BLE      *L1               </= 1. SXR SAVE UNNECESSARY.        12
* SAVE SXR                                                              13
         MTH,-1   JSFLDS            RAISE SAVED FLAG                    65
         AI,V0    CSTW              FORM STW,SXR                        14
         LAB,D1   PRT02,DTSXR       WRITE STW,SXR TMP                   15
* REVERSE(,MODIFY) BC-,-                                                60
*                        R2 = BA(CLOC)                                  61
*                        V0 = BC-(,-) REVERSE(,MODIFY) MASK             62
*                        L1 = LINK REGISTER                             62
OCB10    RES      0                                                     63
         LW,R5    R2                LOAD HA(CLOC)-1                     64
         AI,R5    -1                                                    66
         SLS,R5   -1                                                    65
*                        R5 = HA(CLOC)-1                                54
OCB12    RES      0                                                     67
         LH,R4    1,R5              LOAD,REVERSE BC-(,-)                68
         EOR,V0   R4                                                    69
         BG       OCB14             TEMPORARY REVERSAL                  70
* PERMANENT MODIFICATION                                                71
OCB13    RES      0
         STH,V0   1,R5              STORE MODIFIED, BC-,-               72
         CI,V0    X'10000'          CHECK MODIFY ONLY FLAG              73
         BANZ     OCB16             UP. MODIFY ONLY.                    74
* MODIFY AND REVERSE                                                    75
         EOR,V0   K201              REVERSE BC-                         76
OCB14    RES      0                                                     77
         CI,V0    DCBT              CHECK TEST ONLY FLAG                81
         BANZ     *L1               UP. RETURN                          82
* DOWN. NOT TEST ONLY                                                   83
         STH,V0   D1                STORE REVERSED BC-,-                78
OCB15    RES      0
         CI,V0    X'100'            CHECK BE FLAG                       84
         BANZ     OCB18             UP. ORIGINAL = BCR,-                85
* DOWN. ORIGINAL = BCS,-                                                86
OCB16    RES      0                                                     87
         LW,R4    R2                LOAD BA(CLOC)                       88
         B        WRPOF             WRITE BCS,- TP-FP                   88
* ORIGINAL = BCR,-, WRITE BCS,- REVERSE %+ VALUE(=JT/JF+1)              86
*                        V0 = REVERSED                                  91
*                        V1 = PSIZ                                      90
*                        D1 = REVERSE %+ VALUE                          92
*                        R1 = RPTCNT                                    93
OCB18    RES      0                                                     94
         CI,R1    1                 CHECK RPT CNT                       95
         BLE      OCB19             </=,1                               91
* > 1                                                                   97
         AI,D1    3                 %+ VALUE = %+ VALUE+3               98
         CI,D1    X'200'            CHECK NUMERIC FLAG
         BANZ     OCB19-1           UP, SET REPEAT %+ VALUE.
         CI,V1    0                 CHECK PSIZ                          92
         BEZ      PIL02             = 0. WRITE BCS,- REVERSE %+ VALUE   93
* NOT= 0, PAD CHECK NECESSARY                                           94
         AI,D1    -1                %+ VALUE = %+ VALUE-1               95
* </= 1                                                                 96
OCB19    RES      0                                                     97
         CI,V1    0                 CHECK PSIZ                          971
         BEZ      PIL02             = 0. WRITE BCS,- REVERSE %+ VALUE   98
* NOT= 0, PAD CHECK NECESSARY                                           99
         AI,D1    3                 %+ VALUE = %+ VALUE+3               991
         B        PIL02             WRITE BCS,- REVERSE %+ VALUE        992
*                                                                        0
* CLASSIFY LIT                                                           1
*                        R7 = LIT CLASS                                  2
*                        DO = BSIZS                                      3
OCB30    RES      0
         LH,R1    BCARI             LOAD RFLD TYPE                      11
         LI,R4    CJAL              SET NLIT CODE
         CI,R7    8                 CHECK LIT CLASS                     12
         BANZ     OCB32+1           = NLIT
* NOT NLIT                                                              14
         LI,R4    CJAZ              SET ZERO TYPE CODE                  14
         CI,R7    4                 CHECK LIT CLASS                     15
         BANZ     OCB32             = ZERO/ZERO LIT
         LI,R4    CJANL             SET ANLIT TYPE CODE                 16
         CI,R7    2                  CHECK FOR ALL '1 CHAR'             COBOL42I
         BE       OCB32              = ALL '1 CHAR'                     COBOL42I
         CI,R7    1                                                     17
         BE       OCB32+1           = ANLIT
         BL       OCB32             = FIGCON
* ALL 'ANLIT'                                                           20
         CH,D0    3,R2              COMPARE BSIZS,BSIZR                 21
         BG       OCB32             BSIZS > BSIZR
* BSIZS </= BSIZR, NO ALL                                               23
         STH,D0   3,R2              BSIZR,DSIZR = BSIZS                 25
         STH,D0   3,R5                                                  26
         B        OCB32+1
* ZERO/FIGCON/ALL'ANLIT'                                                30
OCB32    RES      0
         LI,L1    BCB30             SET LINK REGISTER
         CI,R1    CJUN              CHECK RFLD TYPE                     31
         BNE      *L1               RFLD TYPE KNOWN                     44
* RFLD TYPE UNKNOWN                                                     33
*                        R4 = RFLD TYPE                                 34
         LW,R1    R4                LOAD RFLD TYPE                      35
         B        OCB03             UPDATE NREF(I),NREF
* SET MODE FLAG                                                         10
*                        R1 = TYPE CODE                                  1
*                        D1 = SREG                                       2
*                        R4,D2 VOLATILE                                  3
OCB90    RES      0                                                      4
         BDR,R1   OCB90+2           TYPE CODE = TYPE CODE-1
         LI,R1    CJAC-1            SET COMMON NC,ND TYPE CODE
* FLD TYPE = NC/ND
         AI,R1    1                 TYPE CODE = TYPE CODE+1
         LCW,R4   R1                LOAD -RFLD TYPE
         LI,D2    X'1000'           LOAD, POSITION MODE FLAG
         SLS,D2   0,R4                                                  11
         CW,D2    JSAVD             CHECK MODE FLAG                     12
         BANZ     OCB91             UP.
* DOWN, FIRST USE                                                       14
         AWM,D2   JSAVD             RAISE MODE FLAG                     15
*                        D1 = SREG
OCB91    RES      0
         STB,D1   BCART,R1          SAVE SREG                           16
*                        V1 = DECPS
*                        D0 = DSIZS
         STH,V1   BCDECP,R1         SAVE DECPS,DSIZS
         STH,D0   BCDSIZ,R1
         B        *L1               RETURN                              17
* CHECK MODE, LOCATE                                                    20
*                        R1 = TYPE CODE                                 21
*                        R4,R6,V0,D2,D3 VOLATILE                         20
OCB92    RES      0                                                     29
         LW,D2    JSAVD             LOAD, POSITION MODE FLAG
         SLS,D2   0,R1              POSITION MODE FLAG
         CI,D2    X'1000'           CHECK MODE FLAG
         BANZ     OCB96             UP. PREVIOUS USE.                   33
         CI,D2    X'C'              CHECK NC/ND MODE FLAGS              41
         BAZ      OCB93             DOWN. NOT NC/ND                     42
* NC/ND MODE USED                                                       47
         LI,R6    1                 SET MODE INDEX                      48
         EOR,R6   R1                                                    49
         B        OCB97
* UNUSED MODE                                                           51
* *** REVERSE CHECK FIRST **********                                    52
OCB93    RES      0                                                     53
         LW,R6    R1                LOAD,CHECK RFLD TYPE                55
         CI,R1    1                 CHECK ODD PAIR BIT
         BANZ     OCB94             UP.
* DOWN. REVERSE SCAN FROM ODD.
         AI,R6    1                 MODE INDEX = MODE INDEX+1
         AW,D2    D2                POSITION MODE MASK
OCB94    RES      0                                                     62
         CI,D2    X'1000'           CHECK MODE FLAG
         BANZ     OCB97             UP, USE AS SFLD MODE                64
         SLS,D2   -1                POSITION NEXT MODE FLAG
         BDR,R6   OCB94                                                 66
         CI,D2    X'1000'           CHECK NC FLAG
         BANZ     OCB97             UP. USE NC.
* E-O-REVERSE CHECK                                                     67
         LI,R6    -6                INITIALIZE REMAINING RFLD TYPE CNT  68
         AW,R6    R1
         SLS,D2   0,R1              POSITION MODE FLAG(I)               70
OCB95    RES      0                                                     71
         CI,D2    X'1000'           CHECK MODE FLAG
         BANZ     OCB97-1           UP. USE AS SFLD MODE                73
         AW,D2    D2                POSITION MODE FLAG(I)               74
         BIR,R6   OCB95                                                 74
* *** NO FALL THRU******************                                    75
OCB96    RES      0                                                     79
         LW,R6    R1                SFLD TYPE = RFLD TYPE               81
         CI,R6    CJAFS             CHECK SFLD TYPE                     80
         BNE      OCB97             SFLD NOT= FLS                       81
* SFLD = FLS                                                            82
         CI,D2    X'2000'           CHECK FLL MODE FLAG                 83
         BAZ      OCB97             DOWN. FLS ONLY                      85
* FLL SFLD PRESENT                                                      86
         LI,R6    CJAFL-6           SFLD TYPE = FLL                     87
*                        R6 = SFLD TYPE-6
         AI,R6    6                 ADJUST SFLD TYPE
*                        R6 = SFLD TYPE                                 78
OCB97    RES      0                                                     90
         LB,D1    BCART,R6          LOAD MODE CNTL                      92
         LH,V1    BCDECP,R6         LOAD DECPS,DSIZS
         LH,D0    BCDSIZ,R6
         CI,D1    X'0F'             CHECK TMP FLAG
* *** EITHER REG/TMP BITS MUST BE NON-ZERO******                        95
         BANZ     *L1               UP. VALUE IN TMP
         LW,V0    D1                 LOAD SREG
         B        *L1               DOWN. VALUE IN REG
NXMCF    STW,L1   TMPL1
         BAL,L1   RDMCF             READ NEXT MCF
         SLS,R2   -1
         BAL,L1   BAA48             SAVE VAR PARAM
         SLS,R2   1
         LW,L1    TMPL1
         B        *L1
* ***                    R1 = RFLD TYPE
* ***                    R6 = SFLD TYPE
* ***                    D1 = SREG IF VALUE IN REG
* ***                       = TMP BASE,DISPL IF VALUE IN TMP
* ***                    CC2 SET - SFLD IN TMP
* ***                        RESET - SFLD IN REG.
* ***                    V0 = SREG
*
CONDB    DATA     0
VLITF    DATA     0
SLITF    DATA     0
SFLCF    DATA     0                                                     COBOL42I
SIDXL    DATA     0                 SFLD INDEX FLAG                     COBOL42I
DIFLG    DATA     0
TMPV0    DATA     0
TMPV1    DATA     0
TMPL0    RES      1
TMPL1    RES      1
KSTDR    GEN,8,8,8,8 CRI,CRB,CRFL,CRFL      STANDARD REGISTERS          91
KRTYP    GEN,8,8,8,8 X'9',X'A',8,8  RFLD TYPE CODES
         GEN,8,8,8,8 7,7,1,1
         GEN,8,8,8,8 0,0,6,6
KSTYP    GEN,8,8,8,8 CJAX,CJAB,CJAFS,CJAFL  SFLD TYPE CODES             92
         GEN,8,8,8,8 0,0,X'D',0                                         93
KRCLAS   GEN,8,8,8,8 0,X'F',X'E',X'D'                                   94
         GEN,8,8,8,8 0,0,X'D',0
KSCLAS   GEN,8,8,8,8  8,8,X'F',X'E' SUBJECT/OBJECT CLASS
         GEN,8,8,8,8  X'D',X'C',0,0                                     09
KSTMP    GEN,8,8,8,8  DTD4,DTD4,DTF,DTF TEMP SAVE WA DISPL
         GEN,8,8,8,8  DTB,DTX,00
KSLD     GEN,16,16  CLD,CLW
         GEN,16,16  CLW,CLW
KSLDR    RES      0
         GEN,16,16  CDL,CDL
         GEN,16,16  CLD+CRFL,CLW+CRFL
         GEN,16,16  CLW+CRB,CLW+CRI
         REF      JDECP,JDSIZ       DECP,DSIZ
JSALL    EQU      JSXR+1            ALL ANLIT FLAG(=BSIZS)
JBSIZ    EQU      JDSIZ+1           BSIZ
JMBSIZ   EQU      JDSIZ+2           SFLD M(OVED)BS CNT
JCSAV    EQU      JDSIZ+3           CONDITION MODE SAVE
JSFLD    EQU      JDSIZ+4           SFLD BASE,DISPL
JSFLDS   EQU      JDSIZ+5           SFLD SUBSCRIPT FLAG
JRFLD    EQU      JDSIZ+18          RFLD CLASS
JSAVD    EQU      JDECP+14          SAVE DECA FLAG
JSUBF    EQU      JDECP+18
JCREF    EQU      JDSIZ+20          CONDITION FLAG
         REF      JAIDW             DATA REF
JDAN     EQU      JAIDW+3           AN CLUSTER
         REF      JTTBS             TTBS TABLE
*                                                                       65
         REF      BCASAV            CONDITIONAL
BCASI    EQU      BCASAV+2          SFLD
BCARI    EQU      BCASAV+3          RFLD TYPE
BCANT    EQU      BCASAV+4          TYPE BITS,NTYP
BCART    EQU      BCASAV+5          REG/TMP INDICATORS
*        RES      2
BCDECP   EQU      BCASAV+7
*        RES      3
BCDSIZ   EQU      BCDECP+3
*        RES      3
*
BBCSI    EQU      BBCSAV+3          SFLD TYPE
BBCRI    EQU      BBCSAV+4          RFLD TYPE
BBCNI    EQU      BBCSAV+4          NREF(I) CNTL
*                                                                       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
K301     EQU      KBKON+11
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
