         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.2 - MOVE,LOAD'
* 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
         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,OIX02
         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      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      LRN00
         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      OBS90
         REF      LDR00,LDR20,LDR60,LDR70,LDR80
         REF      MDR00,MDR30,MDR40,MDR50
         REF      MDR60,MDR64,MDR66,MDR68
         REF      MDR80,MDR84,MDR88
         REF      MDR70,MDR74,MDR78
         REF      MDE00
         REF      NDR30,NDR31,NDR32
         REF      NDR38,NDR40
         REF      MDR02
         REF      ODR00
         REF      ODR16
         REF      ODR32,ODR34
         REF      MDS00,MDS01
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      MDF65,SLNKF,LNKSF                                     COBOL42D
         REF      SFLCF                                                 COBOL42D
         REF      LIT00
         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
         REF      BCA12,BCA20,BCA40
         REF      BCB30
         REF      BCA94
         REF      NCB50
         REF      NCB40                                                 COBOL42D
         REF      OCB30
         REF      VPP00,VPP10,VPP30
         REF      BAA46,MDF04,RLNTH
         REF      VBIDX,MAREF,NOVF
         REF      LADJ,VPP05,VAM001
         REF      SVARF,GRMVF,VRSAV
         REF      DGSRD,VARF,LITF
         REF      VPLIT,LITVR,VAM50
         REF      SAVV0,FXLIT,ARTHF
         REF      LBLVR,RFLDF,VPP50
         REF      MBS70,CONDF
         DEF      VEXBT,AJAD,VMAD
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
* 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'36'                                                 CBD3
* 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
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
* OP CODES
CCAL1    EQU      X'0400'           CAL1
CLD      EQU      X'1200'                                               C12
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CLI1     EQU      X'2210'           LI,1                                C221
CMI      EQU      X'2300'
CSF      EQU      X'2400'                                               C24
CS       EQU      X'2500'                                               C25
CMTW     EQU      X'3300'
CSTW     EQU      X'3500'           STW                                 C35
CSW      EQU      X'3800'
CLCW     EQU      X'3A00'
CFAS     EQU      X'3D00'
CSTS     EQU      X'4700'           STS                                 C47
CLW      EQU      X'3200'                                               C32
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'
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
CDL      EQU      X'7E00'                                               C795
CPACK    EQU      X'7600'                                               C76
CDA      EQU      X'7900'
CDSA     EQU      X'7C00'
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
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIX     EQU      X'0108'           XREF
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARB     EQU      X'0417'           BRANCH TABLE
DARE     EQU      X'0415'           EXIT TABLE
DARF     EQU      X'41A'            FILE LABEL
DARG     EQU      X'0414'           GLOBAL LITERALS
DARL     EQU      X'0418'           LOCAL LITERALS
DART     EQU      X'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
* DEFINITIONS/DECLARATIONS
DAPI     EQU      X'0341'           INTERNAL LABEL
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
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
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      BBA00
         DEF      BBB00             MOVE-2
         DEF      BBC00
         DEF      BCE00             SET UP/DOWN BY
         DEF      BBB60,BBB62,BBB70,BBB80,BBB88
         DEF      BBC12,BBC20,BBC31
         DEF      BBC33
         DEF      BBC91,BBC92
         DEF      BBE53
         DEF      EBC02,EBC92
*
* LOAD (REGISTER) CLUSTER
*                        R4 = X'5-'-X'C0',(=X'FFFFFF9(CL)')
*                           = X'6-'-X'C0',(=X'FFFFFFA(CL)')
*                           = X'7-'-X'C0',(=X'FFFFFFB(CL)')
BBA00    RES      0
         CI,R4   -X'40'             *****************
         BGZ      BAA02             *******************
         AI,R4    -X'10'            SET DATA/LIT/REG IND.
         LH,V1    4,R5              LOAD DECP
         CI,R6    CRI+X'C'          CHECK FOR INDEX LOAD
         BNE      BBA04             NOT INDEX LOAD
* INDEX LOAD
         LI,V1    0                 CLEAR SUBSCRIPT INFO.
         STH,V1   1,R2
         XW,V1    D1                EXCHANGE SUBF,SUBSCRIPT INFO.(=0)
BBA02    RES      0
         LAB,L0   LRA00,BAA02       LOAD REGISTER
BBA04    RES      0
         CI,V1    X'7FFF'           CHECK DECPS
         BNE      BBA02             NOT.MAX.,- SFLD NOT= FLP
* SFLD = FLP
* *** LOAD BIN ONLY ****************
         BAL,L0   LRA00             LOAD REGISTER
         LI,V0    X'F0'             MASK RREG
         AND,V0   R6
         AI,V0    CAI               FORM AI,RREG
         LI,D1    0
         LAB,L1   PIA02,BAA02       WRITE AI,RREG  0
         TITLE    'PHASE 4.2 - MOVE-2'
*                                                                       76
DABCE    EQU      5                 EXHIBIT
* C:D-D NAME INDEX
XDCD     EQU      8                 DISPLAY CONVERT INDEX
*                        R6 = STMT OPTION(=TYPE INDEX)                   3
*                        R3 = HA(MCBUF)-1
BBB00    RES      0
         CI,R6    1                 CHECK OPTION
         BAZ      BBB20             MOVE TO DATA OPTION
* MOVE DATA/LIT TO MSG AREA                                             10
         MTW,0    VEXBT             FIRST FIELD?
         BNEZ     BEX00             NO
         MTW,1    VEXBT             SET DISPLAY/EXHIBIT FLAG
BEX00    CI,R6    DABCE             CHECK EXHIBIT FLAG
         BNE      BBB02             DOWN. NOT EXHIBIT                   12
* EXHIBIT                                                               13
         BAL,L1   PIA26             WRITE                               14
         LI,V2    C' '              ****     LOAD SPACE                 15
         LI,V0    CSTB+CRV2         LOAD STB,V2                         19
         LH,D3    2,R3              LOAD,CHECK TMP DISPL BA/HA BITS     20
         CI,D3    3                                                     21
         BAZ      BBB01             = 0. NO BA/HA BITS                  22
* BA/HA BIT                                                             23
         AND,D3   K303              MASK BA/HA BITS                     24
         LBAL     PIA22,CLI+CRR1    WRITE LI,R1 BA/HA BITS              25
         BAL,L1   BBAV0
         LI,V0    CSTB+CRV2+CIR1    LOAD STB,V2 -,R1                    26
         LH,D3    2,R3              LOAD TMP DISPL
         B        BBB01+1
BBB01    BAL,L1   BBAV3
         SLS,D3   -2                BA DISPL TO WA                      29
         BAL,L1   PRT22             WRITE STB,V2 TMP(,R1)               30
         MTH,-1   MCBUF+2           DSIZ = DSIZ-1
         MTH,1    2,R3              DISPL = DISPL+1
BBB02    RES      0
         CI,D1    X'10'             CHECK LIT FLAG                      21
         BAZ      BBB03             DOWN. SFLD = DATA                   41
* SFLD = LITERAL                                                        23
         MTW,1    LITF
         BAL,L1   OBS90             CHECK LIT TYPE
         B        BBB10             FIGCON/1 CHAR LIT/ZERO LIT
* LITERAL POOLED
         LH,D1    0,R2              LOAD CLNG,CNTL                      25
* SFLD = DATA/POOLED LITERAL                                            26
*                        D1 = RFLD CLASS                                27
BBB03    RES      0                                                     43
         LI,R7    X'F'              MASK SFLD CLASS                     29
         AND,R7   D1                                                    30
         CI,R7    8                 CHECK SFLD CLASS                    31
         BAZ      BBB08             SFLD = GRP/AN/ND
* SFLD = NC/BIN/FLP                                                     33
         LW,R6    R7                RFLD = SFLD CLASS                   34
         CI,R7    X'C'              CHECK SFLD CLASS                    35
         BL       BBB04             SFLD = NC
* SFLD = INDEX/BIN/FLP                                                  41
         LB,V0    KSTDR-3,R7        LOAD STANDARD BIN/FLP RREG
         BAL,L0   LRD42             LOAD BIN/FLP SFLD                   44
         LH,D3    2,R3              LOAD DISPL                          45
         AW,D3    K6BAS             FORM MSG AREA BASE,DISPL            46
         BAL,L1   PID16             WRITE                               47
         LI,P1    0                 ****  LI,P1 BA(RFLD)                48
         AI,R6    XDCD              SET XREF INDEX                      49
         LAB,L1   PIX02,BAA02       WRITE BAL,L1 C:D-D
* SFLD = NC                                                             50
BBB04    RES      0                                                     51
         LH,V1    4,R5              LOAD DECP
         LBAL,L0  LRD21,8,R6        LOAD NC
         LH,D3    2,R3              LOAD,STORE DISPL
         STH,D3   2,R2
         LI,V1    X'0600'           LOAD,STORE TMP BASE                 59
         STH,V1   2,R5                                                  60
         LI,V1    0                 CLEAR SUBSCRIPT INFO.
         STH,V1   1,R2
         LH,D0    3,R5              LOAD DSIZR,DECPR                    61
         LH,V1    4,R5                                                  62
         LI,R7    6                                                     63
         CI,D1    1                 SIGNED
         BAZ      %+2               NO
         LI,R7    7                 YES
         BAL,L0   MDR02             UNPK/UNPK,MBS  MSG AREA             COBOL42D
         CI,R7    1                 CHECK IF UNSIGNED                   COBOL42D
         BANZ     BAA02             YES RETURN                          COBOL42D
*      THE FOLLOWING CODE GENERATES AN ADDCON FOR TEMP STORAGE          COBOL42D
*   AND LOAD IT IN TO R3 FOR THE BAL TO THE RUN TIME RTN                COBOL42D
*  THE ADDCON IS THE BYTE ADDRESS OF THE SIGN BYTE PLUS 1               COBOL42D
*   IT ALSO CONTAINS A LENGTH OF 3 IN THE HIGH ORDER BYTE    BUT        COBOL42D
*   IT IS NOT USED AND WAS ONLY PUT IN TO AVOID POSSIBLE ERRORS         COBOL42D
         LI,V0    X'0300'                                               COBOL42D
         LH,D3    2,R3          GET TEMP STORAGE DISPL                  COBOL42D
         AH,D3    3,R5          ADD TO IT DECIMAL SIZE                  COBOL42D
         AW,D3    K6BAS                                                 COBOL42D
         BAL,L1   PDD00           CREATE ADDRCON                        COBOL42D
         LBAL     PRA01,CLW+CRR3    GENERATE LW ADDCON                  COBOL42D
         B        BBB0901                                               COBOL42D
* SFLD = GRP/AN/ND                                                      70
BBB08    RES      0                                                     71
         LH,V0    MCBUF+2           LOAD,CHECK BSIZ
         CI,V0    1
         BE       BBB18             BSIZ = 1
* BSIZ > 1
         CI,R7    6                CHECK IF SIGNED DISPLAY              COBOL42D
         BNE      %+2                                                   COBOL42D
         AI,V0    -1               REDUCE LENGTH BY 1 FOR (SIGN)        COBOL42D
         SLS,V0   8                 POSITION BSIZ
         LH,D3    2,R3              LOAD BASE,DISPL                     72
         AW,D3    K6BAS
         BAL,L1   PDD00             WRITE ADCON BSIZ,BA(MSG AREA)       77
         LBAL     PRA01,CLW+CRR3    WRITE LW,RO ADCON                   78
*                                                                       80
         BAL,L1   SSS00             CHECK SUBSCRIPTS                    82
         AI,V0    CMBS-CLI+X'F0000' RAISE SUBSCRIPT FLAG
         AI,V0    CLI               FORM  LI,R2 -                       86
         BLZ      BBB09             SUBSCRIPTED
         BAL,L1   PID10             WRITE LI,R2 BA(SFLD)                87
         BAL,L1   BBAV1
         AI,V0    CMBS-CLI          FORM MBS,R2                         88
         CI,R7    6                 CHECK IF SIGNED                     COBOL42D
         BE       %+3               YES BRANCH                          COBOL42D
         LI,L1    BAA02             SET UP TO RETURN                    COBOL42D
         B        %+2                                                   COBOL42D
         LI,L1    BBB0901           SET TO GENERATE BAL TO RUN TIME RTN COBOL42D
BBB07    RES      0                                                     COBOL42D
         LI,D1    0                                                     COBOL42D
         B        PIA02             WRIT  MBS,R2  0                     COBOL42D
* SUBSCRIPTED                                                           90
BBB09    RES      0
         BAL,L1   BBAV1
         CI,R7    6                 CHECK IF SIGNED                     COBOL42D
         BE       %+3               YES BRANCH                          COBOL42D
         LI,L1    BAA02             SET UP TO RETURN                    COBOL42D
         B        %+2                                                   COBOL42D
         LI,L1    BBB0901         SET TO GENERATE BAL TO RUN TIME RTN   COBOL42D
         MTW,0    LNKSF             IN LINKAGE SECTION                  COBOL42D
         BNEZ     BBB07                                                 COBOL42D
         B        PID10             WRIT MBS,R2  BA(SFLD)               COBOL42D
BBB0901  BAL,L1   PIX06             GENERATE  BAL,L1  C:MSB             COBOL42D
         TEXT     ':MSB'                                                COBOL42D
         B        BAA02                                                 COBOL42D
BBAV0    RES      0
         MTW,0    VEXBT+1
         BGEZ     *L1               NO VAR LNTH
         LCI      8
         STM,V0   MSGREG            SAVE REGISTERS
         LW,D1    AJAD              ADCON FOR VAR REC
         LBAL     PRA01,CSW+CRR1    **** WRITE SW,R1  (AJAD)
         B        BBAV2
BBAV1    RES      0
         MTW,0    VEXBT
         BEZ      *L1               NOT VAR REC
         LCI      8
         STM,V0   MSGREG            SAVE REGISTERS
         MTW,0    LITF
         BEZ      BBAV11
         LI,V0    0
         STW,V0   VARF
         B        BBAV12
BBAV11   LI,V0    R3
         BAL,L0   VPP05
BBAV12   MTW,0    VEXBT+1           PREVIOUS VAR REC FLAG
         BEZ      BBAV13
         MTW,0    VEXBT+2
         BNEZ     BBAV13            FIRST VAR LNTH
         LW,D1    AJAD              ADCON FOR VAR REC
         LBAL     PRA01,CSW+CRR3    **** WRITE SW,R3  (AJAD)
BBAV13   LW,D1    VARF
         BGEZ     BBAV2             NOT VAR LNTH
         BAL,L1   PIA06
         LW,V0    0,R7              **** WRITE LW,V0  0,R7
         LW,D1    AJAD
         MTW,0    VEXBT+2
         BNEZ     BBAV14            FIRST VAR LNTH
         LBAL     PRA01,CAWM+CRV0   **** WRITE AWM,V0 (AJAD)
         B        BBAV2
BBAV14   RES      0
         LBAL     PRA01,CSTW+CRV0   **** WRITE STW,V0  (AJAD)
         MTW,-1   VEXBT+2
BBAV2    LCI      8
         LM,V0    MSGREG            RECOVER REGISTERS
         B        *L1
BBAV3    RES      0
         MTW,0    VEXBT+1
         BEZ      *L1               NOT VAR REC
         LCI      8
         STM,V0   MSGREG            SAVE REGISTERS
         LW,D1    AJAD
         LBAL     PRA01,CLCW+CRR1   **** WRITE LCW,R1 (AJAD)
         LCI      8
         LM,V0    MSGREG            RECOVER REGISTERS
         AI,V0    CIR1              -(,SXR)
         B        *L1
* MOVE 1 CHAR. LIT/ZERO LIT                                              1
*                        D2 = DSIZ,0 IF ZERO LIT OR                      2
*                           = 0,- IF FIGCON/(ALL) 1 CHAR.LIT             3
BBB10    RES      0                                                      4
         LH,D3    2,R3              LOAD,FORM MSG BASE,DISPL             5
         AW,D3    K6BAS                                                  6
         CI,D2    X'FFFF'           CHECK FOR DSIZ,0                     7
         BANZ     BBB14             NO. FIGCON/(ALL) 1 CHAR. LIT         8
* ZERO LIT                                                               9
         BAL,L1   PDD02             WRITE ADCON DSIZ,BA(MSGAREA)        10
         LBAL     PRA01,CLW+CRR1    WRITE LW,R1 ADCON                   11
         BAL,L1   BBAV0
         LI,R1    0                 RESET RPT CNT                       12
         LAB,L0   NDF00,BAA02       WRITE MBS,0 BA(D'0')                13
* FIGCON/(ALL) 1 CHAR. LIT                                              14
* **                     V2 = CHAR                                      15
BBB14    RES      0                                                     16
         CI,D3    3                 CHECK FOR WORD BOUNDARY             17
         BANZ     BBB16             NO. NOT ON WORD BOUNDARY            18
* ON WORD BOUNDARY                                                      19
         LI,V0    CSTB+CRV2
         BAL,L1   BBAV3
         BAL,L1   PID11             **** WRITE STB,V2  WA(MSG ARA)
         B        BAA02             RETURN                              22
* NOT ON WORD BOUNDARY                                                  23
BBB16    RES      0                                                     24
         BAL,L1   PID16             WRITE                               25
         LI,R1    0                 ****  LI,R1 BA(MSG AREA)            26
         BAL,L1   BBAV0
         BAL,L1   PIA06             WRITE                               27
         STB,V2   0,R1              ****     STORE CHAR.                28
         B        BAA02             RETURN                              29
*                                                                       95
* MOVE 1 CHAR. GRP/AN/ND FLD
BBB18    RES      0
         BAL,L1   SSB00             CHECK SUBSCRIPTS
         AI,V0    CLB+CRV2          SET LB,V2 (,SXR)
         BAL,L0   VPP30             VAR REC ADDR
         LB,R1    D3                                                    COBOL42D
         CW,R1    K3FF              SEE IN LINKAGE ITEM                 COBOL42D
         BNE      BBB19             NO                                  COBOL42D
         LI,D3    0                 RESET REGISTER                      COBOL42D
         BAL,L1   PIA22             WRITE LB,V2  0(,SXR)                COBOL42D
         B        BBB19A                                                COBOL42D
BBB19    EQU      %                                                     COBOL42D
         BAL,L1   PID11             WRITE LB,V2 SFLD(,SXR)
BBB19A   RES      0                                                     COBOL42D
         BDR,D2   BBB10             WRITE STB,V2 MSGAREA
*
* MOVE TO DATA NAME                                                     96
BBB20    RES      0
         BL       BBB30             READ INTO                            1
* ACCEPT                                                                 2
         LH,V1    MCBUF+2           LOAD DSIZ                            3
         LW,D3    KMSG              LOAD REPLY BASE,DISPL-1              4
         MTW,1    JSXR              SXR = SXR+1                          5
         LI,R7    X'F'              MASK,CHECK ACFLD CLASS               6
         AND,R7   D1                                                     6
         CI,R7    8                                                      6
         BGE      BBB24             NUMERIC                              7
* ACFLD = AN                                                             8
         AI,D3    1                 REPLY DISPL = REPLY DISPL+1          9
         BAL,L1   PID16             WRITE                               13
         LI,R2    0                 ****  LI,R2 BA(REPLY)               14
         BDR,V1   BBB22             DSIZ = DSIZ-1                       11
* DSIZ = 1                                                              12
         BAL,L1   SSB00             CHECK SUBSCRIPT                     15
         BAL,L1   PIA06             WRITE                               16
         LB,R4    0,R2              ****     LOAD ACCEPT CHAR.
         BAL,L1   PRT06             WRITE RLNG CHECK
         LB,L1    DTWA
         BAL,L1   PIL06
         BNEZ     2
         BAL,L1   PIA06
         LI,R4    X'40'
         AI,V0    CSTB+CRR4         FORM STB,R4 -(,SXR)                 18
         BAL,L0   VPP30             VAR REC ADDR
         LI,L1    BAA02                                                 COBOL42D
         B        MDF65             WRITE STB,R4  ACFLD/0,(,SXR)        COBOL42D
* DSIZ > 1                                                              20
BBB22    RES      0                                                     21
         LBAL,L0  NDR31+1,CRR3      CHECK SUBSCRIPTS
*                                   WRITE ADCON DSIZ,BA(ACFLD)          23
*                                   ****  LW/AW,R3 ADCON                24
         LI,V0    R3
         BAL,L0   VPP00             RESOLVE VAR REC
         BAL,L1   PIA06             WRITE                               25
         MBS,R2   0                 ****     MBS TO ACFLD               26
         B        BAA02             RETURN                              27
* ACFLD = N                                                             30
BBB24    RES      0                                                     31
         CI,V1    1                 CHECK DSIZ                          32
         BANZ     BBB26             ODD                                 33
* DSIZ EVEN                                                             34
         STW,V1   JDSIZ             STORE DSIZ                          32
         BAL,L1   PIA06             WRITE
         LI,V2    X'F0'             ****     LOAD D'+0'                 36
         BAL,L1   PID16             WRITE                               37
         STB,V2   2                 ****  STB,V2 REPLY
         AI,V1    1                 DSIZ = DSIZ+1                       39
         LAB,V0   BBB28,0                                               41
* DSIZ ODD                                                              42
BBB26    RES      0                                                     43
         AI,D3    1                 REPLY DISPL = REPLY DISPL+1         44
         BAL,L1   PID16             WRITE                               45
         LI,R2    0                 ****  LI,R2 BA(REPLY)               46
         LI,V0    CIR2              LOAD XR2                            47
         LI,D3    0                 CLEAR BASE,DISPL                    48
BBB28    RES      0                                                     50
         MTW,1    NOVF              SET FLAG
         BAL,L1   ORD12             WRITE PACK,L REPLY/0,R2             51
         LH,V1    4,R5              LOAD,STORE DECP(=DECPR)             52
         STW,V1   JDECP                                                 53
         LI,R6    8                 SFLD CLASS = NC                     54
         LAB,L0   LDR20,BAA02       STORE N                             55
* READ INTO                                                              0
*                        D1 = BASE                                       1
BBB30    RES      0                                                      2
         LI,D3    0                 FORM BASE,DISPL(=0)                  3
         STW,D3   SVARF
         LI,V0    -1
         STW,V0   MAREF
         STH,D1   D3                                                     4
         STW,D3   JSFLD             STORE BASE,DISPL
         LI,V0    CRR2              LOAD SXR                             5
         LH,D0    MCBUF+2           LOAD RSIZ
         BAL,L1   GRPMV
         LAB,L0   MBS02,BAA02       MOVE TO INTO FLD                     7
* CHECK,SET NLIT CONVERSION CODE
*                        D1 = RFLD TYPE BITS
BBB60    RES      0
         CI,D1    X'1000'           CHECK FLL TYPE BIT                  21
         BANZ     BBB61             SET FLL RFLDS
* NO FLL RFLDS                                                          141
         LI,R6    X'D'              SET SFLD CLASS TO BIN               15
         CI,D1    X'0800'           CHECK FLS TYPE BIT                  23
         BAZ      *L1               NOT SET. BIN ONLY.
         AI,R6    1                 SET SFLD CLASS TO FLS               18
         CI,D1    X'0600'           CHECK BIN(,INDEX) TYPE BITS
         BAZ      *L1               NOT SET. FLS ONLY.
* FLL/BIN,FLS RFLDS                                                     21
BBB61    RES      0
         LI,R6    X'F'              SET SFLD CLASS TO FLL               23
         B        *L1               RETURN
*                                                                        0
* SET NLIT SFLD TYPE CODE
BBB62    RES      0                                                      5
         LH,R6    0,R2              LOAD,CHECK NLIT CLASS                6
         AND,R6   K30F
         LB,R6    KSTYP-3,R6
         B        *L1                                                   10
*                        R6 = SFLD TYPE                                 11
*                                                                       99
* SAVE SET SFLD PARAMETERS
BBB68    RES      0                                                     14
         LH,D0    3,R5              LOAD,SAVE DSIZ
         STW,D0   JDSIZ
         LH,V1    4,R5              LOAD,SAVE DECP
         STW,V1   JDECP
*                        V0 = SUBSCRIPT FLAG
*                        D1 = BA,HA BITS
*                        D3 = BASE,DISPL
BBB69    RES      0                                                     16
         STW,D3   JSFLD             SAVE SFLD BASE,DISPL
         STW,V0   JSFLDS            SAVE SUBSCRIPT FLAG
         LI,D0    0                 CLEAR M(OVED) BS CNT
         STW,D0   JMBSIZ
         XW,D0    LNKSF                                                 COBOL42D
         STW,D0   SLNKF             SAVE SFLD LINKAGE FLAG              COBOL42D
         LH,D0    3,R2              LOAD,SAVE BSIZS                     23
         STW,D0   JBSIZ                                                 24
         B        *L1               RETURN
*                        V1 = DECP
*                        D0 = BSIZ
*
* CHECK,RESET/SET DECA SAVE FLAG
*                        R1 = RFLD TYPE(I)                               1
*                        R6 = SFLD TYPE                                  2
BBB70    RES      0
         LB,V0    MCBUF             LOAD NREF
         LW,V1    JSAVD             LOAD DECA SAVE FLAG                  2
*                        R3 = NREF(I)                                   64
*                        V0 = NREF                                       3
*                        V1 = DECA SAVE FLAG                             4
BBB72    RES      0
         CI,R1    DJAFL             CHECK I                             13
         BGE      BBB76             I NOT= ASCENDING/DESCENDING         14
* I = ASCENDING/DESCENDING                                              15
BBB73    RES      0
         CI,R3    1                 CHECK NREF(I)                        5
         BE       BBB74             = 1, SINGLE RFLD
* SAVE CURRENT DECA                                                      7
         AI,V1    -X'10000'         RAISE CURRENT DECA SAVE FLAG
BBB74    RES      0
         CI,V0    1                 CHECK NREF                          10
         BE       BBB77             = 1, LAST I                         11
* NREF > 1, NOT LAST I                                                  12
BBB75    RES      0                                                     16
         CI,V1    DSG               CHECK DECA SAVED FLAG               17
         BANZ     BBB78             UP.                                 18
* SAVE ORIGINAL DECA                                                    19
         AI,V1    -X'50000'         RAISE ORIGINAL DECA SAVE FLAG        4
         B        BBB78                                                 201
BBB76    RES      0                                                     21
         CI,R1    DJAN              CHECK I                             22
         BE       BBB73             I = AN
         CI,R1    DJAG
         BE       BBB73             I = GRP
* I = BIN/FLP                                                           24
BBB77    RES      0                                                     25
         CI,V1    DSG               CHECK DECA SAVED FLAG               13
         BAZ      BBB78             DOWN. DECA NOT SAVED                27
         AI,V1    -DSG              LOWER DECA SAVED FLAG
BBB78    RES      0                                                     29
         STW,V1   JSAVD             STORE DECA SAVE FLAG                30
         B        *L1                                                   31
*                        = -X'10000'  IF SAVE CURRENT ONLY               6
*                        = -X'50000'   IF SAVE ORIGINAL ONLY             7
*                        = -X'60000'   IF SAVE CURRENT AND ORIGINAL      8
*
* CHECK,ADJUST DISPL/SXR
BBB80    RES      0
         LI,R4    1                 SET EXECUTE INDEX
         LCW,D3   JMBSIZ            LOAD,CHECK -MBSCNT                  21
         BEZ      *L0               = 0, NO SFLD DISPL CHANGE
* NOT= 0, SFLD.DISPL/SXR CHANGED                                        23
*                        V0 = SXR(=R2)                                  27
         AWM,D3   JMBSIZ            CLEAR MBSCNT
         LW,V0    JSFLDS            LOAD,CHECK SUBSCRIPT FLAG
         BGEZ      *L0             DOWN. RETURN.
* SUBSCRIPTED
         MTW,0    LITF
         BNEZ     BBB81             LIT SFLD
         LW,R4    SVARF                                                 COBOL42D
         BEZ      BBB83             NO VAR LENGTH                       COBOL42D
         CI,R4    -2                                                    COBOL42D
         BE       BBB82                                                 COBOL42D
         MTW,-1   SVARF             RESET VAR REC                       COBOL42D
         BEZ      BBB83             VAR ADDR ONLY                       COBOL42D
         B        BBB82             VAR LENGTH                          COBOL42D
BBB81    MTW,0    VARF
         BGEZ     BBB83             NO VAR LNTH
BBB82    AI,V0    CSW
         LI,D1    L0
         BAL,L1   PIA02             **** WRITE SW,SXR  L0
         B        BBB84
BBB83    AI,V0    CAI+X'F'          FORM AI,SXR -(MBS CNT)
         BAL,L1   PIA22             WRITE AI,SXR -MBS CNT               29
BBB84    LI,R4    2
         B        *L0               RETURN                              42
*
* CHECK,SAVE DECA
BBB88    RES      0
         LW,V0    JSAVD             CHECK DECA SAVE FLAG
         BGEZ     *L0               DOWN, DECA SAVE UNNECESSARY
* SAVE DECA
         AI,V0    X'50000'          CHECK CURRENT DECA SAVE,ONLY        10
         BGZ      BBB89             YES. CURRENT DECA ONLY
* SAVE DECA FOR NEXT I
         BAL,L1   PRT26             WRITE
         DST,0    DTD4              *- *  DST,0 DECA SAVE AREA
         STW,V1   BBCSAV+1          SAVE ORIGINAL DECP,DSIZ
         STW,D0   BBCSAV+2
         AI,V0    DSG               RAISE DECA SAVED FALG
         BGZ      BBB89             SAVE ORIGINAL DECA ONLY
* SAVE CURRENT DECA
         AI,V0    X'50000'          RAISE CURRENT DECA SAVE FLAG
BBB89    RES      0
         STW,V0   JSAVD             STORE SAVE DECA FLAG
         B        *L0               RETURN
*                                                                        0
* ZERO/BLANK FILL - MULTIPLE RFLDS                                       1
BBB90    RES      0                                                      2
         LI,R1    1                 RFLD TYPE INDEX(I) =1(=GRP/AN)       3
         LI,R4    5                 NREF = 5                             4
BBB91    RES      0                                                      5
         LH,R3    MCBUF,R1          LOAD,CHECK NREF(I)                   6
         BNEZ     BBB93             NOT= 0, TYPE I RFLDS PRESENT         7
* = 0, NO TYPE I RFLDS                                                   8
BBB92    RES      0                                                      9
         AI,R1    1                 I = I+1                              9
         BDR,R4   BBB91             NREF = NREF-1                       10
         B        BAA02             NREF = 0, E-O-MOVE                  11
* ZERO/BLANK FILL TYPE I RFLDS                                          12
BBB93    RES      0                                                     13
         STH,R1   MCBUF             SAVE I,NREF                         14
         STH,R4   MCBUF,R3                                              15
*                        R1 = I                                         16
*                        R3 = NREF(I)                                   17
BBB94    RES      0                                                     18
         BAL,L0   EBB90-1,R1        ZERO/BLANK FILL TYPE I RFLD         19
         LH,R1    MCBUF             LOAD I                              20
         BDR,R3   BBB94             NREF(I) = NREF(I)-1                 21
* NREF(I) = 0, E-O-TYPE I RFLDS                                         22
         LH,R4    MCBUF,R1          LOAD NREF                           23
         B        BBB92                                                 24
* ZERO/BLANK FILL - RFLD TYPE
EBB90    RES      0
         B        MDF21             NC/NE
         B        MDF21             ND
         B        MDF61             BIN
         B        MDF01             AN/ANE
         B        MDF01             GRP
*
         TITLE    'PHASE 4.2 - MOVE-1'
* MOVE
*
* DATA CLUSTER CLNG,CNTL EQUIVALENCES
CJIFC    EQU      X'0390'           FIGCON
CJINC    EQU      X'0988'           NC
* SFLD TYPES                                                            ADG 0
CJUN     EQU      -9                UNKNOWN
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
* 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
GRPMV    STW,L1   TMPL1
         LH,L1    3,R2              GET RFLD LNTH
         CI,L1    255
         BG       %+2
         LI,L1    0
         STW,L1   RLNTH             RLNTH FLAG
         B        *TMPL1
RRFLD    STW,L0   TMPV0
         BAL,L1   BAA46             SAVE VAR FLAG
         BAL,L1   GRPMV
         B        *TMPV0
*                        R6 = SFLD TYPE
BBC00    RES      0
         LI,R7    0
         STW,R7   MDBUF-1           RESET UP/DOWN FLAG                  COBOL42D
         STW,R7   LADJ
         STW,R7   CONDF
         STW,R7   RLNTH
         STW,R7   DGSRD
         STW,R7   MAREF             RESET GROUP MOVE FLAG
         LH,R7    0,R2              LOAD, MASK SFLD CLASS
         AND,R7   K30F
         STW,R7   JSET              SET TO
         CI,R7    X'C'              CHECK SIGNED FIELDS
         BG       BBC01             SFLD = BIN/FLP
         BE       BBC01-1           SFLD = INDEX - UNSIGNED
         CI,R7    1                 CHECK UNSIGNED FLAG
         BAZ      BBC01             DOWN. SIGNED
* SFLD UNSIGNED
         LI,R7    X'10000'          LOAD UNSIGNED FLAG
BBC01    RES      0
         STW,R7   JUNSD             STORE UNSIGNED FLAG
*                        R1 = CLNG                                       1
* *** CLNG IDENTIFIES MOVE TYPE
         CI,R1    9                 CHECK CLNG                           3
         BG       BBE30             N/AN SFLD, MULTIPLE RFLDS
*                                                                        5
         EXU      EBC00-4,R1        EXECUTE ON CLNG                      6
* SINGLE RFLD
*                        R6 = SFLD TYPE
*                        D1 = RFLD TYPE
         LW,R1    D1                LOAD RFLD CLASS                     10
         CI,D1    DJAG              CHECK RFLD CLASS                    11
         BG       EBB90-6,R1        ZERO/BLANK FILL                     12
* NOT ZERO/BLANK FILL
         BL       EBC02+3,R6        NOT GRP, BRANCH ON SFLD TYPE        14
* RFLD = GRP                                                            19
         EXU      EBC04+3,R6        EXECUTE ON SFLD TYPE
* SFLD = INDEX/BIN/FLP
         LI,L0    BBC08             SET LINK REGISTER
         MTW,15   JSXSX             SET GRP SWITCH
* SFLD = GRP
*                        R1 = RFLD TYPE
*                        L0 = LINK REGISTER
BBC04    RES      0
         STW,L0   BBCSAV            SAVE LINK REGISTER
         BAL,L1   SSS00             CHECK SUBSCRIPTS
         AI,V0    CSXR              RAISE SUBSCRIPT FLAG                 3
         STB,R7   BBCOSI                                                COBOL42D
         BAL,L1   BBB68             SAVE SFLD PARAMETERS                21
BBC06    RES      0
*                        D0 = BSIZS
         BAL,L0   RRFLD
         BAL,L0   MBS01             MOVE GRP TO GRP
         B        *BBCSAV           RETURN
* GRP RFLD RETURN                                                       34
BBC08    RES      0
         MTW,1    JSXSX             RESET GRP SUBSCRIPT SWITCH
         B        *BBCSAV+1         RETURN
* CLNG
EBC00    RES      0
         LI,L0    BAA02             SINGLE RFLD - SET LINK REGISTER
         B        BBE00             GRP MOVE
         B        BBE20             ANLIT/FIGCON
         B        BBB90             ZERO/BLANK FILL
         B        BBE10             ZERO/ZERO LIT
* SINGLE RFLD - SFLD TYPE
EBC02    RES      0
         B        BBC20             AN LIT/FIGCON
         B        BBC04             GRP
         B        BBC30             AN
         B        BBC70             NC
         B        BBC50             ND
         B        BBC84             FLL
         B        BBC80             FLS
         B        BBC90             BIN
         B        BBC88             INDEX
         B        BBC60             NLIT
         B        BBC10             ZER/ZERO LIT
* SINGLE RFLD = GROUP - SFLD
EBC04    RES      0
         B        BBC20             ANLIT/FIGCON
         B        BBC04             GRP
         B        BBC04             AN
         B        BBC04             NC
         B        BBC04             ND
         STW,L0   BBCSAV+1          FLL
         STW,L0   BBCSAV+1          FLS
         STW,L0   BBCSAV+1          BIN
         STW,L0   BBCSAV+1          INDEX
         B        BBC59             NLIT
         B        BBC12             ZERO/ZERO LIT
*
* SFLD = ZERO/ZERO LIT                                                   1
*                        R1 = RFLD TYPE
*                        L0 = LINK REGISTER
BBC10    RES      0                                                      3
         CI,R1    1                 CHECK RFLD TYPE
         BLE      BBC12             RFLD = GRP/AN
         STW,L0   BBCSAV            SAVE LINK REGISTER
         MTW,1    LITF
* RFLD NUMERIC
BBC11    RES      0
         BAL,L1   BAA46             SAVE VAR FLAG
         EXU      EBC10-2,R1        EXECUTE ON RFLD TYPE
         B        *BBCSAV           RETURN
* SFLD = ZERO/ZERO LIT - RFLD TYPE
EBC10    RES      0
         BAL,L0   MDF21             NC/NE
         BAL,L0   MDF61             FLL
         BAL,L0   MDF61             BIN/FLS
*                                                                       33
* RFLD = AN/GRP                                                          2
BBC12    RES      0                                                     11
         MTW,1    LITF
         AW,R2    R2                HA(CLOC) TO BA                       4
         LB,D0    1,R2              LOAD FIGCON INDEX(=0)/0 CNT          5
         LW,D3    K4BAS             LOAD ZERO BASE,DISPL                 6
*                                                                        7
* SFLD = FIGCON/ZERO LIT/ALL'1CHAR'                                      8
*                        D0 = DSIZS(=0 IF ALL/FIGCON)                    9
*                        D3 = SFLD BASE,DISPL                           10
BBC14    RES      0                                                     14
         STW,L0   BBCSAV            SAVE LINK REGISTER
         STW,D3   JSFLD             SAVE SFLD BASE,DISPL
         STW,D0   JBSIZ             SAVE BSIZS
BBC16    RES      0                                                     24
         BAL,L0   RRFLD
         LH,R7    0,R2              LOAD,MASK RFLD CLASS                16
         AND,R7   K30F                                                  17
* *** CONDITION ENTRY CHECK ********                                     1
         CWF      BCA12             CHECK CONDITION FLAG                 2
* ** SFLD = ZERO/ZERO LIT/FIGCON/ALL '1 CHAR' ANLIT                      4
         EXU      EBC14,R7          EXECUTE ON RFLD CLASS
         B        *BBCSAV           RETURN
* SFLD = ZERO/ZERO LIT - RFLD CLASS
EBC14    RES      0
         BAL,L0   MBS42             GRP
         BAL,L0   MBS42             AN
         BAL,L0   MBS42             ANJR
         BAL,L0   MBS62             ANE
         BAL,L0   MBS62             ANEJR
*
* SFLD = ANLIT/FIGCON                                                  1
BBC20    RES      0                                                    2
         MTW,1    LITF
         LH,D0    0,R2              LOAD,CHECK SFLD TYPE               3
         CI,D0    1
         BANZ     BBC26             SFLD = (ALL) ANLIT
*
* SFLD = FIGCON/ALL'1 CHAR' LIT                                         30
BBC22    RES      0
         AI,D0    -CJIFC            CHECK CLNG,CNTL
         BEZ      BBC23             SFLD = FIGCON
* SFLD = ALL'1 CHAR' LIT                                                34
         LI,D0    0                 DSIZS = 0                           35
         LAB,L1   LIT00,BBC14       POOL LITERAL                        36
*                        D3 = LITERAL BASE,DISPL                        37
*                                                                       38
* SFLD = FIGCON                                                         39
BBC23    RES      0
         AW,R2    R2                HA(CLOC) TO BA                      40
         LB,D3    1,R2              LOAD FIGCON INDEX                   41
         AW,D3    K4BAS             FORM FIGCON BASE,DISPL              42
         B        BBC14                                                 43
*                        D0 = 0                                         44
*                        D3 = FIGCON BASE,DISPL                         45
*                                                                       29
* SFLD = ANLIT
BBC26    RES      0                                                     31
         CI,D0    2                 CHECK ANLIT TYPE
         BAZ      BBC28             SFLD = ANLIT, NOT 'ALL'
* SFLD = ALL ANLIT
         BAL,L1   LIT00             POOL LITERAL
         LH,D0    3,R2              ALL 'ANLIT' FLAG = BSIZS
         STW,D0   JSALL
         MTH,3    BCASI             SET ALL '>1 CHAR.' SFLD CODE
         B        BBC30
*
* SFLD = ANLIT
BBC28    RES      0
         MTH,2    BCASI             SET AN SFLD CODE
         BAL,L1   LIT00             POOL ANLIT
         LH,D0    3,R2              LOAD BSIZS
* SFLD = AN/AN LIT(POOLED)                                               0
*                        R1 = RFLD TYPE
*                        L0 = LINK REGISTER
BBC30    RES      0                                                      2
* *** CONDITION ENTRY CHECK ********                                     7
         CWF      BBC31             CHECK CONDITION FLAG                 7
         CI,R1    DJAN
         BL       BBC48             RFLD = NUMERIC, SFLD = NDU           4
         LI,V1    1                                                     COBOL42D
* RFLD = AN/ANE                                                          5
BBC31    RES      0                                                      9
         STB,V1   BBCOSI                                                COBOL42D
         BAL,L1   SSS00             CHECK SUBSCRIPTS                    10
         AI,V0    CSXR              RAISE SUBSCRIPT FLAG                 9
         BAL,L1   BBB68             SAVE SFLD PARAMETERS
         MTH,4    JCSAV             RAISE AN USAGE FLAG
*
*                        L0 = LINK REGISTER
BBC32    RES      0                                                     21
         STW,L0   BBCSAV            SAVE LINK REGISTER
         BAL,L0   RRFLD
BBC33    RES      0
         LH,R4    0,R2              LOAD,MASK RFLD CLASS
         LI,R7    X'F'
         AND,R7   R4
         CI,R4    X'10'             CHECK LIT FLAG
         BAZ      BBC34             DOWN. DATA.
         MTW,1    LITF
* LIT/FIGCON
* *** MUST BE LIT/FIGCON OBJECT*****
         BAL,L1   OCB30             CHECK LIT TYPE
* *** ANLIT RETURN ONLY ************
         BAL,L1   LIT00             POOL LIT
         B        BBC33
BBC34    RES      0                                                   11
         LH,V1    3,R5              LOAD DSIZR                          01
         CI,R7    3                 CHECK RFLD CLASS
         BL       BBC40             RFLD = GRP/AN/ANJR                  03
* *** CONDITION ENTRY CHECK ********
         CWF      BBC39             CHECK CONDITION FLAG
* ***  SFLD = AN, RFLD = ND - CBS ***
*
* RFLD = ANE/ANEJR
         BAL,L0   NDR31             WRITE ADCON BSIZR,BA(RFLD)         1
*                                   ****  LW/AW,RO ADCON               2
         BAL,L0   NDR40             MOVE EDIT MASK                     3
*                        R7 = RFLD CLASS                               4
*                        V1 = BSIZR                                    5
*                        D0 = BSIZS                                    6
         CI,R7    4                 CHECK RFLD CLASS                   7
         BANZ     BBC35             RFLD = ANEJR                       8
* RFLD = ANE                                                           9
         LCW,D0   D0                BSIZS = -BSIZS                    10
BBC35    RES      0
         BAL,L1   ODR34                                               12
*                        R1 = EGRPCNT                                 13
*                        R5 = EMDLOC                                  14
*                        V1 = DSIZR(ADJUSTED)                         15
*                        D0 = SFLD PAD                                16
*                        D1 = -BSIZR                                  17
         LW,D3     JSFLD           LOAD SFLD BASE,DISPL
         LW,D0    JPSIZ             LOAD,CHECK PSIZ
         BLEZ     BBC36             </= 0, NO LEFT TRUNCATION
* > 0, LEFT TRUNCATION OF SFLD
         AW,D3    D0                SFLD DISPL = SFLD DISPL+PSIZ
BBC36    RES      0
         AWM,V1   JMBSIZ            MBS CNT = MBS CNT+DSIZR
         LW,V0    JSFLDS            LOAD,CHECK SUBSCRIPT FLAG         21
         BLEZ     BBC38             UP. SFLD SUBSCRIPTED.
* SFLD NOT SUBSCRIPTED                                                23
         BAL,L0   NDR38             WRITE LI,RE  BA(SFLD)
*                                   ****  MBS,RE 0  TO ANE RFLD
         B        *BBCSAV           RETURN
*                                                                     19
* SFLD SUBSCRIPTED                                                    40
* **                     R2 = SUBSCRIPT VALUE                         41
BBC38    RES      0
         BAL,L1   PIA06                                                 COBOL42D
         LW,RE    R2                ****     RE = SUBSCRIPT           43
         BAL,L0   NBS62             WRITE
         MBS,RE   0                 ****  MBS,RE BA(SFLD)  TO ANE RFLD
         B        *BBCSAV           RETURN
*                                                                       29
* RFLD = ND/NC
BBC39    RES      0
         MTW,1    JSXR              SET SXR FOR RFLD
         LBAL,L0  NCB40,0,V1        NUMERIC (/EXPRESSION) TO AN         COBOL42D
         MTW,-1   JSXR              RESET SXR
         LI,R7    1                 RFLD CLASS = AN
         LW,D0    JBSIZ             LOAD BSIZS
         LH,V1    3,R5              LOAD DSIZR
*                        R1 = RFLD TYPE(=AN)
*                        R7 = RFLD CLASS(=AN)
*                        V1 = DSIZR
* RFLD = GRP/AN/ANJR                                                    30
BBC40    RES      0                                                     31
         LW,D1    JSALL             CHECK ALL'ANLIT' FLAG(=ALLSIZ)      31
         BEZ      BBC42             = 0, SFLD NOT= ALL 'ANLIT'          32
* SFLD = ALL 'ANLIT'                                                    33
         CW,V1    JSALL             COMPARE DSIZR,ALL 'ANLIT' BSIZ      34
         BLE      BBC42             </=, ALL MOVE NOT REQUIRED          35
* ALL 'ANLIT' MOVE                                                      36
         LW,D0    V1                SAVE DSIZR                          37
         SW,D0    D1                DSIZR = DSIZR-BSIZS                 38
         CI,R7    2                 CHECK RFLD CLASS
         BNE      BBC41             RFLD NOT= ANJR
* RFLD = ANJR
* *** MOVE ONLY, NOT CONDITION******
         LI,V0    0                 CLEAR RE
         DW,V0    D1                OBTAIN,CHECK MOD(BSIZR,ALLSIZ)(R)
         CI,V0    0
         BEZ      BBC41             = 0, BSIZR = EVEN MULTIPLE OF ALLSIZ
* NOT= 0, BSIZR NOT= EVEN MULTIPLE OF ALLSIZ
         SW,D0    V0                DSIZR = DSIZR-R
         AWM,V0   JMBSIZ            MBS CNT = MBS CNT+R
         LW,V1    V0                LOAD R
         LW,D3    D1                LOAD ALLSIZ
         SW,D3    V0                ALLSIZ = ALLSIZ-R
         LBAL     PIA22,CLI+CRR2    WRITE LI,R2 ALLSIZ-R
         LBAL,L0  NDR32,CRR3        WRITE ADCON R,BA(RFLD)
*                                   ****  LW/AW,R3 ADCON
         BAL,L1   MVLIT
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         BAL,L1   PID16             WRITE
         MBS,R2   0                 ****     MBS R BYTES
         LW,D3    JSALL             LOAD ALLSIZ
         MTW,0    VARF
         BLZ      BBC401            VAR LNTH
         LBAL     PIA22,CLI+CRV2    WRITE LI,V2 ALLSIZ
         BAL,L1   PIA26             WRITE
         STB,V2   R3                ****     ALLSIZ TO RO
BBC401   LW,V1    JSALL             LOAD ALLSIZ
         B        BBC411
BBC41    RES      0
         LW,V1    D1                LOAD ALLSIZ                         39
         LBAL,L0  NDR32,CRR3        WRITE ADCON ALLSIZ,BA(RFLD)
         BAL,L1   MVLIT
BBC411   RES      0
*                                   ****  LW,R3 ADCON                   41
*                        VI = ALLSIZ
*                        D0 = BSIZR(ADJUSTED)
         AWM,V1   JMBSIZ            MBS CNT = MBS CNT+ALLSIZ
         BAL,L1   PIA26             WRITE                               11
         LI,R2    0                 ****     RE = 0                     12
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL                42
         XW,V1    D0                EXCHANGE ALLSIZ,DSIZR(-ALLSIZ)       1
* *** CONDITION ENTRY CHECK ********                                    15
*                        R7 = RFLD CLASS                                15
         CWF      BCA20             CHECK CONDITION FLAG                16
* ** SFLD = ALL 'ANLIT'                                                 17
         BAL,L1   PID16             WRITE                               43
         MBS,R2   0                 **** MBS,RE BA(ALL'ANLIT')          44
* **                     BA(ALL'ANLIT') ALWAYS USED                     45
* **                     ALLSIZ </=255                                  46
*                        V1 = DSIZR(ADJUSTED)                           54
         MTW,0    VARF
         BLZ      BBC49             VAR LNTH
         CI,V1    0                 CHECK BSIZR(ADJUSTED)
         BEZ      *BBCSAV           = 0, E-O-ALL ANLIT MOVE
* *** ONLY POSSIBLE IF RFLD = ANJR ***
         BAL,L0   NDR30             OBTAIN L,RPTCNT
*                                   WRITE LI,V2 L                       56
*                        R1 = RPTCNT                                    57
*                        D0 = ALLSIZ                                     3
         LCW,D3   D0                LOAD -ALLSIZ                         4
         BAL,L1   PIA06             WRITE                               60
         STB,V2   R3                ****     STORE L                    61
         LBAL,L0  NBS04,CMBS+CRR3+X'F' WRITE MBS,R3 -ALLSIZ             62
* **                     REPEATED MOVES PERFORMED                       63
         B        *BBCSAV           RETURN                              64
BBC49    RES      0
         LCW,D3   D0                -ALLSIZ
         BAL,L1   VPLIT
         LBAL     PIA22,CMBS+CRR3+X'F'
         MTW,0    RLNTH
         BEZ      *BBCSAV
         BAL,L1   VAM50
         B        *BBCSAV
MVLIT    STW,L1   TMPL1
         MTW,0    LITF
         BNEZ     MVLIT1            LITERAL SFLD
         LI,V0    R2
         BAL,L0   VPP10             VAR SFLD ADDRESS
MVLIT1   LW,L1    TMPL1
         LI,V0    R3
         B        LITVR             RESOLVE VAR REC
* SFLD NOT ALL 'ANLIT'                                                  66
BBC42    RES      0                                                     67
         LI,V0    CRR2              R2
         STW,V0   SAVV0
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         CI,R7    2                 CHECK RFLD CLASS                    68
         BL       BBC44             RFLD = GRP/AN                       69
         CWF      BBC44             CHECK CONDITION FLAG
* RFLD = ANJR                                                           70
         SW,D0    V1                PSIZ = BSIZS-DSIZR                  71
         BEZ      BBC45             = 0, BSIZS = DSIZR                  72
         BG       BBC43             > 0, BSIZS > DSIZR                  73
* < 0, BSIZS < DSIZR - LEFT PAD                                         73
         AW,D0    V1                BSIZS = PSIZ+DSIZR                  74
         SW,V1    D0                PSIZ = DSIZR-BSIZS                  75
         LBAL,L0  NDR32,CRR1        WRITE ADCON PSIZ,BA(RFLD)           76
*                                   ****  LW,R1 ADCON                   77
         LW,V1    D0                DSIZR = BSIZS                       78
         MTW,0    MAREF
         BGEZ     BBC421            NOT GROUP MOVE
         LI,V0    R1
         BAL,L0   VPP00             RESOLVE VAR REC
         B        BBC421+1
BBC421   BAL,L0   LBLVR
         BAL,L0   NDF04             BLANK PAD                           79
         BAL,L0   NDR30             OBTAIN L,RPTCNT
         BAL,L1   PIA06             WRITE                               81
         STB,V2   R1                ****     STORE L                    82
         BAL,L1   PIY31             WRITE                               83
         LW,R3    R1                ****     R3(=RO) = L,BA(RFLD)       84
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         B        BBC46                                                 85
*                                                                       86
* > 0, BSIZS > DSIZR                                                    87
BBC43    RES      0
         AW,D3    D0                SFLD DISPL = SFLD DISPL+PSIZ
         B        BBC45                                                 91
*                                                                       01
* RFLD = GRP/AN                                                         02
         LCW,D0   D0                BSIZS = -BSIZS
BBC44    RES      0                                                     03
         SW,D0    V1                PSIZ = BSIZS-DSIZR                  03
         BGEZ     BBC45             >/= 0, BSIZS >/= DSIZR              04
* < 0, BSIZS < DSIZR                                                    05
         AW,V1    D0                DSIZR = DSIZR+BSIZS-DSIZR(=BSIZS)
*                        V1 = DSIZR                                     07
*                        D0 = PSIZ                                      08
BBC45    RES      0                                                     10
         STW,D3   BBCSAV+5          SAVE SFLD BASE,DISPL
         LBAL,L0  NDR32,CRR3        WRITE ADCON DSIZR,BA(RFLD)          11
         LW,D3    BBCSAV+5          LOAD SFLD BASE,DISPL
*                        D3 = SFLD BASE,DISPL
*                        V1 = MIN(BSIZS,DSIZR)                          12
* **                     RO = MIN(BSIZS,DSIZR),BA(RFLD)                 13
BBC46    RES      0                                                     14
         AWM,V1   JMBSIZ            MBS CNT = MBS CNT + DSIZR           15
         LW,V1    D0                SAVE PSIZ                           16
         LW,V0    JSFLDS            LOAD SUBSCRIPT FLAG                 22
* *** CONDITION ENTRY CHECK ********
         CWF      BCA40             CHECK CONDITION FLAG                22
* RFLD = AN/GRP                                                         23
         AI,V0    CMBS              FORM MBS,RE                         25
         STW,V0   TMPV0
         BLEZ     BBC461            SUBSCRIPTED
* NOT SUBSCRIPTED                                                       20
         AI,V0    CLI-CMBS          FORM LI,RE                          27
         MTW,0    SLNKF                                                 COBOL42D
         BNEZ     BBC461            IN LINKAGE SECTION                  COBOL42D
         BAL,L1   PID10             WRITE LI,RE BA(SFLD)                22
BBC461   MTW,0    MAREF
         BEZ      BBC462            NOT GRP MOVE
         MTW,0    LITF
         BEZ      BBC463
         LI,L1    0                 LITERAL SFLD
         STW,L1   MAREF
         B        BBC462
BBC463   MTW,1    CONDF
         BAL,L1   MBS70
         B        BBC462+1
BBC462   BAL,L1   MVLIT
         LI,L0    BBC47             LINK REGISTER
         MTW,0    SLNKF                                                 COBOL42D
         BNEZ     BBC464            IN LINKAGE SECTION                  COBOL42D
         LW,V0    TMPV0
         BLEZ     NBS02
BBC464   LI,D3    0                 CLEAR SUBSCRIPT FLAG                COBOL42D
         LBAL,L0  NBS04,CMBS+CRR2   WRITE MBS,R2 0
* MBS RETURN                                                            24
* *** PSIZ SAVED IN V1 SINCE NBS0- DESTROYS D0***
*                       V1 = PSIZ
BBC47    RES      0                                                     26
         MTW,0    VARF
         BGEZ     BBC471
         BAL,L1   FXLIT
         B        *BBCSAV
BBC471   LCW,V1   V1                -PSIZ
         BLEZ     *BBCSAV           </= 0, NO PAD REQUIRED              28
* > 0, RIGHT PAD                                                        29
         BAL,L0   NDR30             OBTAIN L,RPTCNT
         BAL,L1   PIA06             WRITE                               31
         STB,V2   R3                ****     STORE L                    32
         BAL,L1   PIY31             WRITE                               33
         LW,R1    R3                ****     R1 = PSIZ,(3A(SFLD)        34
         BAL,L0   NDF04             BLANK PAD                           35
         B        *BBCSAV           RETURN
*
* RFLD NUMERIC
BBC48    RES      0
         MTH,6    0,R2              SFLD CLASS = NDU
         LI,R6    1                 SFLD TYPE = ND
         STB,R6   BBCOSI                                                COBOL42D
*                                                                        1
* SFLD = ND/NDU                                                          2
*                        R1 = RFLD TYPE
BBC50    RES      0                                                      4
         CI,R1    DJAN              CHECK RFLD TYPE                      5
         BL       BBC70             RFLD NUMERIC                         6
         CI,R1    DJAXM
         BE       BBC70             RFLD INDEX
* RFLD = AN                                                              7
         LH,V1    0,R2              LOAD CLASS                           8
         LCH,D0   4,R5              LOAD,CHECK DECP                      9
BBC52    RES      0                                                      7
         BGZ      BBC70             > 0, TRAILING P'S                   10
* </= 0, INTEGER/FRACTIONAL                                             10
         BLZ      BBC54             < 0, FRACTIONAL                     11
         CI,V1    1                 CHECK CLASS                         13
         BAZ      BBC70             CLASS = NDS
* UNSIGNED INTEGER /FRACTIONAL                                          14
BBC54    RES      0                                                     15
         AH,D0    3,R2              BSIZS = BSIZS-DECP                  16
         STH,D0   3,R2                                                  16
         LI,R6    -1                                                    COBOL42D
         STH,R6   BBCSI                                                 COBOL42D
         AND,V1   L(X'01')                                              COBOL42D
         B        BBC31             'AN' MOVE
* **********************************
*                                                                        1
* SFLD = NLIT
* RFLD = GRP
BBC59    RES      0
         LI,V1    0                 DECPS = 0
         STH,V1   4,R5
*                        R1 = RFLD TYPE
*                        L0 = LINK REGISTER
BBC60    RES      0                                                      3
         LB,R6    KRCLAS,R1         LOAD RFLD CLASS CODE                30
         BAL,L1   LIT00             CONVERT,POOL LITERAL                12
         BAL,L1   BBB62             SET LIT TYPE CODE                   31
         MTW,1    LITF
* SFLD = NC                                                              2
BBC70    RES      0                                                      3
* SFLD = FLS                                                             2
BBC80    RES      0                                                      3
* SFLD = FLL                                                            10
BBC84    RES      0                                                     11
* SFLD = INDEX
BBC88    RES      0
* SFLD = BIN                                                             1
BBC90    RES      0                                                      2
*                        R1 = RFLD TYPE
*                        R6 = SFLD CLASS                                34
*                        L0 = LINK REGISTER
BBC91    RES      0                                                      6
         LH,R7    MDBUF-1           LOAD UP/DOWN FLAG (0/X'100')        COBOL42D
         STW,L0   BBCSAV            SAVE LINK REGISTER
         LI,L0    BBC93             SET LINK REGISTER
*                        R7 = DOWN BY FLAG
*                        L0 = LINK REGISTER
BBC92    RES      0                                                     14
         LH,V1    4,R5              LOAD DECPS,DSIZS,BSIZS              51
         LH,D0    3,R5                                                  52
         LH,D1    3,R2                                                  53
         STW,V1   JDECP             STORE DECPS,DSIZS,BSIZS             14
         STD,D0   JDSIZ                                                 15
         EXU      EBC92+1,R1        EXECUTE ON RFLD TYPE
*                        R6 = RREG,RFLD CLASS                           17
         XW,D0    LITF
         STW,D0   NOVF
         XW,D0    LITF
         BDR,R7   LRN00             DOWN BY, LOAD NEGATIVE
         B        LRD00             LOAD SFLD                           57
BBC93    RES      0
         LW,L0    JCREF             SEE IF CONDITIN FLAG ON             COBOL42D
         BEZ      %+3               NO--MOVE STATEMENT JSXR = 3         COBOL42D
         MTW,-1   JSXR              YES SET JSXR = 1                    COBOL42D
         B        %+2                                                   COBOL42D
         MTW,1    JSXR              SET SXR FOR RFLD                    19
         BAL,L0   BBB88             CHECK, SAVE DECA
         LI,L0    0
         STW,L0   NOVF
*                        R6 = SREG,SFLD CLASS                           20
* ** SFLD CLASS AGREES WITH RFLD CLASS ***                              21
BBC94    RES      0                                                     22
         BAL,L1   BAA46             SAVE VAR FLAG
         LW,L0    BBCSAV            LOAD LINK REGISTER                  23
* *** CONDITION ENTRY CHECK ********
         CWF      BCA94             CHECK CONDITION FLAG
         CI,R6    4                 CHECK SFLD CLASS                    24
         BAZ      LDR20             SFLD = ND/NC/NE(/AN/ANE)            25
         LI,R7    X'F'              MASK SFLD CLASS
         AND,R7   R6
         EXU      EBC94-X'C',R7     EXECUTE ON RFLD TYPE
* RFLD = INDEX
         LH,R1    JSET              SET IF SET UP/DOWN BY               COBOL42D
         BEZ      BBC95             NO                                  COBOL42D
         LI,V0    X'F0'             SET REGISTER (SREG)                 COBOL42D
         AND,V0   R6                                                    COBOL42D
         LH,D3    2,R2              DISPL                               COBOL42D
         LH,V1    2,R5              BASE                                COBOL42D
         STH,V1   D3                BASE,DISP                           COBOL42D
         B        BCE38             WRITE AWM,SREG  RFLD                COBOL42D
BBC95    RES      0                                                     COBOL42D
         BAL,L0   MDR64             STORE INDEX
         B        *BBCSAV           RETURN
* RFLD = INDEX                                                          62
*                        R6 = SFLD TYPE                                 63
         LI,R1    DJAXM             ADJUST RFLD TYPE
         STH,R1   BBCRI
BBC96    RES      0                                                     64
         CI,R6    CJAX              CHECK SFLD TYPE                     65
         BE       BBC97             SFLD = INDEX, SUBFS LOADED.         66
* SFLD NOT= INDEX                                                       67
         LI,V1    -1                SUBFS = -1                          68
*                        V1 = SUBFS(=SUBFR)                             69
BBC97    RES      0                                                     70
         LAB,R6   *L1,CRI+X'C'      LOAD RREG,RFLD CLASS                71
* SFLD = NUM - RFLD TYPE
         BAL,L1   BBC96-2           INDEX
EBC92    RES      0
         LI,R6    CRB+8             DESCENDING
         LI,R6    CRB+8             ASCENDING
         LI,R6    CRFL+X'F'         FLL                                 94
         LI,R6    CRFL+X'E'         FLS                                 95
         LI,R6    CRB+X'D'          BIN                                 96
         LI,R6    CRB+8             AN
         LI,R6    CRB+8             GRD***NLIT ONLY
         BAL,L1   BBC96             INDEX
         B        *L1               EXPRESSION - RETURN
* SFLD(=RFLD) = INDEX/BIN/FLP - RFLD CLASS
EBC94    RES      0
         BAL,L0   MRR00+2           INDEX
         B        MDR64             BIN
         B        MDR64             FLS
         B        MDR88             FLL
*
* GRP MOVE - MULTIPLE RFLDS                                              0
BBE00    RES      0                                                      1
         LI,L0    BAA02             SET LINK REGISTER
         LW,R3    MCBUF+1           LOAD NREF(GRP)
         MTW,1    MAREF             SET MULTI RFLD FLAG
BBE02    RES      0
         STW,L0   BBCSAV+2          SAVE LINK REGISTER
         BAL,L0   BBC04             MOVE FIRST GRP                       2
*                        R3 = NRF(GRP)
         BDR,R3   BBE04             NRF(GRP) = NREF(GRP)-1
* E-O-GRP MOVES.
         B        *BBCSAV+2         RETURN
* MOVE TO NEXT GRP
BBE04    RES      0
         BAL,L0   BBB80             CHECK,ADJUST DISPL/SXR
         LW,D0    JBSIZ             LOAD BSIZS
         B        BBC06             TO MOVE NEXT GRP
*                                                                       12
* ZERO/ZERO LIT MOVE - MULTIPLE RFLDS                                    1
*                        D1 = TYPE BITS,NREF
BBE10    RES      0                                                      3
         MTW,1    LITF
         STB,D1   MCBUF             SAVE NREF
         LI,R1    0                 RFLD TYPE INDEX(I) = 0(=NC/NE-1)     5
BBE11    RES      0                                                      6
         AI,R1    1                 I = I+1                             27
         LH,R3    MCBUF+1,R1        CHECK NREF(I)                        7
         BEZ      BBE11             = 0. TYPE I RFLDS NOT PRESENT
* MOVE ZERO/ZERO LIT TO TYPE I RFLDS                                    12
*                        R3 = NREF(I)                                   13
BBE12    RES      0                                                     14
         STH,R1   BBCRI             SAVE I
         BAL,L0   BBC10             MOVE TO FIRST RFLD                  17
         LH,R1    BBCRI             LOAD I
         BDR,R3   BBE16             NREF(I) = NREF(I)-1                 19
* E-O-TYPE I                                                            20
         MTB,15   MCBUF             NREF = NREF-1                       21
         BEZ      BAA02             = 0, E-O-MOVE                       22
* ANOTHER TYPE                                                          23
BBE13    RES      0                                                     24
         AI,R1    1                 I = I+1
         LH,R3    MCBUF+1,R1        LOAD,CHECK NREF(I)                  25
         BEZ      BBE13             = 0
*     NOT  = 0
         STH,R1   BBCRI             SAVE RFLD TYPE
* REPEATED MOVES
BBE16    RES      0                                                     31
         CI,R1    1                 CHECK I                             32
         BG       BBC11             > 1, RFLD NUMERIC                   33
         B        BBC16             = 1, RFLD = GRP/AN/ANE              34
*                                                                       35
* SFLD = (ALL) ANLIT/FIGCON - MULTIPLE RFLDS                             1
*                        D1 = TYPE BITS,NREF
BBE20    RES      0                                                      3
         MTW,1    LITF
         STB,D1   MCBUF             SAVE NREF
         LI,R1    3                 RFLD TYPE INDEX(2) = 3 (=AN-1)       5
         LH,R3    MCBUF,R1          LOAD,CHECK NREF(2)                   6
         BNEZ     BBE21             NOT= 0, TYPE I RFLDS PRESENT         7
* = 0, NO TYPE I RFLDS                                                   8
         AI,R1    1                 I = I+1(=GRP-1)                      9
         LH,R3    MCBUF,R1          LOAD NREF(GRP)
* MOVE (ALL) ANLIT/FIGCON TO TYPE I RFLDS
BBE21    RES      0                                                     11
         AI,R1    1                 I = I+1                             12
         STH,R1   BBCRI             SAVE I
         BAL,L0   BBC20             MOVE TO FIRST RFLD                  14
*                        R3 = NREF(I)                                   15
         BDR,R3   BBE22             NREF(I) = NREF(I)-1                 16
* = 0, E-O-TYPE I MOVES                                                 17
         MTB,15   MCBUF             NREF = NREF-1                       18
         BEZ      BAA02             = 0, E-O-MOVES                      19
* RFLDS = GRP                                                           20
         MTH,1    BBCRI             I = I+1(=GRP)
         LH,R3    MCBUF+2           LOAD NREF(GRP)                      22
*                        R3 = NREF(I)                                   24
* MOVE (ALL) ANLIT/FIGCON                                               23
BBE22    RES      0                                                     25
         LH,R1    BBCRI             LOAD I
         LW,D0    JBSIZ             LOAD,CHECK BSIZS                    27
         BEZ      BBC16             = 0, SFLD = ALL '1 CHAR' ANLIT/FIGCON28
* SFLD = (ALL) ANLIT                                                    29
         LAB,L0   BBB80,BBC32+1     CHECK,ADJUST DISPL/SXR
*
*                                                                        1
* SFLD = AN/N - MULTIPLE RFLDS                                           2
*                        D1 = TYPE BITS,NREF                             5
*                        R6 = SFLD TYPE
*                        V1 = 0(ON ENTRY)
BBE30    RES      0                                                      6
         MTW,1    MAREF
         STW,V1    JCSAV           LOWER AN USAGE FLAG
         STB,V1   BBCOSI                                                COBOL42D
         LI,L0    BBB70             SET LINK REGISTER
         STB,D1   MCBUF             SAVE NREF                            7
         CI,R6    CJAL              CHECK SFLD TYPE                     61
         BE       BBE302            =NLIT
         CI,R6    CJANL
         BNE      BBE31             NOT=ANLIT
* SFLD = ANLIT
         MTW,1    LITF
         BAL,L1   LIT00             POOL ANLIT
         LAB,R6   BBE31,CJAN        SFLD TYPE = AN
* SFLD = NLIT
BBE302   RES      0
         MTW,1    LITF
         CI,D1    X'100'            CHECK GRP FLAG
         BAZ      BBE60             DOWN. NO GRPS
* GRP RFLDS ***MOVE ONLY***
         AI,D1    -X'100'           LOWER GRP FLAG
         LH,V1    4,R5              SAVE DECPS
         STW,V1   BBCLD
* SFLD = DATA                                                           63
BBE31    RES      0
         STH,R6   BBCSI             SAVE SFLD TYPE                      64
         LI,R4    0                 LOAD EXECUTE INDEX                  71
         STW,R4   JMBSIZ            CLEAR MBS CNT                       72
         CI,D1    X'100'            CHECK GRP TYPE BIT                   8
         BAZ      BBE40             = 0, NO GRP RFLDS
* GRP RFLDS                                                             10
         LI,R1    5                 LOAD NREF(GRP)
         LH,R3    MCBUF+2,R1
         MTW,15   JSXSX             SET GRP SUBSCRIPT SWITCH            12
         BAL,L0   BBE02             MOVE TO GRP RFLDS
         MTW,1    JSXSX             RESET GRP SUBSCRIPT SWITCH          14
         MTB,15   MCBUF             NREF = NREF - 1                     15
         BEZ      BAA02             NREF = 0,GRP RFLDS ONLY
         LH,R6    BBCSI             LOAD SFLD TYPE                      16
         BAL,L0   BBB80             CHECK,ADJUST DISPL/SXR
         LI,R4    0                 RESET EXECUTE CODE
         LI,L0    BBE70             SET LINK REGISTER
         LH,D1    MCBUF+1           LOAD TYPE BITS, NREF
*                                                                       46
*                        R4 = EXECUTE TYPE                              48
*                        R6 = SFLD TYPE
BBE40    RES      0                                                     49
         EXU      EBE40+1,R6        EXECUTE ON SFLD TYPE FOR NREF CNTL   2
         CI,D1    X'8000'           CHECK INDEX FLAG
         BAZ      BBE41             DOWN.
         LH,R1    V1                LOAD STACK CNTL(1)
         BLZ      BBE42-1           < 0, GRP
         EXU      EBE41-2,R1        EXECUTE ON I FOR STACK CNTL ADJ.
BBE41    RES      0
*                        V1 = NREF(I) CNTL                              51
         LH,R1    V1                LOAD I                              53
         BGZ      BBE42             > 0
* </= 0, GRP/INDEX
         AI,R1    8                 ADJUST I
BBE42    RES      0
         LH,R3    MCBUF+1,R1        LOAD,CHECK NREF(I)                  54
         BNEZ     BBE44             NOT= 0, TYPE I RFLDS PRESENT        55
* =0, NO TYPE I RFLDS                                                   56
BBE43    RES      0                                                     57
         STH,R3   V1                POSITION NEXT I                     58
         SLS,V1   3                                                     59
         B        BBE41
* INITIAL NREF(I)CNTL - SFLD TYPE
EBE40    RES      0
         LI,V1    DWCA              AN
         LI,V1    DWCN              NC
         LI,V1    DWCN              ND
         LI,V1    DWCFL             FLL
         LI,V1    DWCFS             FLS
         LI,V1    DWCB              BIN
         LI,V1    DWCB              INDEX
         LI,V1    X'F0000'          NLIT - GRP
* INDEX STACK CNTL
EBE41    RES      0
         LI,V1    DWIN              NC/ND/NLIT
         LI,V1    DWIFL             FLL
         LI,V1    DWIFS             FLS
         LI,V1    DWIB              BIN/INDEX
*                                                                       37
* MOVE TO TYPE I RFLDS                                                  61
*                        R1 = RFLD TYPE                                 63
*                        R3 = NREF(I)                                   64
*                        R6 = SFLD TYPE                                 65
*                        V1 = NREF(I) CNTL                              67
BBE44    RES      0                                                     68
         STW,V1   BBCNI             SAVE NREF(I) CNTL                   64
         AI,R1    -2                I = I-2                             72
         STH,R1   BBCRI             SAVE RFLD TYPE
         CI,R4    0                 CHECK EXECUTE INDEX                 73
         BG       BBE50             NOT= 0, NOT FIRST I                 12
* MOVE TO FIRST FIELD                                                   75
*                        L0 = LINK REGISTER
         BAL,L1   *L0               RETURN OR
*        BAL,L1   BBB70             CHECK,SET/RESET DECA SAVE FLAGS
*        B(AL,L1) BBE70             GRP MOVE(D)
         EXU      EBE44+1,R6        MOVE TO FIRST RFLD                  76
BBE45    RES      0
         LH,R1    BBCRI             LOAD I                               6
         EXU      EBE45+1,R1        EXECUTE ON I                        14
*                        R4 = (NEW) SFLD TYPE                            8
         STH,R4   BBCSI             STORE (NEW) SFLD TYPE                9
         MTW,4    BBCSAV            SET REPEAT LINK                     10
*                        R3 = NREF(I)                                   77
         BDR,R3   BBE56             NREF(I) = NREF(I)-1                 16
* NREF(I) = 0, E-O-TYPE I MOVES                                         79
         MTB,15   MCBUF             MREF = NREF-1                       80
         BEZ      BAA02             = 0, E-O-MOVES                      81
* NREF > 0, MORE RFLDS                                                  82
         BAL,L0   BBB80             CHECK,ADJUST DISPL/SXR
         LI,L0    BBE55             SET LINK REGISTER                   21
* MOVE TO NEXT RFLD TYPE                                                21
*                        R4 = EXECUTE CODE(>0)                          23
*                        R6 = SREG,SFLD CLASS
*                        L0 = LINK REGISTER
BBE46    RES      0                                                     25
         LW,R7    R6                SAVE SREG,SFLD CLASS
         LW,V1    BBCNI             LOAD NREF(I) CNTL                   84
         LH,R6    BBCSI             LOAD,CHECK SFLD TYPE
         BLZ      BBE59             = GRP (NLIT)
         CI,R6    CJAFL             CHECK SFLD TYPE
         BNE      BBE43             SFLD NOT= FLL
* SFLD = FLL
         LI,R7    CRFL+X'F'         LOAD FLL REG,CLASS
         B        BBE43             TO CHECK FOR NEXT I
* SFLD = FLP
BBE47    RES      0
         LI,R6    CJAFL             SFLD TYPE = FLL
         CI,R1    DJAB              CHECK RFLD TYPE
         BNE      BBC90             NOT= BIN
* RFLD = BIN
         STH,R6   BBCSI             SAVE SFLD TYPE
         LBAL,L0  BBC91+2,DJAFL,R1  LOAD SFLD
         MTW,1    JSXR              SET SXR FOR RFLD
         LI,R7    CRFL+X'F'         LOAD SREG,SFLD CLASS
         LI,R1    DJAB              RFLD TYPE = BIN
         LAB,L0   BBE52+1,BBE55     MOVE FLL TO BIN
* RFLD = FLS - SET (NEW) SFLD TYPE
BBE48    RES      0                                                     33
         LH,R4    BBCSI             LOAD,CHECK LAST SFLD TYPE
         CI,R4    CJAFL
         BE       *L1               = FLL
         CI,R4    CJAFS
         BE       *L1               = FLS
         EXU      EBE48-2,R1        LOAD (NEW) SFLD TYPE
         B        *L1
* RFLD = BIN
BBE49    RES      0
         LH,R4    MCBUF+1           LOAD,CHECK TYPE BITS
         BGZ      BBE48             NO INDEX RFLDS
         LAB,R4   *L1,CJAB
* MOVE TO FIRST RFLD - SFLD TYPE
EBE44    RES      0
         BAL,L0   BBC30             AN
         BAL,L0   BBC70             NC
         BAL,L0   BBC50             ND
         BAL,L0   BBE47+1           FLL
         BAL,L0   BBE47             FSL
         BAL,L0   BBC90             BIN
         BAL,L0   BBC88             INDEX
         BAL,L0   BBC59             NLIT - GRP
*                                                                       31
* SFLD TYPE ADJUSTMENT - RFLD TYPE
EBE45    RES      0
         LI,R4    0                 DESCENDING
         LI,R4    0                 ASCENDING
         LI,R4    CJAFL             FLL
         BAL,L1   BBE48             FLS
         BAL,L1   BBE49             BIN
         LH,R4    BBCSI             AN
         LI,R4    CJAG              GRP - NLIT ONLY
         LI,R4    CJAX              INDEX
* (NEW) SFLD TYPE  - RFLD TYPE(BIN/FLS)
EBE48    RES      0
         LI,R4    CJAFS             FLS
         LI,R4    CJAB              BIN
* MOVE TO NEXT RFLD TYPE                                                21
*                        R1 = RFLD TYPE                                 22
*                        R4 = EXECUTE CODE                              23
*                        R6 = SFLD TYPE                                 24
BBE50    RES      0                                                     42
         CI,R6    CJAN              CHECK SFLD TYPE
         BE       BBE70             SFLD TYPE = AN
* SFLD = NUMERIC
         LW,V1    JSAVD             LOAD DECA SAVE FLAG
         CI,V1    DSG               CHECK DECA SAVED FLAG
         BAZ      BBE52             DOWN.                               37
* DECA SAVED
         BAL,L1   PRT06             WRITE
         DL,0     DTD4              ****  DL,0 TMP
         LD,D0    BBCSAV+1          RESTORE DECPS,DSIZS
* **                     DECP,DSIZ SAVED WHEN ORIGINAL DECA SAVED
         STW,D0   JDECP
         STW,D1   JDSIZ
BBE52    RES      0
         BAL,L1   BBB70             CHECK,SET/RESET DECA SAVE FLAGS
*                        R7 = SREG,SFLD CLASS                           36
         LI,D1    X'F0'             LOAD,MASK SREG,SFLD CLASS           37
         AND,D1   R7                                                    38
         EOR,R7   D1                                                    39
         LW,V1    JDECP             LOAD DECPS
*                        R1 = RFLD TYPE
*                        R7 = SFLD CLASS
*                        V1 = DECPS(/SUBFS)
*                        L0 = LINK REGISTER
BBE53    RES      0
         STW,L0   BBCSAV            SAVE LINK REGISTER
         CI,R1    DJAXM             CHECK RFLD TYPE
         BNE      BBE54             RFLD NOT= INDEX
* RFLD = INDEX
         CI,R7    4                 CHECK SFLD CLASS
         BANZ     BBE54             SFLD NOT= NC
* SFLD = NC
         LBAL,L0  MRR11,CRI+X'D',R6 LOAD BIN
*                        R1 = RFLD TYPE(PRESERVED)
* *** R7 SETTING NOT ESSENTIAL FOR NC TO BIN CONVERSION ***
         LI,R7    X'D'              SFLD CLASS = BIN
BBE54    RES      0                                                     51
         MTW,0    SFLCF                                                 COBOL42D
         BNEZ     BBE541            NO CONVERSION NECESSARY             COBOL42D
         EXU      EBC92+1,R1        EXECUTE ON RFLD TYPE                34
*                        R6 = RREG,RFLD CLASS                           35
         BAL,L0   LRR01             CHECK,CONVERT N VALUE
BBE541   RES      0                                                     COBOL42D
         BAL,L0   BBB88             CHECK,SAVE DECA
         B        *BBCSAV           RETURN                              64
         BAL,L0   BBE52             GRP/AN USAGE LOADED                 51
BBE55    RES      0                                                     53
         LI,L1    BBE45             SET LINK REGISTER
         STW,L1   BBCSAV
* REPEATED MOVES                                                        41
BBE56    RES      0
         LH,R1    BBCRI             LOAD,CHECK RFLD TYPE                43
         BLEZ     BBE58             RFLD TYPE = ASCENDING/DESCENDING
         CI,R1    DJAN                                                  45
         BNE      BBC94             RFLD TYPE = INDEX/BIN/FLP
         CH,R1     JCSAV           CHECK AN USAGE FLAG
         BAZ       BBC94           AN USAGE FLAG DOWN
         LW,D0     JBSIZ           LOAD BSIZS
         BAL,L0   BBB80             CHECK,ADJUST DISPL/SXR
         B        BBC32+1           RFLD TYPE = AN                      48
* RFLD = ASCENDING/DESCENDING                                           50
BBE58    RES      0                                                     57
         LAB,L1   BBB70,BBC94       CHECK,RESET DECA SAVE FLAG          52
*                                                                        0
* SFLD = NLIT - MULTIPLE RFLDS                                           1
* RFLD = GRP
BBE59    RES      0
*                                    CORRECT MOVE TO BOTH AN AND
*                                    NUMERIC FIELDS - SIDR 1945
         CI,R6    CJAN               TEST IF AN
         BE       BBE43              YES
         LW,V1    BBCLD             RESTORE DECPS
         STW,V1   JDECP
         STW,V1   BBCSAV+1
         LAB,R6   BBE40-1,0         SFLD TYPE = NC
*                        D1 = TYPE BITS,NREF                             2
BBE60    RES      0                                                      3
         CI,D1    X'6300'           CHECK RFLD TYPE BITS                 4
         BANZ     BBE62             ND/NC/NE RFLDS
* INDEX/BIN/FLP RFLDS ONLY
         BAL,L1   BBB60             CHECK,SET NLIT CONVERSION CODE
BBE62    RES      0                                                      8
         BAL,L1   LIT00             (CONVERT,)POOL LIT                  10
         LAB,L1   BBB62,BBE31       SET NLIT TYPE CODE
*
* GRP MOVE                                                               1
BBE70    RES      0                                                      2
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         LW,V0    JSFLDS            LOAD SUBSCRIPT FLAG
         LW,V1    JDSIZ             LOAD DSIZ   (REPLACED 6/8/70)
         LW,D0    JDSIZ             LOAD DSIZ
         CI,R6    1                 CHECK SFLD CLASS                     4
         BG       BBE76             SFLD = INDEX/BIN/FLP                 5
* SFLD = AN/ND/NC                                                        6
         BANZ     BBE72             SFLD = AN/NC                         7
* SFLD = NC                                                              8
BBE71    RES      0
         LB,R7    BBCOSI                                                COBOL42D
         BAL,L0   NBS20             CHECK SUBSCRIPT, LOAD BYTE OFFSET
         LAB,L1   ORD23,BBE55-1     WRITE DL,DSIZ/2+1 SFLD(,SXR)
* SFLD = AN/ND                                                          12
BBE72    RES      0                                                     14
         BE       BBE74             SFLD = ND                           15
* SFLD = AN                                                             16
*                        R1 = RFLD TYPE                                 13
         CI,R1    DJAN              CHECK RFLD TYPE                     17
         BNE      BBE73             RFLD NOT= AN                        18
* RFLD = AN                                                             19
         LAB,L0   BBC32-1,BBE45     RFLD = AN
* RFLD NOT = AN
BBE73    RES      0
         MTB,6    BBCOSI                                                COBOL42D
         LI,R6    1                 SFLD TYPE = ND
* SFLD = ND
BBE74    RES      0
         LB,R7    BBCOSI                                                COBOL42D
         AI,R7    2                 SFLD CLASS = NC/NCU
         CI,V1    1                 CHECK BSIZS
         BANZ     BBE75             ODD.
* BSIZS EVEN
*   MOVE MULTIPLE RECIEVING FIELDS     NAVY TEST  GG                    COBOL42D
         LI,L0    BBE74A            SET UP EXIT                         COBOL42D
         CI,V0    0                 CHECK SUBSCRIPT FLAG
         BLZ      NRD02             SUBSCRIPTED
         BAL,L1   OBS20             WRITE LI,RE BA/HA BITS OR 0
         AI,V0    -CLI              CLEAR LI
         B        NRD02             WRITE MBS,RE TO UNPKA+1
*   MOVE MULTIPLE RECIEVING FIELDS     NAVY TEST  GG                    COBOL42D
BBE74A   LW,D0    JDSIZ             RESTORE  DECIMAL SIZE               COBOL42D
         B        BBE55-1                                               COBOL42D
*                                   ****  PACK,L  UNPKA
* BSIZS  ODD
BBE75    RES      0
         BAL,L0   NBS20             CHECK SUBSCRIPT, LOAD BYTE OFFSET
         LAB,L1   ORD12,BBE55-1     WRITE PACK,L SFLD(,SXR)
* SFLD = BIN/FLP
BBE76    RES      0
         CI,V0    0                      CHECK SUBSCRIPT FLAG           24
         BGZ      BBE78             >/= 0. NOT SUBSCRIPTED
* SFLD SUBSCRIPTED                                                      26
         LI,D1    CSAS+X'7E'        LOAD SAS -2 RA                      30
         CI,R6    2                 CHECK SFLD TYPE                     31
         BANZ     BBE77             SFLD = BIN/FLS
* SFLD = FLL                                                            34
         AI,D1    -1                SET SAS -3 RA                       35
BBE77    RES      0
         AI,V0    CS                FORM SLS,SXR
         BAL,L1   PIA02             WRITE SLS,SXR -2/-3                 39
         SLS,V0   -3                POSITION SXR
BBE78    RES      0
         AND,V0   K30E              MASK SXR
         LI,V1    X'F0'             MASK RREG
         AND,V1   EBC92+1,R6
         INT,R6   EBC92+1,R6        SET SFLD CLASS(>X'C'),SREG
         LI,L1    BBE55-1           SET LINK REGISTER
         CI,R7    CRFL+X'F'         CHECK SFLD CLASS
         BNE      ORD42             SFLD = BIN/FLS
         B        ORD48             SFLD = FLL
*
* SET UP/DOWN BY
*                        R1 = CLNG                                       1
*                        R6 = (DOWN BY IND.,)UP/DOWN BY(SFLD) TYPE       2
BCE00    RES      0
         LI,R7    X'100'            SET/RESET DOWN BY FLAG               3
         STH,R7   JSET              SET UP/DOWN
         AND,R7   R6                                                     4
         EOR,R6   R7                RESET DOWN BY IND.                   5
         STH,R7   MDBUF-1           SAVE DOWN BY FLAG
         STW,R7   JUNSD             LOWER UNSIGNED FLAG
         CI,R6    CJAO              CHECK SFLD TYPE
         BGE      BCE60             UP/DOWN BY 1
* NOT UP/DOWN BY 1
         CI,R1    4                 CHECK CLNG                           6
         BNE      BCE40             MULTIPLE SET FLDS                    7
* SINGLE SET FLD(RFLD)                                                  10
*                        R6 = SFLD TYPE                                 11
*                        D1 = RFLD TYPE                                 12
         LW,R1    D1                LOAD RFLD TYPE                      14
*                        R1 = RFLD TYPE                                 15
*                        R6 = SFLD TYPE                                 16
*                        R7 = UP/DOWN BY FLAG                           17
BCE02    RES      0                                                     18
         STH,R1   BBCRI             SAVE RFLD TYPE
         CI,R6    CJAL              CHECK SFLD TYPE                     20
         BNE      BCE04             SFLD NOT= NLIT                      21
* SFLD = NLIT                                                           22
         LB,R6    KRCLAS,R1         LOAD RFLD CLASS CODE                23
         MTW,1    LITF
         MTW,1    NOVF
         BAL,L1   LIT00             POOL NLIT                           24
         BAL,L1   BBB62             SET NLIT TYPE CODE                  25
BCE04    RES      0                                                     30
         LH,R3    1,R5              LOAD,CHECK REVERSE FLAG              1
*                        REVERSE FLAG = -1 ALIGN RFLD                    2
*                                     = 0  PACK RFLD                     3
*                                     > 0  NO REVERSE                    4
         BGZ      BCE10             DOWN. NO REVERSE                     5
* REVERSE                                                                6
         BAL,L1   BAA40             SAVE SFLD CLUSTER                    7
         LI,R1    DJAC              RFLD TYPE = ASCENDING
         BAL,L0   SARTHF
         LBAL,L0  BBC92,0,R7        LOAD RFLD                            9
         LW,L0    TMPD0
         STW,L0   LITF              RESET FLAGS
         STW,L0   NOVF
* ***                    RFLD LOADED                                    10
*                        V1 = DECPR                                     11
*                        D0 = DSIZR                                     11
         LI,R2    HA(MDBUF)-1       LOAD HA(SFLD),HA(SFLD)-1
         LI,R5    HA(MDBUF)-2                                           11
         MTW,1    JSXR              SET SFLD SXR                        12
         SH,V1    4,R5              DECPR = DECPR-DECPS                  1
         STH,V1   4,R5
         BEZ      BCE07             = 0, DECPR = DECPS                   2
         BLZ      BCE06             < 0, DECPR < DECPS                   3
* DECPR > DECPS - PACK RFLD                                             16
         BAL,L1   PRT26             WRITE
         DST,0    DTD4              ****     SAVE RFLD                  18
         BAL,L1   SSB00             CHECK SUBSCRIPTS                    11
         BAL,L1   ORD22             WRITE DL,L SFLD(,SXR)               12
         LH,D3    4,R5              LOAD DECPS(=DECPR-DECPS)
         LBAL     PIA22,CDSA        WRITE DSA DECPS
         LH,V0    MDBUF-1           LOAD,CHECK DOWN BY FLAG             15
         BLEZ     BCE05             DOWN. UP BY.                        16
* DOWN BY.                                                              17
         BAL,L1   PIA26             WRITE                               18
         AI,D3    1                 ****     NEGATE DECA                19
BCE05    RES      0                                                     20
         BAL,L1   PRT26             WRITE                               21
         DA,0     DTD4              ****     ADD +/-SFLD,RFLD           22
         B        BCE08                                                 23
* DECPR < DECPS - ALIGN                                                 20
BCE06    RES      0                                                     30
         BAL,L1   ODR00+4           WRITE DSA -(DECPR-DECPS)
BCE07    RES      0                                                     21
         BAL,L1   SSB00             CHECK SUBSCRIPTS                    40
*                        V0 = 0/SXR                                     41
         AI,V0    CDA-CDL           SET DA(-DL),- -(,SXR)               42
         SH,V0    MDBUF-1           SET DS(-DL),-  -(,SXR) FOR DOWN BY  43
         BAL,L1   ORD22             WRITE DA/DS,BSIZS SFLD(,SXR)        44
         LH,D3    4,R5              LOAD,CHECK DECPR(=DECPR-DECPS)
         BGEZ     BCE08             >/= 0
* < 0, ALIGN
         LBAL     PIA22,CDSA        WRITE DSA DECPS
*                        D0 = DSIZR
BCE08    RES      0
         AI,D0    1                 DSIZS = DSIZR+1
         LAB,L0   MDS01,BAA02       WRITE DST/UNPK,BSIZR RFLD(,SXR)     45
*
BCE10    RES      0                                                     40
         BAL,L0   BBC92             LOAD SFLD                           41
         LI,R3    1                 NREF(I) = 1
         STB,R3   MCBUF             NREF = 1
         LI,L0    BAA02             SET LINK REGISTER
* **                     SFLD LOADED - NEGATIVE FOR DOWN BY             41
BCE11    RES      0                                                     13
         STW,L0   BBCSAV            SAVE LINK REGISTER
         BAL,L1   BAA46             SAVE VAR FLAG
         LH,R1    BBCRI             LOAD,CHECK RFLD TYPE
         BGZ      BCE30             RFLD = INDEX/BIN/FLP               11
* RFLD = ASCENDING/DESCENDING (ND/NC)                                  12
*                        V1 = DECPS                                      1
*                        D0 = DSIZS                                      2
BCE12    RES      0
         CH,V1    4,R5              COMPARE DECPS,DECPR                15
         BE       BCE13             =, ALIGNED.
         BG       BCE14             >. ALIGN RFLD - ND SFLD ONLY       17
* DECPS < DECPR                                                          9
         BAL,L1   ODR00             ALIGN RFLD
         LH,V1    4,R5              DECPS = DECPR                       11
         STW,V1   JDECP                                                 12
BCE13    RES      0
         LH,R7    0,R2              LOAD,CHECK RFLD CLASS              23
         CI,R7    8                                                    24
         BANZ     BCE17             RFLD = NC
BCE14    RES      0                                                    26
         LW,R4    JSAVD             LOAD, CHECK DECA SAVED FLAG
         CI,R4    DSG
         BAZ      BCE15             DOWN. NOT SAVED
* DECA SAVED
         CW,V1    BBCSAV+1          COMPARE DECPS,DECPO
         BE       BCE16             DECPS = DECPO. SAVE UNNEC0.
* SAVE NEW DECA
         STW,V1   BBCSAV+1          SAVE DECPS,DSIZS
         STW,D0   BBCSAV+2
* SAVE DECA
BCE15    RES      0
         BAL,L1   PRT06             WRITE
         DST,0    DTD4              ****     SAVE SFLD                  15
BCE16    RES      0
         LI,R6    CRB+8             LOAD RREG,RFLD CLASS
         BAL,L0   SARTHF
         BAL,L0   LRD00             LOAD NC/ND RFLD                    29
         BAL,L1   PRT06             WRITE
         DA,0     DTD4              ****     ADD RFLD,SFLD              19
         B        BCE18                                                32
* RFLD = NC - SFLD(DECA) ALIGNED
*                        V1 = DECPS                                     16
BCE17    RES      0
         MTH,DSG  JSAVD             RAISE DECA SAVE FLAG                11
         BAL,L1   SSB00             CHECK SUBSCRIPTS                   35
         MTH,-DSG JSAVD             LOWER DECA SAVE FLAG                13
         STW,R7   JRFLD             SAVE SFLD CLASS                    36
         STW,V0   JSFLDS            *    SXR/0                         37
         STW,D3   JSFLD             *    BASE DISPL                    38
         AI,V0    CDA-CDL           FORM DA(-DL),-  -(,SXR)            39
         BAL,L1   ORD22             WRITE DA,BSIZR RFLD(,SXR)          40
         LW,V1    JDECP             LOAD DECPS                         41
*                        V1 = MAX(DECPS,DECPR)                         42
BCE18    RES      0                                                    43
         SH,V1    4,R5              DECPS = DECPS-DECPR                 20
         BLEZ     BCE20             </= 0, DECPS</=DECPR                21
* DECPS > DECPR                                                         22
*                        V1 = DECPS                                     23
         LCW,D3   V1                SHIFT CNT = -(DECPS-DECPR)          24
         LBAL     PIA22,CDSA        WRITE DSA SHIFT CNT                 25
* **                     DECA,RFLD ALIGNED                              26
BCE20    RES      0                                                    50
         BAL,L0   MDS00             WRITE DS/UNPK,BSIZR RFLD(,SXR)
         BDR,R3   BCE24             NREF(I) = NREF(I)-1
         B        *BBCSAV           RETURN
* NREF (I) > 0
BCE24    RES      0
         LW,R4    JSAVD             LOAD,CHECK DECA SAVED FLAG
         CI,R4    DSG
         BAZ      BCE68             DOWN. SET UP BY 1
* DECA SAVED
         BAL,L1   PRT06             WRITE
         DL,0     DTD4              ****  DL,0 TMP
         B        BCE11+1
* RFLD = INDEX/BIN/FLP                                                 60
BCE30    RES      0                                                    61
         CI,R1    4                 CHECK RFLD TYPE
         BAZ      BCE32             RFLD NOT= INDEX
* RFLD = INDEX
         BAL,L0   MRR00             CHECK ADJUST INDEX VALUE
BCE32    RES      0
         BAL,L1   SSB00             CHECK SUBSCRIPTS                   62
*                        R6 = SREG,SFLD CLASS                          63
*                        R7 = RFLD CLASS                               64
         LI,V1    X'F0'             LOAD R MASK
         LS,V0    R6                FORM -,SREG -(,SXR)                  66
         CI,R7    X'E'              CHECK RFLD CLASS                   67
         BL       BCE38             RFLD = INDEX/BIN                   68
* RFLD = FLS/FLL                                                       69
         BE       BCE34             RFLD = FLS
* RFLD = FLL                                                           71
         AI,V0    CFAL-CFAS         SET FOR FAL(-FAS)                  72
BCE34    RES      0
         BDR,R3   BCE36             NREF(I) = NREF(I)-1
*NREF(I) = 0
         MTB,15   MCBUF             NREF = NREF-1
         BNEZ     BCE36-1           NREF = 0
*NREF,NREF(I) = 0
         AI,V0    CFAS              FORM FAS/FAL,SREG -(,SXR)          74
         BAL,L1   PID11             WRITE FAS/FAL,SREG RFLD(,SXR)      75
         AI,V0    CSTW-CFAS         FORM STW/STD,SREG  -(,SXR)         76
         BAL,L1   CALVP
         LAB,L1   PID11,BAA02       WRITE STW/STD,SREG RFLD(,SXR)           77
*NREF/NREF(I) NOT= 0
         MTB,1    MCBUF             NREF = NREF-1
BCE36    RES      0
         AI,R3    1                 NREF(I) = NREF(I)+1
         AND,V1   V0                SAVE SREG
         AI,V0    CLW+CRR2          FORM LW/LD,SREG+2 - (,SXR)
         BAL,L1   CALVP
         BAL,L1   MDF65                                                 COBOL42D
         LW,D1    V1                LOAD SREG
         XW,V1    V0                SAVE LW/LD,SREG+2 -(,SXR)
         LI,V0    X'FFF0'           MASK LW/LD,SREG+2
         AND,V0   V1
         AI,V0    CFAS-CLW          FORM FAS/FAL,SREG+2
         BAL,L1   ORR07             WRITE FAS/FAL,SREG+2  SREG
         LW,V0    V1                LOAD FAS/FAL,SREG+2 -(,SXR)
         AI,V0    CSTW-CFAS-CAWM    SET STW/STD(-AWM),SREG+2 -(,SXR)
* RFLD = INDEX/BIN                                                      80
*                        V0 = -,SREG  -(,SXR)                          81
*                        D3 = BASE,DISPL                                 82
BCE38    RES      0                                                     83
         AI,V0    CAWM              FORM AWM,SREG -(,SXR)               84
         BAL,L1   CALVP
         BAL,L1   MDF65                                                 COBOL42D
         BDR,R3   BCE11+1           NREF = NREF-1
         B        *BBCSAV           RETURN
* MULTIPLE RFLDS                                                        60
BCE40    RES      0                                                     61
         BAL,L0   BBE30+1           INITIALIZE SET UP/DOWN BY
         LH,R7    MDBUF-1           LOAD DOWN BY FLAG                    1
         BAL,L0   BBC92             LOAD SFLD                            2
         LH,R1    BBCRI             LOAD I                               6
         EXU      EBE45+1,R1        EXECUTE ON I
*                        R4 = EXECUTE CODE                              66
         STH,R4   BBCSI             STORE (NEW) SFLD TYPE                9
         BDR,R4   BCE42             RFLD NOT=NC/ND
*RFLD =  NC/ND
         BAL,L1   PRT06             WRITE                               17
         DST,0    DTD4              ****     SAVE RFLD                  18
         MTW,DSG  JSAVD             RAISE ORIGINAL DECA SAVED FLAG
BCE42    RES      0
         BAL,L0   BCE11             SET UP/DOWN BY
* NREF(I) = 0, E-O-TYPE I MOVES                                         79
         MTB,-1   MCBUF             NREF = NREF-1                       20
         BEZ      BAA02             NREF = 0, E-O-SET UP/DOWN           21
* NREF > 0, MORE RFLDS                                                  82
         LBAL,L0  BBE46,1,R4        CHECK,SET NEXT I                    22
* SET UP/DOWN NEXT I                                                    23
*                        R1 = RFLD TYPE                                 22
*                        R3 = NREF(I)                                   77
         LI,V0    0                 CLEAR SAVE DECA FLAG                24
         STH,V0   JSAVD                                                 25
         LAB,L0   BCE11,BCE42+1     SET UP/DOWN NEXT I                  26
* UP/DOWN BY 1                                                           1
BCE60    RES      0                                                      2
         STH,D1   JSUBF             SET JSUBF(<0 IF INDEX RF3DS)         3
         BE       BCE70             ZERO CLUSTER NOT WRITTEN             4
* ZERO CLUSTER WRITTEN                                                   5
         BAL,L1   BAA46             SAVE VAR FLAG
         CI,R1    4                 CHECK CLNG                           7
         BE       BCE70             SINGLE RFLD                          8
         MTW,1    LITF
         MTW,1    NOVF
* MULTIPLE RFLDS                                                         9
         STB,D1   MCBUF             SAVE NREF                           10
         LI,V1    DWCB              LOAD WRITE STACK CNTL               11
         CI,D1    X'8000'           CHECK INDEX FLAG                    12
         BAZ      BCE64             DOWN. NO INDEX RFLDS                13
* INDEX RFLDS                                                           14
         LI,V1    DWIB              LOAD INDEX WRITE STACK CNTL         15
BCE64    RES      0                                                     16
         LH,R1    V1                LOAD,CHECK RFLD TYPE(I)
         BNEZ     BCE65             I NOT= 0, NOT INDEX                 18
* RFLD = INDEX                                                          19
         LH,R3    MCBUF+5           LOAD NREF(INDEX)
         B        BCE65+1
BCE65    RES      0                                                     21
         LH,R3    MCBUF+1,R1        LOAD,CHECK NREF(I)                  22
         BEZ      BCE66             NREF(I) = 0
* NREF(I) NOT= 0                                                        24
         AI,R1    -2                ADJUST I                            25
         STW,V1   BBCNI             SAVE WRITE STACK CNTL               26
         STH,R1   BBCRI             SAVE I
         BAL,L0   BCE72             UP/DOWN BY 1                        27
         BDR,R3   BCE68             NREF(I) = NREF(I)-1
* NREF(I) = 0                                                           29
         MTB,-1   MCBUF             NREF = NREF-1                       30
         BEZ      BAA02             E-O-SET UP/DOWN BY 1                31
         LW,V1    BBCNI             LOAD WRITE STACK CNTL               32
         LI,R3    0                 CLEAR NREF(I)                       29
* OBTAIN NEXT I                                                         33
BCE66    RES      0
         STH,R3   V1                CLEAR I                             35
         SLS,V1   3                 POSITION NEXT I                     36
         B        BCE64                                                 37
* SET NEXT I FLD UP/DOWN BY 1
BCE68    RES      0
         LH,R1    BBCRI             LOAD I
         BAL,L1   BAA46             SAVE VAR FLAG
         B        BCE72+1
*
* SINGLE RFLD                                                           40
BCE70    RES      0                                                     41
         LW,R1    D1                LOAD RFLD TYPE                      42
         LI,R3    1                 NREF = 1
         LI,L0    BAA02             SET LINK REGISTER                   43
         MTW,1    LITF
         MTW,1    NOVF
*                        R1 = RFLD TYPE(I)                              44
BCE72    RES      0                                                     45
         STW,L0   BBCSAV            SAVE LINK REGISTER                  46
         EXU      ECE72+1,R1        EXU ON I                            47
* RFLD = INDEX                                                          48
*                        D1 = SUBFR                                     49
         BEZ      BCE76             SUBFR = 0, INDEX DATA               50
* RFLD = INDEX NAME                                                     51
         CH,D1    JSUBF             COMPARE SUBFR,SUBF                  52
         BE       BCE74             =. RI LOADED.                       53
* NOT=, LOAD SUBFR                                                      54
         LI,V0    CLI+CRI           LOAD LI,RI                          55
         LH,R7    MDBUF-1           LOAD,CHECK DOWN BY FLAG             56
         BEZ      BCE73                                                 57
* DOWN BY                                                               58
         AI,V0    X'F'              SET LI,RI -                         59
         LCW,D1   D1                COMPLEMENT SUBFR                    60
BCE73    RES      0                                                     61
         BAL,L1   PIA02             WRITE LI,RI +/-SUBFR                62
* ***                    RI = +/-SUBFR                                  63
BCE74    RES      0                                                     64
         LH,D3    2,R2              LOAD,COMBINE BASE,DISPL             65
         LH,D2    2,R5                                                  66
         STH,D2   D3                                                    67
         BAL,L1   PID16             WRITE                               68
         AWM,RI   2                 ****  AWM,RI INDEX                  69
         B        *BBCSAV           RETURN                              70
* SET UP/DOWN BY 1 - RFLD TYPE                                          91
         LH,D1    4,R5              INDEX - LOAD SUBFR                  92
ECE72    RES      0                                                     93
         B        *BBCSAV           DESCENDING - NOP                    94
         B        BCE90             ASCENDING                           95
         B        BCE80             FLL                                 96
         B        BCE80             FLS                                 97
         B        BCE76             BIN                                 98
* RFLD = BIN/INDEX DATA                                                 71
BCE76    RES      0                                                     72
         BAL,L1   SSB00             CHECK SUBSCRIPTS                    73
         AI,V0    CMTW+X'10'        FORM MTW,1 -(,SXR)                  74
         LH,R7    MDBUF-1           LOAD,CHECK DOWN BY F3AG             75
         BEZ      BCE78             DOWN. UP BY                         76
         AI,V0    X'E0'             FORM MTW,-1 -(,SXR)                 77
BCE78    RES      0                                                     78
         BAL,L1   CALVP
         BAL,L1   PID11             WRITE MTW,+/-1 RFLD(,SXR)           79
         B        *BBCSAV           RETURN                              80
* RFLD = FLS/FLL                                                        81
BCE80    RES      0                                                     82
         BAL,L1   SSB00             CHECK SUBSCRIPTS                    83
         LW,V1    V0                SAVE  (,SXR)                        83
         CI,R7    X'E'              CHECK RFLD CLASS                    84
         BE       BCE82             RFLD = FLS                          85
* RFLD = FLL                                                            86
         MTW,1    VBIDX             DA
         AI,V0    CLD-CLW           SET FOR LD(-LW)                     87
BCE82    RES      0                                                     88
         AI,V0    CLW+CRFL          FORM LW/LD,RFL -(,SXR)              89
         BAL,L1   CALVP
         BAL,L1   MDF65                                                 COBOL42D
         EOR,V0   V1                MASK (,SXR)                         91
         AI,V0    CFAS-CLW          FORM FAS/FAL,RFL OR                 92
         SH,V0    MDBUF-1           *    FSS/FSL,RFL                    93
         LBAL     PRG02,DGF1,D1     WRITE FAS/FAL,RFL = FS/FL'1.E0' OR  94
*                                   ****  FSS/ESL,RFL=FS/FL'1.E0'       95
* **                     D2 = LW/LD,RFL -(,SXR)                         95
         MTB,6    D2                FORM STW/STD,RFL  -(,SXR)           96
         LBAL     PID14+1,DAID,D1   WRITE STW/STD,RFL RFLD(,SXR)        97
         B        *BBCSAV           RETURN                              98
* RFLD = NC/ND
BCE90    RES      0
         LH,V1    4,R5              LOAD,CHECK DECPR
         BEZ      BCE96             = 0. INTEGER
         BL       *BBCSAV           . 0. NOP.
* DECPR > 0.
         BAL,L1   PRG06             WRITE
         DL,1     DGD1              ****  DL,1 D'+1'
         LI,V1    0                 DECPS = 0                            8
         LI,D0    1                 DSIZS = 1                            9
         STW,V1   JDECP             SAVE DECPS,DSIZS
         STW,D0   JDSIZ
         LH,R7    MDBUF-1           LOAD,CHECK DOWN BY FLAG              1
         BEZ      BCE12             DOWN. UP BY.
* DOWN BY                                                                3
         BAL,L1   PIA26             WRITE
         AI,D3    1                 ****     NEGATE                      5
         CI,R3    1                 CHECK NREF(I)
         BLE      BCE12             NREF (I) = 1
* NREF(I) > 1
         MTW,DSG  JSAVD             RAISE DECA SAVED FLAG
         BAL,L1   ODR00             ALIGN RFLD
         LH,V1    4,R5              LOAD DECPR
         B        BCE15-2
* NC/ND  INTEGER
BCE96    RES      0
         LI,R6    CRB+8             LOAD RREG,RFLD CLASS
         BAL,L0   SARTHF
         BAL,L0   LRD00             LOAD DL/PACK RFLD
         LI,V0    CDA+X'10'         LOAD DA,1
         SH,V0    MDBUF-1           FORM DA/DS,1
         LBAL     PRG02,DGD1,D1     WRITE DA/DS,1 D'+1'
         BAL,L0   MDS00             WRITE DSI/UNPK RFLD(SXR)
         B        *BBCSAV           RETURN
*
CALVP    STW,L1   TMPL1
         MTW,2    VBIDX             WA
         MTW,0    RFLDF
         BLZ      CALVP1            VAR REC SAVED
         BAL,L0   VPP30             VAR REC ADDR
         B        *TMPL1
CALVP1   BAL,L0   VPP50
         B        *TMPL1
SARTHF   STW,L0   TMPL0             SET SAVE VAR REC FLAGS
         LI,L0    0
         XW,L0    LITF
         STW,L0   TMPD0
         LI,L0    1
         STW,L0   ARTHF
         B        *TMPL0
VMAD     DATA     0                 TEMP ADDR FOR V0, V1
VEXBT    DATA     0                 DISPLAY/EXHIBIT FLAG
         DATA     0
         DATA     0
AJAD     DATA     0
TMPV0    RES      1
TMPL0    RES      1
TMPL1    RES      1
TMPD0    RES      1
MSGREG   RES      8
KSTDR    GEN,8,8,8,8 CRI,CRB,CRFL,CRFL      STANDARD REGISTERS          91
KRTYP    GEN,8,8,8,8 8,9,9,9
         GEN,8,8,8,8 0,0,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
         REF      SSSAV
SSSD0    EQU      SSSAV+10
         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
JUNSD    EQU      JDSIZ+21          UNSIGNED FLAG
JPSIZ    EQU      JDSIZ+23          ANE PSIZ
*                                                                       65
JSET     EQU      JDSIZ+24          SET UP/DOWN
         REF      BCASAV            CONDITIONAL
BCASI    EQU      BCASAV+2          SFLD
BCARI    EQU      BCASAV+3          RFLD TYPE
BCANT    EQU      BCASAV+4          TYPE BITS,NTYP
*
BBCSI    EQU      BBCSAV+3          SFLD TYPE
BBCRI    EQU      BBCSAV+4          RFLD TYPE
BBCNI    EQU      BBCSAV+4          NREF(I) CNTL
BBCLD    EQU      BBCSAV+5          NLIT DECPS
*                                                                       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
K303     EQU      KBKON+9
K4SPAC   EQU      K4BAS+1
K4AST    EQU      K4BAS+2
KUNPKA   EQU      K6BAS+1
KUNPK4   EQU      K6BAS+2           UNPKA+1
KMSG     EQU      K6BAS+3           MSG AREA
BBCOSI   RES      1                                                     COBOL42D
         END
