         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.2 - STORE-1'
* 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 CLASS,BRANCH
CLAS     CNAME
         PROC
* LF     CLAS,CF(2) AF(1),AF(2),AF(3),AF(4),AF(5),AF(6)
*            REG   CLASS B >/= CLASS B >   B =   B
LF       CI,CF(2) AF(1)             CHECK CLASS
         BGE      AF(2)-AF(1),CF(2) >/=,
         DO       NUM(AF(3))
         CI,CF(2) AF(3)
         FIN
         DO       NUM(AF(4))
         BG       AF(4)             >
         FIN
         DO       NUM(AF(5))
         BE       AF(5)             =
         FIN
         DO       NUM(AF(6))
         B        AF(6)             <
         FIN
         PEND
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      PIA00,PIA02,PIA06,PIA08,PIA20,PIA22,PIA26,PIA28
         REF      PII00,PII02,PII20,PII22
         REF      PIL00,PIL02,PIL06,PIL20,PIL22,PIL26
         REF      PID10,PID11,PID12,PID14,PID16,PID18
         REF      PIP00,PIP02,PIP20,PIP22
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PRB00,PRB02,PRB06,PRB20,PRB22,PRB26
         REF      PRE00,PRE01,PRE02,PRE20,PRE21,PRE22
         REF      PRF00,PRF02,PRF06
         REF      PRG00,PRG02,PRG06,PRG20,PRG22,PRG26
         REF      PRT00,PRT02,PRT06,PRT20,PRT22,PRT26
         REF      PDB00,PDB02,PDB06
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDL10,PDL12,PDL16
         REF      PPI10,PPI11,PPI12
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      LRA00,LRA01,LRA02
         REF      LRR00,LRR01,LRR02
         REF      LRD00,LRD01
         REF      LRD10,LRD11,LRD20,LRD21
         REF      LRD40,LRD41,LRD42
         REF      LRD60,LRD61,LRD62,LRD80,LRD81,LRD82
         REF      LRL00,LRL01
         REF      MRR10,MRR11,MRR12
         REF      MRR40,MRR41,MRR42
         REF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
         REF      VARF,VPP00,VPP05
         REF      VPP10,VPP30,VMAD
         REF      VRSAV,VBIDX,CONDB
         REF      VAL00,DIFLG
         REF      NRR10,NRR11,NRR12
         REF      NRR40,NRR41,NRR42
         REF      NRR60,NRR61,NRR62,NRR80,NRR81,NRR82,NRR70
         REF      NRD00,NRD01,NRD02
         REF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         REF      ORD12,ORD22,ORD23,ORD24
         REF      ODR32,ODR34
         REF      ODR40
         REF      ORD42,ORD44,ORD48
         REF      OII00,OII01,OII02
         REF      MTL20
         REF      NDR30,NDR31,NDR32
         REF      LNKSF,NDR34,NDR10
         REF      NDR38,NDR39
         REF      NDR40
         REF      MDE00,MDE02
         REF      NDE00,NDE02,NDE20,NDE50
         REF      ODE02,ODE04,ODE10,ODE16
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      LIT00
         REF      WRPOF
         REF      RDMCF
         REF      JCREF             CONDITION FLAG                      COBOL42M
         REF      JSXR                                                  COBOL42M
         DEF      DGSRD,GRMVF,LITF
         DEF      SAVV0,CONDF,MAREF
         DEF      RLNTH,MDF04,MBS70
         DEF      VAM001,SVARF,BADJ
         DEF      VPLIT,LITVR,FXLIT
         DEF      VAM50,VAM60,LADJ
         DEF      MDF65,SLNKF
         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
RFL      EQU      V0                FLP
RF       EQU      V2                FILE CNTL
RS       EQU      V2                SIGN - EDIT
RC       EQU      L1                %
P1       EQU      V2                PREG 1
SR1      EQU      8                 SR1
SR3      EQU      X'A'              SR3
* BA(D-)
CBD0     EQU      X'30'
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'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'
CIBC     EQU      RB-4              CONVERT BIN
CIFC     EQU      RFL-4             CONVERT FLP
* 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
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRFL     EQU      CRV0              FLP
CRS      EQU      CRV2              SIGN - EDIT
CRF      EQU      CRV2              FILE CNTL
CRC      EQU      CRL1              %
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES
CCAL1    EQU      X'0400'           CAL1
CLD      EQU      X'1200'                                               C12
CSTD     EQU      X'1500'
CFAL     EQU      X'1D00'                                               C194
CAI      EQU      X'2000'                                               C20
CLI      EQU      X'2200'           LI                                  C22
CLI1     EQU      X'2210'           LI,1                                C221
CMI      EQU      X'2300'
CSF      EQU      X'2400'                                               C24
CS       EQU      X'2500'                                               C25
CAW      EQU      X'3000'
CCW      EQU      X'3100'           CW
CSW      EQU      X'3800'           SW
CSTW     EQU      X'3500'           STW                                 C35
CLW      EQU      X'3200'                                               C32
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
CSAS     EQU      X'400'            RA SETING - SAS                     C484
CSDA     EQU      X'500'            RA SETTING - SAD                    C485
COR      EQU      X'4900'           OR                                  C49
CAND     EQU      X'4B00'
CLAH     EQU      X'5B00'
CMBS     EQU      X'6100'
CBDR     EQU      X'6400'                                               C64
CEXU     EQU      X'6700'                                               C67
CBR      EQU      X'6800'           B                                   C68
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CBL      EQU      X'6910'           BL                                  C691
CBNE     EQU      X'6930'           BNE,BNEZ
CLCI     EQU      X'0220'
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CPACK    EQU      X'7600'                                               C76
CUNPK    EQU      X'7700'
CDSA     EQU      X'7C00'
CDL      EQU      X'7E00'                                               C795
CDST     EQU      X'7F00'
CIND     EQU      X'8000'           INDIRECT BIT                        C900
* 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
* REGISTER SAVE LEVELS
DSS      EQU      1                 SUBSCRIPT
DSL      EQU      2                 STORE
DSG      EQU      4                 GENERATOR
* RESET REGISTER SAVE LEVEL VALUES
DSAR     EQU      X'F'
DSLR     EQU      X'E'
DSSR     EQU      X'C'
* GLOBAL LITERAL WA DISPL - BASE 4
DGDZ     EQU      4                 D'+0'
DGD1     EQU      3                 D'+1'
DGFZ     EQU      6                 FL'0.E8'
* GLOBAL LITERAL BA DISPL - BASE 4
DGZRO    EQU      0                 ZERO
DGSPC    EQU      1                 SPACE
DGQUO    EQU      2                 QUOTE
DGLV     EQU      3                 LOW-VALUE
DGHV     EQU      4                 HIGH-VALUE
DGAST    EQU      6                 ASTERISK
* 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
*
* ENTRY POINTS
         DEF      MDF01
         DEF      MDF21,MDF61
         DEF      NDF00,NDF02,NDF04 ZERO,*,SPACE FILL
         DEF      MBS00,MBS01,MBS02
         DEF      MBS42,MBS62
         DEF      NBS00,NBS02,NBS04
         DEF      NBS20,OBS20
         DEF      NBS62
         DEF      OBS14
         DEF      OBS90
*
* ZERO/BLANK-FILL
* RFLD = GRP/AN/ANE - BLANK FILL
MDF00    RES      0
*                        R2 = HA(CLOC)
MDF01    RES      0
         LH,R7    0,R2              LOAD,MASK RFLD CLASS
         AND,R7   K30F
*                        R7 = RFLD CLASS
*                        L0 = LINK REGISTER
MDF02    RES      0
         STW,L0   MDFSAV            SAVE LINK REGISTER
         CI,R7    3                 CHECK RFLD CLASS
         BGE      MDF12             RFLD = ANE
* RFLD = GRP/AN
         LBAL,L0  NDR31+1,CRR1      WRITE ADCON BSIZR,BA(RFLD)
         LI,V0    R1
         BAL,L0   VPP00             RESOLVE VAR REC
*                                   ****  LW/AW,R1 ADCON
         MTW,0    VARF
         BGEZ     MDF05             NO VAR LNTH
         LW,D1    MDFSAV
MDF04    STW,D1   MBSSAV
         LH,D1    3,R2
         CI,D1    255
         BG       %+2               RFLD > 255
         LI,D1    0
         STW,D1   RLNTH
         LH,D1    3,R2              RLNTH
         B        MBS261
MDF05    BAL,L0   NDF04             BLANK PAD
         B        *MDFSAV           RETURN
*
* RFLD = ANE
MDF12    RES      0
         BAL,L0   NDR31             WRITE ADCON BSIZR,BA(RFLD)
*                                   ****  LW/AW,RO ADCON
         BAL,L0   NDR40             MOVE EDIT MASK TO RFLD
* ***                    EDIT MASK SET TO SPACE
         B        *MDFSAV           RETURN
*
* RFLD = NC/NE/ND - ZERO FILL
MDF21    RES      0
         LH,R7    0,R2              LOAD,MASK RFLD CLASS
         AND,R7   K30F
*                        R7 = RFLD CLASS
MDF22    RES      0
         STW,L0   MDFSAV            SAVE LINK REGISTER
         CI,R7    5                 CHECK RFLD CLASS
         BE       MDF42             RFLD = NE
* RFLD = ND/NC
         CI,R7    8                 CHECK RFLD CLASS
         BANZ     MDF32             RFLD = NC
*
* RFLD = ND
         LH,V1    3,R2              LOAD BSIZR
         LBAL,L0  NDR31+2,CRR1      WRITE ADCON BSIZR,BA(RF
         LI,V0    R1
         BAL,L0   VPP10             RESOLVE VAR REC
*                                   ****  LW/AW,R1 ADCON
         BAL,L0   NDF00             ZERO FILL
         B        *MDFSAV           RETURN
*
* RFLD = NC/ND(BSIZR ODD)
MDF32    RES      0
         BAL,L1   SSB01             CHECK SUBSCRIPTS
         LB,L1    JZREG             CHECK DECA ZERO FLAG                 4
         BNEZ     MDF34             UP. DECA = D'+0'                     5
         BAL,L1   PRG06             WRITE
         DL,1     DGDZ              ****  DL,1 =D'+0'
         STB,D1   JZREG             RAISE DECA ZERO FLAG                 7
MDF34    RES      0                                                      8
         AI,V0    CDST-CDL          SET FOR DST(-DL)
         BAL,L1   ORD22             WRITE DST,L RFLD(,SXR)
         B        *L0               RETURN
*
* RFLD = NE
MDF42    RES      0
         LH,R6    5,R5              LOAD EDITING INFORMATION
         CI,R6    X'800'            CHECK BWZ/*WZ FLAG
         BANZ     MDF46             UP. BLANK/* FILL
* NO BWZ/*WZ
         BAL,L0   NDR31             WRITE ADCON BSIZR,BA(RFLD)
*                                   ****  LW/AW,RO ADCON
         LB,L1    JZREG             CHECK DECA ZERO FLAG                 4
         BNEZ     MDF43             UP. DECA = D'+0'
         BAL,L1   PRG06             WRITE
         DL,1     DGDZ              ****  DL,1 =D'+0'
         STB,D1   JZREG             RAISE DECA ZERO FLAG                 7
MDF43    RES      0
         MTW,1    LITF
         BAL,L0   NDR40             WRITE LI,RE BA(MASK)
*                                   ****  MBS,RE 0
         LH,V1    3,R5               GET DECIMAL SIZE                   COBOL42M
         AW,R5    R5                HA(CLOC)-1 TO BA
         BAL,L1   ODE04             CHECK,CHANGE EDIT FLAGS
         B        MDF44             NO FLOATING +/- OR TRAILING +
         BAL,L1   ODE10             WRITE LI,RS C'+'/C' '
MDF44    RES      0
         BAL,L1   ODE16             CHECK, ADJUST RO
         B        MDF45             NO LEADING +/-
* LEADING +/-
         LI,R1    X'14000'          CLEAR LEADING +/- FLAGS
         AND,R1   R6
         EOR,R6   R1
MDF45    RES      0
         BAL,L0   NDE20             EDIT BYTE STRING
         B        *MDFSAV           NO TRAILING SIGN INSERTIONS. RETURN.
* TRAILING + AND/OR TRAILING -/DB/CR WITH TRAILING INSERTIONS
         BAL,L0   NDE50             INSERT TRAILING SIGNS
         B        *MDFSAV           RETURN.
* BWZ/*WZ
MDF46    RES      0
         LBAL,L0   NDR31+1,CRR1     WRITE ADCON BSIZR,BA(RFLD)
*                                   ****  LW,R1 ADCON
         AW,R5    R5                HA(CLOC)-1 TO BA
         BAL,L1   ODE02             SET BWZ/*WZ FLAGS
         BAL,L0   NDE02             BLANK/* FILL RFLD
         B        *MDFSAV           RETURN
*
* RFLD = BIN/FLP
MDF61    RES      0
         LH,R7    0,R2              LOAD,MASK RFLD CLASS
         AND,R7   K30F
MDF62    RES      0
         BAL,L1   SSB01             CHECK SUBSCRIPTS
         CW,R7    JZREG             CHECK ZERO REG. FLAG                 1
         BANZ     MDF63             UP. R7 = 0                           2
         BAL,L1   PIA06             WRITE
         LI,R7    0                 ****     CLEAR ODD REGISTER
         AWM,R7   JZREG             RAISE ZERO REG FLAG                  5
MDF63    RES      0                                                      6
         CI,R7    X'F'              CHECK RFLD CLASS
         BE       MDF631            FLL RFLD
         BAL,L1   PIA06
         LW,R6    R7                **** WRITE LW,R6  R7
         AI,V0    -X'10'
         B        MDF64
MDF631   RES      0
* RFLD = FLL
         AI,V0    CSTD-CSTW
         MTW,1    VBIDX
MDF64    RES      0
         AI,V0    CSTW+CRR7         FORM STW/STD,R7  -(,SXR)
         MTW,2    VBIDX
         STW,L0   TMPL0
         BAL,L0   VPP30
         LW,L0    TMPL0
         LW,L1    L0                RETURN ADDR
MDF65    MTW,0    LNKSF
         BEZ      PID11             WRITE STW/STD,R7 WA(RFLD),(SXR)
         LI,D3    0
         STW,D3   LNKSF             RESET LINKAGE FLAG                  COBOL42M
         B        PIA22             WRITE STW/STD,R7 0,SXR
*
*
* ZERO-FILL
NDF00    RES      0
         LW,D3    K4BAS             LOAD ZERO BASE DISPL(=BASE)
         B        NDF04+1
* *-FILL
NDF02    RES      0
         LW,D3    K4AST             LOAD * BASE,DISPL
         B        NDF04+1
* BLANK-FILL
NDF04    RES      0
         LW,D3    K4SPAC            LOAD SPACE BASE,DISPL
         LI,V0    CMBS              LOAD MBS,0
         B        NBS02             WRITE MBS,0 BA(FILL-CHAR.)
*
* BYTE STRING MOVE
* MBS - NOT JUSTIFIED,RIGHT PAD
MBS00    RES      0
*                        V0 = RE
*                        D0 = BSIZS
*                        L0 = LINK REGISTER
*                        JSFLD = 0/SFLD BASE,DISPL                       8
MBS01    RES      0
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL, SUBSCRIPT FLAG 4
         LW,V0    JSFLDS                                                 5
MBS02    RES      0
         STW,L0   MBSSAV            SAVE LINK REGISTER
         LH,V1    3,R2              LOAD BSIZR
         CI,D0    1                 CHECK BSIZS                          2
         BE       MBS20             BSIZS = 1
         CI,V1    1                 CHECK BSIZR                          3
         BE       MBS20             BSIZR = 1
* BSIZS,BSIZR NOT= 1                                                     6
         SW,D0    V1                BSIZS = BSIZS-BSIZER(=PSIZ)
         STW,D0   DGSRD
         BGEZ     MBS04             >/=0, BSIZS >/= DSIZR
* < 0, BSIZS < BSIZR
         AW,V1    D0                BSIZR = BSIZR+(BSIZS-BSIZR) (!BSIZS)
MBS04    RES      0
         AWM,V1   JMBSIZ            UPDATE SFLD M(OVED)BS CNT
         CI,D3    0                 CHECK SFLD BASE,DISPL
         BEZ      MBS06             = 0, LI,RE BA(SFLD) GENERATED
         CI,V0    0                 CHECK SUBSCRIPT FLAG
         BL       MBS06             UP. SFLD SUBSCRIPTED
* SFLD NOT SUBSCRIPTED
         LW,D2    D0                SAVE PSIZ
         BAL,L1   OBS20             WRITE LI,RE BA,HA BITS/0
         LW,D0    D2                LOAD PSIZ
         AI,V0    -CLI              SET RE
MBS06    RES      0
         AI,V0    X'10'             RE = RE+1
         BAL,L0   NDR32             LOAD MIN(BSIZR,BSIZS),BA(RFLD)
*                        R1 = RPTCNT
*                        D0 = PSIZ(PRESERVED)
         AND,V0   K3E0              MASK RE
         STW,V0   SAVV0             SAVE RE
         AI,V0    CMBS              FORM MBS,RE
*
         LCW,V1   D0                SAVE -PSIZ
         BAL,L1   MBS70
         LW,L1    LADJ
         AW,L1    BADJ
         BEZ      MBS10             NOT VAR REC MOVE
         LI,L1    0
         STW,L1   LADJ
         STW,L1   BADJ
         B        *MBSSAV           RETURN
* CHECK PSIZ
MBS10    RES      0
         CI,V1    1                 CHECK PSIZ                           2
         BL       *MBSSAV           < 0, NO PAD                          3
* PAD REQUIRED
         BE       MBS14             = 1, SINGLE PAD CHAR.                5
* PSIZ > 1
*                        D2 = 0,-/MBS,RE,-
MBS12    RES      0
         BAL,L1   OBS02             WRITE LW,R1 RO
         BAL,L1   ODR32             OBTAIN MBS COUNT,RPTCNT
*                        V0 = -,L
*                        V1 = RPTCNT,SXR/0
*                        D0 = PSIZ
         LB,R1    V1                SAVE RPTCNT
         LI,R4    2                 LOAD INDEX REGISTER
         LB,D1    V0,R4             LOAD L
         LBAL     PIA02,CLI+CRV2    WRITE LI,V2 PSIZ
         BAL,L1   PIA06             WRITE
         STB,V2   R1                ****     STORE PSIZ
         BAL,L0   NDF04             BLANK FILL RFLD
         B        *MBSSAV           RETURN
*                                                                        0
* PSIZ = 1
MBS14    RES      0
         LH,V0    D2                LOAD,CHECK -,RO                      7
         BNEZ     MBS15             NOT= 0(=-,RO)                        8
         LH,V0    D3                LOAD -,RO                            9
MBS15    RES      0                                                     10
         BAL,L1   PIA06             WRITE                               13
         LI,V2    C' '              ****     LOAD SPACE                 14
         AND,V0   K3E0              MASK,POSITION RE(FORCE EVEN)
         SLS,V0   -3                                                    12
         AI,V0    CSTB+CRV2+2       LOAD STB,V2  -,RO                   16
         LBAL,L1  PIY01,0,D1        WRITE STB,V2 0,RO                   15
         B        *MBSSAV           RETURN                              17
*                                                                        2
* BSIZS/BSIZR = 1                                                        3
*                        V0 = 0/SXR                                      9
*                        V1 = BSIZR                                      4
*                        D0 = BSIZS                                      5
*                        D3 = SFLD BASE,DISPL                           10
MBS20    RES      0
         SW,V1    D0                PSIZ = BSIZR-BSIZS                   7
         BAL,L0   NBS20             CHECK SUBSCRIPT, LOAD BYTE OFFSET
         AI,V0    CLB+CRR4          FORM LB,R4 -(,SXR)                  11
         CI,D3    0                 CHECK BASE,DISPL
         BE       MBS21             = 0, NOT DATA REF                   COBOL42M
         MTW,0    SLNKF             LINKAGE SECTION                     COBOL42M
         BEZ      MBS22             NO                                  COBOL42M
MBS21    RES      0                                                     COBOL42M
* SXR = BA(SFLD)(+SUBSCRIPT)
         LAB,L1   PIA22,MBS23       WRITE LB,R4 0,SXR
* DATA REF
MBS22    RES      0
         BAL,L0   VPP30             RESOLVE VAR REC
         BAL,L1   MDF65             WRITE LB,R4 0/SFLD(,SXR)
MBS23    RES      0
         MTW,1    JSXR              SXR TO R3                           COBOL42M
         BAL,L1   SSB00             CHECK SUBSCRIPT                     13
         MTW,-1   JSXR              RECOVER SXR (SET TO R2)             COBOL42M
*                        V0 = 0/SXR                                     14
         AI,V0    CSTB+CRR4         FORM STB,R4  -(,SXR)                15
         BAL,L0   VPP30             RESOLVE VAR REC
         BAL,L1   MDF65             WRITE STB,R4 0/RFLD(,SXR)
         CI,V1    1                 CHECK PSIZ(=BSIZR-BSIZS)            17
         BL       *MBSSAV           < 1, NO PAD                         18
* PAD REQUIRED                                                          19
         BG       MBS26             PSIZ > 1                             2
         MTW,0    VARF
         BNEZ     MBS26             VAR REC
* PSIZ = 1                                                               5
*                        V0 = OP CODE,R-  -(,SXR)                        3
*                        D3 = RFLD BASE,DISPL                            4
MBS24    RES      0                                                      1
         BAL,L0   NBS24             CHECK,SET SXR/R1                     6
         BAL,L1   PIA06             WRITE                                7
         LI,V2    C' '              ****     LOAD PAD                    8
MBS25    RES      0                                                      6
         AI,V0    CSTB+CRV2         FORM STB,V2  -,SXR/R1                9
         BAL,L1   MDF65             WRITE STB,V2 0/RFLD,SXR/R1
         B        *MBSSAV           RETURN                              11
* PSIZ > 1                                                              12
MBS26    RES      0                                                     13
         STW,V1   DGSRD
         BAL,L1   OBS24             CHECK SUBSCRIPTS/BYTE OFFSET        14
*                        V0 = LI,R1 IF NO SUBSCRIPT/BYTE OFFSET OR      15
*                           = AI,SXR IF SUBSCRIPTS/BYTE OFFSET          16
         CI,D3    3                                                     COBOL42M
         BAZ      %+2               NO BA/HA OFFSET                     COBOL42M
         SW,D3    SSSD1             BA/HA OFFSET                        COBOL42M
         AI,D3    1                 DISPL = DISPL+1                     17
         AI,V0    -CLI              SET FOR AW/LW,SXR/R1
         BAL,L0   NDR32+2           SET L,RPTCNT
*                                   WRITE ADCON L,BA(RFLD)
*                                   ****  AW/LW,SXR/R1 ADCON
         LI,D1    X'F0'             MASK SXR/R1
         AND,D1   V0
         LBAL     ORR06,CRR1        CHECK,LOAD R1
         LW,D1    DGSRD
         MTW,0    VARF              IS THIS A VARIABLE RECORD           COBOL42M
         BEZ      MBS27             NO                                  COBOL42M
MBS261   RES      0
         LBAL     PIA02,CLI+CRV0    **** WRITE LI,V0  (DGSRD)
         BAL,L1   PIA06
         SW,V0    0,R7              **** WRITE SW,V0  0,R7
         MTW,0    VARF
         BGEZ     MBS27
         LI,V0    R1
         STW,V0   TMPRE
         MTW,0    RLNTH
         BNEZ     MBS262
         BAL,L1   VAM10
         B        *MBSSAV
MBS262   BAL,L0   VAM40             RFLD > 255
         B        *MBSSAV
MBS27    BAL,L0   NDF04             WRITE MBS,0  (SPACE)
         B        *MBSSAV           RETURN
*
* RFLD = AN                                                              1
*                        R7 = RFLD CLASS                                 2
*                        D0 = DSIZS/0                                    3
MBS42    RES      0                                                      4
         STW,L0   MBSSAV            SAVE LINK REGISTER                  34
         LH,V1    3,R2              LOAD BSIZR                           5
         AND,V1   K2FFFF            SIDR 4385                           COBOL42M
         CI,D0    0                 CHECK DSIZS                          6
         BE       MBS48             = 0, FIGCON/ALL '1 CHAR' LIT FILL    7
* SFLD = ZERO LIT                                                        8
         CW,D0    V1                COMPARE DSIZS,DSIZR                  9
         BGE      MBS48             DSIZS >/= DSIZR, ZERO FILL          10
* DSIZR > DSIZS, PAD REQUIRED                                           11
         CI,R7    2                 CHECK RFLD CLASS                    12
         BAZ      MBS46             RFLD = AN                           13
* RFLD = ANJR                                                           14
         SW,V1    D0                PSIZ = DSIZR-DSIZS                  16
         LBAL,L0  NDR32,CRR1        WRITE ADCON PSIZ,BA(RFLD)           17
*                                   ****  LW/AW,R1 ADCON                18
         BAL,L0   NDF04             BLANK PAD                           19
         LW,V1    JBSIZ             LOAD BSIZS                          20
MBS44    RES      0                                                     210
         LW,D3    D2                SAVE MBS,RE  0
         BAL,L0   NDR30             OBTAIN RPTCNT
*                                   WRITE LI,V2 L
         BAL,L1   OBS14             WRITE STB,V2 RO
         LW,D2    D3                RESTORE MBS,RE 0
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         LI,V0    R1
         BAL,L1   LITVR
         LBAL     PID14+1,DAID,D1   WRITE MBS,RE BA(SFLD)
         MTW,0    VARF
         BGEZ     MBS45             NO VAR LNTH
         BAL,L1   VPLIT
         LBAL     PID14+1,DAID,D1   **** WRITE MBS,RE  BA(SFLD)
         MTW,0    RLNTH                                                 COBOL42M
         BEZ      *MBSSAV                                               COBOL42M
MBS441   BAL,L1   VAM50                                                 COBOL42M
         B        *MBSSAV
MBS45    RES      0
         BAL,L0   NBS10             CHECK,WRITE REPEATED MBS            32
         B        *MBSSAV           RETURN                              33
*                                                                       33
* RFLD = AN                                                             33
MBS46    RES      0                                                     34
         SW,V1    D0                PSIZ = DSIZR-DSIZS                  35
         XW,V1    D0                EXCHANGE PSIZ,DSIZS                 36
         LBAL,L0  NDR32,CRR1        WRITE ADCON DSIZR,BA(RFLD)          37
         LI,V0    R1
         BAL,L1   LITVR
*                                   ****  LW/AW,R1 ADCON                38
         LW,V1    D0                SAVE PSIZ                           40
         LBAL,L0  NBS00,CMBS        WRITE MBS,0 BA(SFLD)
         LW,V0    V1                LOAD,CHECK PSIZ
         BDR,V0   MBS12+1           PSIZ > 1
* PSIZ = 1
         B        MBS15             WRITE LI,V2 C' '
*                                   ****   STB,V2 0,R1
*                                                                       44
* SFLD = FIGCON OR SFLD = ZERO LIT AND DSIZS >/=DSIZR                   45
*                        V1 = DSIZR                                     46
MBS48    RES      0                                                     47
         LBAL,L0  NDR32,CRR1        WRITE ADCON DSIZR,BA(RFLD)          48
*                                   ****  LW/AW,R1 ADCON                49
         LI,V0    R1
         BAL,L1   LITVR
         MTW,0    VARF
         BGEZ     MBS482
         LW,D3    JSFLD
         LBAL     PID10,CMBS        **** WRITE MBS,0  BA(SFLD)
         MTW,0    RLNTH                                                 COBOL42M
         BEZ      *MBSSAV                                               COBOL42M
         BAL,L1   VPLIT
         LBAL     PID10,CMBS        **** WRITE MBS,0  BA(SFLD)
         B        MBS441
MBS482   RES      0
         LBAL,L0  NBS00,CMBS        WRITE MBS,0 BA(SFLD)
         B        *MBSSAV           RETURN                              52
*                                                                        0
* RFLD = ANE                                                            30
*                             R7 = RFLD CLASS                           32
*                             D0 = DSIZS/0                              31
MBS62    RES      0                                                     33
         STW,L0   MBSSAV            SAVE LINK REGISTER                  34
         BAL,L0   NDR31             CHECK SUBSCRIPTS                    35
*                                   WRITE ADCON BSIZR,BA(ANE FLD)       36
*                                   ****  LW/AW,RO ADCON                37
*                        V1 = BSIZR                                     38
*                        D0 = DSIZS/0(PRESERVED)                        39
         BAL,L0   NDR40             WRITE LI,RE  BA(EDIT MASK)          40
*                                   ****  MBS,RE  0                     41
*                        R7 = RFLD CLASS                                42
         CI,R7    1                 CHECK RFLD CLASS                    43
         BAZ      MBS64             RFLD JUSTIFIED                      44
* RFLD NOT JUSTIFIED                                                    45
         LCW,D0   D0                DSIZS = -DSIZS
MBS64    RES      0                                                     47
         BAL,L1   ODR34             CHECK DSIZS,R, SET -BSIZR           48
*                                   WRITE AI,RO -BSIZR(ADJUSTED)
*                        R1 = EMDCNT(J)                                 49
*                        R5 = EMDLOC(I)                                 50
*                        V1 = DSIZR(>/=0)                               51
         BAL,L1   PIY31             WRITE                               62
         LW,R1    RO                ****     R1 = BA(RFLD)              63
         LW,D3    JSFLD             LOAD SFLD BASE,DISPL
         BAL,L0   NBS62             WRITE
         MBS,0    0                 ****  MBS,0 BA(SFLD) TO ANE RFLD
         B        *MBSSAV           RETURN
MBS65    STW,L0   TMPL0
         BAL,L1   VAM00
MBS651   LW,D1    TMPRE             RE+1
         LBAL     PIA02,CSTB+CRV2   **** WRITE STB,V2  RE+1
         MTW,0    CONDF
         BNEZ     *TMPL0            CONDITION
MBS652   LCI      8
         LM,V0    SAVV0+1
         MTW,0    SLNKF             IN LINKAGE SECTION                  COBOL42M
         BNEZ     MBS6522           YES                                 COBOL42M
         BAL,L0   NBS00
MBS6521  RES      0                                                     COBOL42M
         XW,L1    SAVV0+4           SAVE RETURN ADDR
         LCI      8
         STM,V0   SAVV0+1
         B        *TMPL0
MBS6522  RES      0                                                     COBOL42M
         BAL,L1   PIA06             WRITE                               COBOL42M
         MBS,R2   0                 ***MBS,R2  0                        COBOL42M
         B        MBS6521                                               COBOL42M
MBS66    BAL,L1   PIA06
         SAD,V0   -32               **** WRITE SAD,V0  -32
         BAL,L1   PIA06
         LI,R7    255               **** WRITE LI,R7  255
         BAL,L1   PIA06
         DW,V0    R7                **** WRITE DW,V0  R7
         B        *L0
MBS67    AND,D1   L(X'FFFFF')
         OR,D1    L(X'22600000')    FORM LI,R6  (DGSRD)
         LI,D0    DAIA              LOAD  CLNG,CNTL
         B        PIA08+2           WRITE
MBS68    STW,L0   TMPL0
         B        MBS651
MBS69    STW,L1   TMPL0
         LI,L1    MBS691
         STW,L1   VRSAV
         B        VAM001
MBS691   B        MBS651
MBS70    LCI      8
         STM,V0   SAVV0+1
         MTW,0    CONDF
         BNEZ     MBSM0
         MTW,0    LITF
         BNEZ     MBS095
MBSM0    MTW,0    MAREF
         BGEZ     MBS070            SINGLE OR 1ST MULTI RFLD
         LW,V0    SVARF
         BEZ      MBS078            NO VAR REC
         BGZ      MBSM1
         MTW,0    CONDF
         BLZ      MBS078
         LW,D1    VMAD
         LBAL     PRA01,CLW+CRV0    **** WRITE LW,V0  (VMAD)
         LW,V0    SVARF
         CI,V0    -2
         BE       MBS078            NO VAR REC
MBSM1    LW,V0    SAVV0
         BAL,L1   VAM70
         B        MBS078
MBS070   LW,V0    SAVV0
         CI,V0    1
         BAZ      MBS071            NOT ALL LITERAL CONDITION
         MTW,1    GRMVF
         BAL,L0   VPP00             RESOLVE VAR REC
         B        MBS072
MBS071   SLS,V0   -4
         BAL,L0   VPP10             RESOLVE SFLD
MBS072   LW,L1    VARF
         STW,L1   SVARF
         BGEZ     MBS073            NOT VAR LNTH
         BAL,L1   PIA06
         LW,V0    0,R7              **** WRITE LW,V0  0,R7
MBS073   MTW,0    MAREF
         BEZ      MBS078            SINGLE RFLD
         MTW,-2   MAREF
         MTW,0    SVARF
         BEZ      MBS078            NOT VAR REC
         LW,D1    VMAD
         BNEZ     MBS074            BUFFER ASSIGNED
         LW,D1    GADNO
         AI,D1    4                 VMAD + 1                            COBOL42M
         STW,D1   VMAD              BUFFER WA
         MTW,4    GADNO
         MTW,4    GADNO
MBS074   MTW,0    SVARF
         BGZ      MBS075
         LBAL     PRA01,CSTW+CRV0   **** WRITE STW,V0  (VMAD)
         LW,V0    SVARF
         CI,V0    -2
         BE       MBS078            VAR LNTH ONLY
MBS075   BAL,L1   PIA06
         LW,V1    1,R7              **** WRITE LW,V1  1,R7
         LW,D1    VMAD
         AI,D1    4
         LBAL     PRA01,CSTW+CRV1   **** WRITE STW,V1  (VMAD+1)
MBS078   MTW,0    CONDF
         BLZ      MBS099
         LW,V0    SAVV0
         AI,V0    X'10'
         SLS,V0   -4
         STW,V0   TMPRE
         MTW,1    GRMVF
         BAL,L0   VPP00             RESOLVE VAR REC
         MTW,0    VARF
         BNEZ     MBS079            NO RFLD VAR REC
         MTW,0    SVARF
         BGEZ     MBS079            NO SFLD VAR LNTH
         LW,D1    TMPRE
         LBAL     PIA02,CLB+CRV2    **** WRITE LB,V2  RE
MBS079   MTW,0    SVARF
         BLZ      MBS086            VAR LNTH SFLD
MBS081   MTW,0    VARF
         BEZ      MBS083            RFLD NOT VAR ADDR
         BLZ      MBS084            VAR REC RFLD
MBS082   LW,D1    TMPRE
         LBAL     PIA02,CSTB+CRV2   **** WRITE STB,V2  RE+1
MBS083   MTW,0    CONDF
         BNEZ     MBS099            CONDITION
         LCI      8
         LM,V0    SAVV0+1
         MTW,0    SLNKF             SOURCE IN LINKAGE                   COBOL42M
         BNEZ     MBS0831           YES.                                COBOL42M
         BAL,L0   NBS00
         B        MBS70R
MBS0831  RES      0                                                     COBOL42M
         BAL,L1   PIA06             WRITE                               COBOL42M
         MBS,R2   0                 *** MBS,R2 0                        COBOL42M
*        SIDR'S 24777/24778  GO TO NBS10 TO SEE IF SIZE IS > 255
         LI,D2    0                 FORCE LOGIC TO USE VAM201           COBOL42M
         LI,D3    0                 CLEAR REG FOR MBS INST              COBOL42M
         STH,V0   D3                D3 = OP CODE                        COBOL42M
         BAL,L0   NBS10             PROCESS IF > 255                    COBOL42M
         B        MBS70R                                                COBOL42M
MBS084   MTW,1    BADJ              SET BLANK FILL FLAG
         LW,D1    DGSRD
         BLZ      MBSBR2            SFLD < RFLD
         MTW,1    LADJ                                                  COBOL42M
         BAL,L0   MBS65
         MTW,0    CONDF
         BNEZ     MBS099                                                COBOL42M
MBSBR1   MTW,0    RLNTH
         BEZ      MBS099                                                COBOL42M
         LW,D1    R1                                                    COBOL42M
         LBAL     PIA02,CLI+CRL1                                        COBOL42M
         BAL,L1   PIA06                                                 COBOL42M
         SW,L1    V1                                                    COBOL42M
         BAL,L1   VAM30                                                 COBOL42M
         B        MBS099                                                COBOL42M
MBSBR2   BAL,L1   MBS67
         BAL,L1   PIA06
         AW,R6    0,R7              **** WRITE AW,R6  0,R7
         MTW,0    RLNTH
         BNEZ     MBSBR5            RLNTH > 255
         BAL,L1   PIL06
         BLEZ     2                 **** WRITE BLEZ  %+2
         BAL,L1   PIA06
         SW,L0    R6                **** WRITE SW,L0  R6
MBSBR3   BAL,L0   MBS68
         MTW,0    CONDF
         BNEZ     MBS099            CONDITION
         BAL,L1   PIA06
         LCW,V0   R6                **** WRITE LCW,V0  R6
         BAL,L1   PIL06
         BLEZ     4                 **** WRITE BLEZ  %+4
MBSBR4   BAL,L1   VAM10             BLANK FILL
         B        MBS099
MBSBR5   MTW,1    LADJ              RLNTH > 255
         BAL,L1   PIA06                                                 COBOL42M
         LI,9     0                                                     COBOL42M
         BAL,L1   PIA06
         LW,V0    R6                **** WRITE LW,V0  R6
         BAL,L1   PIL06
         BLEZ     9                 **** WRITE BLEZ  %+9
MBSBR6   BAL,L1   MBS69
         MTW,0    CONDF
         BNEZ     MBS099            CONDITION
         LW,D1    R1
         BEZ      MBSBR7            TO BLANK FILL
         LBAL     PIA02,CLI+CRL1
         BAL,L1   PIA06
         SW,L1    V1                **** WRITE SW,L1  V1
         BAL,L1   VAM30
MBSBR7   BAL,L1   PIA06
         LCW,V0   R6                **** WRITE LCW,V0  R6
MBSBR8   BAL,L1   PIL06
         BLEZ     13                **** WRITE BLEZ  %+13
         BAL,L0   VAM40
         B        MBS099
MBS086   MTW,1    LADJ              SET MOVE FLAG
         MTW,1    BADJ
         LW,D1    DGSRD
         BAL,L1   MBS67
         MTW,0    VARF
         BLZ      MBS090            VAR LNTH RFLD
         MTW,0    DGSRD
         BLZ      MBS088            BLANK FILL
         BAL,L1   PIA06
         SW,V0    R6                **** WRITE SW,V0  R6
         MTW,0    RLNTH
         BNEZ     MBS087            RFLD >255
         BAL,L1   PIL06
         BLEZ     2                 **** WRITE BLEZ  %+2
         BAL,L1   PIA06
         SW,L0    V0                **** WRITE SW,L0  V0
         BAL,L1   PIA06
         LCW,R6   V0                **** WRITE LCW,R6  V0
         B        MBSBR3
MBS087   BAL,L1   PIA06
         LCW,R6   V0                **** WRITE LCW,R6  V0
         BAL,L1   PIA06                                                 COBOL42M
         LI,9     0                                                     COBOL42M
         BAL,L1   PIA06
         AI,V0    0                 **** WRITE AI,V0  0
         BAL,L1   PIL06
         BLEZ     9                 **** WRITE BLEZ  %+9
         B        MBSBR6
MBS088   BAL,L1   PIA06
         SW,R6    V0                **** WRITE SW,R6  V0
MBS089   MTW,0    RLNTH
         BNEZ     MBSBR6            RFLD > 255
         BAL,L1   PIA06
         SW,L0    V0                **** WRITE SW,L0  V0
         B        MBSBR3
MBS090   MTW,0    DGSRD
         BLZ      MBS091            BLANK FILL
         BAL,L1   PIA06
         SW,V0    R6                **** WRITE SW,V0  R6
         BAL,L1   PIL06
         BLEZ     6                 **** WRITE BLEZ  %+6
         BAL,L1   PIA06
         CW,V0    0,R7              **** WRITE CW,V0  0,R7
         BAL,L1   PIL06
         BLE      4                 **** WRITE BLE  %+4
         BAL,L1   PIA06
         LCW,R6   V0                **** WRITE LCW,R6  V0
         BAL,L1   PIA06
         AW,R6    0,R7              **** WRITE AW,R6  0,R7
         BAL,L1   PIL06
         B        3                 **** WRITE B  %+3
         BAL,L1   PIA06
         LW,V0    0,R7              **** WRITE LW,V0  0,R7
         BAL,L1   PIA06
         LW,R6    V0                **** WRITE LW,R6  V0
         B        MBS089
MBS091   BAL,L1   PIA06
         AW,R6    0,R7              **** WRITE AW,R6  0,R7
         B        MBS088
MBS095   LW,V0    SAVV0
         SLS,V0   -4
         AI,V0    1                 GET RE
         STW,V0   SAVV0
         BAL,L1   LITVR0
         MTW,0    CONDF
         BNEZ     MBS099            CONDITION
         LI,L0    MBS096
         STW,L0   TMPL0
         B        MBS652
MBS096   MTW,0    VARF
         BGEZ     MBS099            NO VAR LNTH
         BAL,L1   FXLIT
         MTW,1    LADJ
MBS099   LCI      8
         LM,V0    SAVV0+1
MBS70R   LI,L1    0
         STW,L1   CONDF             CLEAR COND FLAG
         B        *SAVV0+4
LITVR    STW,V0   SAVV0
         LCI      8
         STM,V0   LITRG
         MTW,0    MAREF
         BEZ      LTIL4             NOT GRP CONDITION
         MTW,0    CONDF
         BGEZ     LTIL4             NOT ALL CONDITION
         MTW,0    MAREF
         BLZ      LTIL1             NOT FIRST PASS
         BAL,L1   MBS70             FIRST PASS
         B        LTIL2
LTIL1    MTW,0    SVARF
         BEZ      LTIL2             NO VAR REC
         BAL,L1   VAL00
         LW,L1    SVARF
         CI,L1    -2
         BE       LTIL2             VAR LNTH ONLY
         SLS,V0   4
         BAL,L1   VAM70
LTIL2    LW,L1    SVARF
         STW,L1   VARF
         BEZ      LTIL5             NO VAR REC
         BGZ      LTIL3             VAR ADDR ONLY
         BAL,L1   VAM60
LTIL3    LI,L1    LTIL5             LINKAGE
         STW,L1   LITL1
         MTW,0    SVARF
         BGZ      LITVR1
         B        LITVA
LTIL4    BAL,L1   LITVR0            NOT GRP CONDITION
LTIL5    LI,V0    0
         STW,V0   CONDF             RESET CONDITION FLAG
         LCI      8
         LM,V0    LITRG
         B        *L1
LITVR0   STW,L1   LITL1
         MTW,1    GRMVF
         BAL,L0   VPP00             RESOLVE VAR REC
         MTW,0    VARF
         BEZ      *LITL1
         BGZ      LITVR1            VAR ADDR
         LH,D1    3,R2
         LBAL     PIA02,CLI+CRV0    **** WRITE LI,V0  RLNTH
         BAL,L1   PIA06
         SW,V0    0,R7              **** WRITE SW,V0  0,R7
         BAL,L1   PIA06
         CW,V0    L0                **** WRITE CW,V0  L0
LITVA    BAL,L1   PIL06
         BGE      2                 **** WRITE BGE  %+2
         MTW,0    JCREF             IS THIS AN IF STATEMENT             COBOL42M
         BEZ      LITVA1            NO                                  COBOL42M
         BAL,L1   PIA06                                                 COBOL42M
         XW,L0    V0                **** WRITE  XW,L0  V0               COBOL42M
         B        LITVR1                                                COBOL42M
LITVA1   RES      0                                                     COBOL42M
         BAL,L1   PIA06
         LW,L0    V0                **** WRITE LW,L0  V0
LITVR1   LW,D1    SAVV0
         LBAL     PIA02,CSTB+CRV2   **** WRITE STB,V2  RE
         MTW,0    VARF
         BGEZ     *LITL1
         BAL,L1   PIA06
         SW,V0    L0                **** WRITE SW,V0  L0
         B        *LITL1
VPLIT    LCI      8
         STM,V0   LITRG
         MTW,0    RLNTH
         BEZ      %+2
         BAL,L0   MBS66
         LW,D1    SAVV0
         LBAL     PIA02,CSTB+CRV0   **** WRITE STB,V0 RE
         LCI      8
         LM,V0    LITRG
         B        *L1
FXLIT    STW,L1   TMPL0
         MTW,0    RLNTH
         BEZ      %+2
         BAL,L0   MBS66
         LW,D1    SAVV0
         LBAL     PIA02,CSTB+CRV0   **** WRITE STB,V0 RE
         BAL,L1   PIA06
         LW,R1    R3                **** WRITE LW,R1  R3
         LW,D3    K4SPAC
         LI,V0    CMBS
         BAL,L1   PID10             **** WRITE MBS,RE  BA(SFLD)
         MTW,0    RLNTH
         BEZ      *TMPL0
         B        VAM50+1
VAM00    STW,L1   VRSAV
         MTW,0    RLNTH
         BEZ      VAM003            RLNTH < 256
         BAL,L1   PIA06
         LW,V0    0,R7              **** WRITE LW,V0  0,R7
VAM001   BAL,L0   MBS66
         BAL,L1   PIA06
         CW,V0    L0                **** WRITE CW,V0  L0
         BAL,L1   PIL06
         BL       3                 **** WRITE BL  %+3
         BAL,L1   PIA06
         AI,V1    1                 *** WRITE AI,V1  1                  COBOL42M
         BAL,L1   PIA06
         AI,L0    255               **** WRITE AI,L0  255
VAM002   BAL,L1   PIA06
         SW,L0    V0                **** WRITE SW,L0  V0
         B        *VRSAV
VAM003   BAL,L1   PIA06
         SW,L0    0,R7              **** WRITE SW,L0  0,R7
         B        *VRSAV
VAM10    STW,L1   VRSAV
         LW,D1    TMPRE
         LBAL     PIA02,CLW+CRR1    **** WRITE LW,R1  RE+1
         BAL,L1   PIA06
         STB,V0   R1                **** WRITE STB,V0  R1
         LW,D3    K4SPAC
         LI,V0    CMBS
         MTW,0    CONDF
         BEZ      %+2               NOT CONDITIONAL
         AI,V0    -X'100'           TO CBS
         BAL,L1   PID10             **** WRITE MBS,0  BA(SFLD)
         STW,D2   TMPD2
         B        *VRSAV
VAM20    STW,L1   VRSAV
         BAL,L1   PIA06
         LI,V2    X'FF'             **** WRITE LI,V2  255
         LH,D1    TMPD2
         BEZ      VAM201            =0 MBS,RE  0
         BAL,L1   OBS14+1           WRITE STB,V2  RO
         LI,D1    DAID
         WPOF     ,CBD1+2,VAM202    WRITE MBS,RE  BA(SFLD)
VAM201   BAL,L1   OBS14             WRITE STB,V2  RO
         LI,D2    DAIA              CLUSTER LGTH CTRL BYTE              COBOL42M
         WPOF     ,CBD2+2           WRITE MBS,RE  0
VAM202   B        *VRSAV
VAM30    STW,L1   TMPL1
         BAL,L1   PIL06
         BLEZ     5                 **** WRITE BLEZ  %+5
         BAL,L1   VAM20
         BAL,L1   PIL06
         BDR,L1   X'FFFE'           **** WRITE BDR,L1  %-2
         B        *TMPL1
VAM40    STW,L0   TMPL0
         BAL,L0   MBS66
         BAL,L1   VAM10
VAM401   BAL,L1   PIA06
         LW,L1    V1                **** WRITE LW,L1  V1
         BAL,L1   VAM30
         B        *TMPL0
VAM50    STW,L1   TMPL0
         STW,D2   TMPD2
         B        VAM401            REPEAT MOVE
VAM60    STW,L1   TMPL1
         LW,D1    DIFLG
         LBAL     PIA02,CLI+CRV0    **** WRITE LI,V0  RLNTH
         LW,D1    VMAD
         LBAL     PRA01,CSW+CRV0    **** WRITE SW,V0  (VMAD)
         BAL,L1   PIA06
         CW,V0    L0                **** WRITE CW,V0  L0
         B        *TMPL1
VAM70    STW,L1   TMPL1
         LW,D1    VMAD
         AI,D1    4
         AI,V0    CSW
         BAL,L1   PRA01             **** WRITE SW,RE  (VMAD+1)
         B        *TMPL1
*
*
NBS00    RES      0
*                        V0 = MBS,RE
*                        JSFLD = 0/SFLD BASE,DISPL
* MBS,RE  BA(SFLD)
* **  RE = R0, OR
* **     NOT= R0, THEN RE CONTAINS SUBSCRIPT VALUE
         LW,D3    JSFLD             LOAD,CHECK SFLD BASE,DISPL
         BEZ      NBS04             = 0, RE = BA(SFLD)
*                        V0 = MBS,RE
*                        D3 = SFLD BASE,DISPL
NBS02    RES      0
         BAL,L1   PID10             WRITE MBS,RE BA(SFLD)
         B        NBS10
*
* = 0, RE = BA(SFLD)
*                        V0 = MBS,RE
*                        D3 = 0
NBS04    RES      0
         BAL,L1   PIA22             WRITE MBS,RE 0
*                                                                        0
* CHECK RPTCNT,WRITE ADDITIONAL MBS,LOOP
*                        R1 = RPTCNT
*                        V0 = MBS,RE
*                        D3 = SFLD BASE,DISPL
NBS10    RES      0
         STW,D2   TMPD2
         MTW,0    LADJ
         BNEZ     *L0               NO VAR REC
         CI,R1    1                 CHECK RPTCNT
         BL       *L0               =0, NO ADDITIONAL MBS
* ADDITIONAL MBS REQUIRED
         BE       NBS12             =1, ONE ADDITIONAL ONLY
* RPTCNT > 1, MBS LOOP
         LW,D1    R1                LOAD RPTCNT
         LBAL     PIA02,CLI+CRL1    WRITE LI,L1 RPTCNT
NBS12    RES      0
         BAL,L1   VAM20             255 BLOCK MOVE
NBS18    RES      0
         CI,R1    1                 CHECK RPTCNT
         BE       *L0               =1, RETURN
* COMPLETE MBS LOOP
         BAL,L1   PIL06             WRITE
         BDR,L1   X'FFFE'           ****  BDR,L1 %1-2
         B        *L0               RETURN
*
* CHECK SUBSCRIPT,LOAD BYTE OFFSET                                       2
NBS20    RES      0                                                      2
         AND,V0   KF00F0            MASK SUBSCRIPT FLAG,SXR              6
         CI,D3    3                 CHECK FOR HA/BA BITS                 7
         BAZ      NBS22             NO HA/BA BITS                        8
* BA/HA BITS                                                            11
         BAL,L1   OBS20             WRITE LI/AI,SXR  BA,HA BITS
NBS21    RES      0
         AND,V0   K3F0              MASK,POSITION SXR                   20
         SLS,V0   -3                                                    21
         B        *L0               RETURN                              22
* NO BA/HA BITS                                                         23
NBS22    RES      0
         CI,V0    0                 CHECK SUBSCRIPT FLAG                25
         BLZ      NBS21             UP. SUBSCRIPTED.
* NOT SUBSCRIPTED                                                       27
         LI,V0    0                 CLEAR SXR                           28
         B        *L0               RETURN                              29
*
* CHECK SUBSCRIPTS/BYTE OFFSET, ADJUST SXR/SET INDEX                    21
*                        V0 = OP CODE,R- -(,SXR)                        22
*                        V0,D0,D1 VOLATILE                              23
NBS24    RES      0                                                     24
         BAL,L1   OBS24             CHECK SUBSCRIPTS/BYTE OFFSET        25
         LBAL     PIA02,1,D1        WRITE AI/LI,SXR/R1 1                26
         B        NBS21
*                                                                        0
* RFLD = ANE                                                             1
*                        R1 = EMDCNT(J)                                 49
*                        R5 = EMDLOC(I)                                 50
*                        L0 = LINK REGISTER                              5
*                        *L0 = MBS,RE 0                                  6
* **                     RE = BA(SFLD)                                   7
NBS62    RES      0                                                      8
         LW,D2    *L0               LOAD MBS,RE 0                        9
         AI,L0    1                 UPDATE LINK                         10
NBS64    RES      0                                                     11
         LI,D1    0
         STW,D1   VAREF
NBS65    LB,D1    5,R5              LOADXCNT(I)
         LBAL     PIY01,CLI+CRV2    WRITE LI,V2 XCNT(I)                 67
         LH,D1    D2                LOAD MBS,RE                         14
         BAL,L1   OBS14+1           WRITE STB,V2 RO                     15
         MTW,0    VAREF
         BNEZ     NBS66             NOT FIRST MOVE
         LCI      8
         STM,V0   LITRG
         LI,V0    X'F'
         AND,V0   D1                RE
         BAL,L0   VPP00
         LCI      8
         LM,V0    LITRG
         MTW,1    VAREF
NBS66    RES      0
         LBAL     PID14+1,DAID,D1   WRITE MBS,RE BA(SFLD)               16
         AI,R1    -1                J = J-1                             72
         BLEZ     *L0               J = 0, E-O-ANE MBS                  18
* SKIP EDIT GROUP                                                       19
*                        D0 = ABS INSTRUCTION CLNG.CNTL                 20
         LH,V0    D2                LOAD,MASK RE                        22
         AND,V0   K3E0                                                  23
         AI,V0    CAI+CRR1          FORM AI,RO                          24
         AI,R5    1                 I = I+1                             74
         LB,D1    5,R5              LOAD ECNT(I)                        75
         BAL,L1   PRA04             WRITE AI,RO ECNT(I)                 27
         AI,R5    1                 I = I+1                             77
         BDR,R1   NBS65             J=J-1, CONTINUE ANE MBS
* LOAD R1 WITH RO
*                        D2 = 0,- THEN D3 = -,RE,- OR
*                           = -,RE,-
OBS02    RES      0
         LI,V0    CLW+CRR1          LOAD LW,R1
         LH,D1    D2                LOAD,CHECK FOR -,RE
         BNEZ     OBS04             NOT= 0(=-,RE)
* = 0
*                        D3 = -,RE,-
         LH,D1    D3                LOAD -,RE
*                        V0 = OP CODE
*                        D1 = -,RE(/RO),-
OBS04    RES      0
         AND,D1   K3E0              MASK RE(/RO)
         AI,D1    X'10'             RE = RE+1(=RO)
         B        ORR07             WRITE OP CODE,R- RO
*
* MBS COUNT(L) TO RO
*                        D3 = MBS,RE
OBS14    RES      0
         LH,D1    D3                LOAD MBS,RE
*                        D1 = -,MBS,RE
         LAB,V0   OBS04,CSTB+CRV2   WRITE STB,V2 RO
* BA/HA BITS - LI/AI,SXR BA(SFLD)                                       61
*                        D3 = BASE DISPL
OBS20    RES      0                                                     62
         LI,D1    3                 MASK BA,HA BITS
         AND,D1   D3
         BEZ      OBS21-1           = 0, WA ALIGNED
* BA,HA BITS
         EOR,D3   D1                CLEAR BA,HA BITS
         STW,D3   JSFLD
         CI,V0    0                 CHECK SUBSCRIPT FLAG                12
         BLZ      OBS21             UP. SUBSCRIPTED
* NOT SUBSCRIPTED
         MTH,15   JSFLDS            RAISE SUBSCRIPT FLAG
         AI,V0    CLI-CAI+X'F0000'   FORM LI(-AI),SXR
OBS21    RES      0                                                     69
         AI,V0    CAI               FORM LI/AI,SXR
         MTW,0    SLNKF
         BNEZ     *L1               IN LINKAGE SECTION
         B        PIA02             WRITE LI/AI,SXR  BA,HA BITS/0
* CHECK SUBSCRIPTS/BYTE OFFSET                                          30
*                        V0 = OP CODE,R- -(,SXR)                        31
OBS24    RES      0
         AND,V0   K30E              MASK SXR                            32
         BNEZ     OBS25             SXR NOT= 0, SUBSCRIPTS/BYTE OFFSET  33
* NO SUBSCRIPTS/BYTE OFFSET                                             34
         LAB,V0   *L1,CLI+CRR1      LOAD LI,R1                          35
* SUBSCRIPTS/BYTE OFFSET                                                37
OBS25    RES      0                                                     36
         SLS,V0   3                 POSITION SXR                        38
         AI,V0    CAI               FORM AI,SXR                         39
         B        *L1               RETURN                              40
*                        V0 = LI,R1 IF NO SUBSCRIPT/BYTE OFFSET OR      41
*                           = AI,SXR IF SUBSCRIPTS/BYTE OFFSET          42
*
* CHECK LITERAL TYPE                                                     1
*                        L1 = LINK REGISTER                              2
*                        D2,D3  VOLATILE                                 3
OBS90    RES      0                                                      4
         LH,D1    0,R2              LOAD LITERAL CLNG,CNTL               5
*                        D1 = CLNG,CNTL                                  6
         CI,D1    9                 CHECK LIT TYPE                       7
         BANZ     OBS94             NOT FIGCON/ALL '1 CHAR' LIT          8
* FIGCON/(ALL) '1 CHAR' LIT                                              9
OBS92    RES      0                                                     10
         AW,R2    R2                HA(CLOC) TO BA                      11
         CI,D1    3                 CHECK (ALL) ANLIT FLAG              12
         BANZ     OBS93             UP.(ALL) CHAR                       13
* FIGCON                                                                14
         LB,R2    1,R2              LOAD FIGCON TYPE                    15
         AI,R2    BA(KABA)-8        LOAD BA(FIGCON CHAR.)
OBS93    RES      0                                                     17
         LB,D3    1,R2              LOAD FIGCON /(ALL) CHAR.  .         18
         LAB,V0   PIA22,CLI+CRV2    WRITE LI,V2 FIGCON/(ALL) CHAR.      19
* NOT FIGCON/ALL '1 CHAR' LIT                                           20
*                        R2 = HA(CLOC)
OBS94    RES      0                                                     21
         CI,D1    4                 CHECK LIT TYPE                      22
         BAZ      OBS96             NOT ZERO LIT                        23
* *** INDEX/BIN LIT NOT EXPECTED *****
* ZERO LIT                                                              24
         LH,D2    1,R2              LOAD,CHECK DSIZ                     25
         CI,D2    1                                                     26
         BG       OBS95             >  1                                27
* DSIZ = 1                                                              28
         LI,D3    X'F0'             LOAD FIGCON ZERO                    29
         B        OBS93+1                                               30
* DSIZ > 1                                                              31
OBS95    RES      0                                                     32
         LW,D3    K4BAS             LOAD ZERO FIGCON BASE DISPL         33
         SCS,D2   -8                POSITION DSIZ                       34
         B        *L1               RETURN                              35
* AN/N LIT                                                              36
OBS96    RES      0                                                     37
         LH,D2    3,R5              LOAD DSIZ                           38
         BDR,D2   OBS98             DSIZ = DSIZ -1                      39
* DSIZ = 1                                                              40
         AW,R2    R2                HA(CLOC) TO BA                      43
         LB,D3    4,R2              LOAD DIGIT/CHAR.
         CI,D1    8                 CHECK LIT TYPE
         BAZ      OBS93+1           NOT NLIT
* 1 CHAR.NLIT                                                           46
         SCS,D3   -4                ZONE DIGIT
         AI,D3    X'F0'
         CI,D1    1                 CHECK LIT TYPE
         BANZ     OBS93+1           UNSIGNED
* SIGNED
         AI,D3    -X'20'            ZONE = 'D'(-)
         B        OBS93+1                                               48
* DSIZ > 1                                                              53
OBS98    RES      0                                                     54
         AI,L1    1                 SET LINK REGISTER                   55
         B        LIT00             POOL LITERAL                        56
*                                                                       50
SVARF    DATA     0
CONDF    DATA     0                 CONDITION FLAG
LADJ     DATA     0                 LNTH ADJUST FLAG
BADJ     DATA     0                 BLNK ADJUST FLAG
TMPRE    DATA     0
MAREF    DATA     0
VAREF    DATA     0
RLNTH    DATA     0                 RLNTH > 255 FLAG
GRMVF    DATA     0
DGSRD    DATA     0
LITF     DATA     0
TMPD2    DATA     0
SLNKF    DATA     0                 SFLD LINKAGE FLAG
LITL1    RES      1
TMPV1    RES      1
TMPL0    RES      1
TMPL1    RES      1
LITRG    RES      8
SAVV0    RES      9
         REF      JDECP,JDSIZ       DECP,DSIZ
JBSIZ    EQU      JDSIZ+1           BSIZ
JMBSIZ   EQU      JDSIZ+2           SFLD M(OVED)BS CNT
JSALL    EQU      JDSIZ+3           ALL ANLIT FLAG(=BSISZ)
JSFLD    EQU      JDSIZ+4           SFLD BASE,DISPL
JSFLDS   EQU      JDSIZ+5           SFLD SUBSCRIPT FLAG
JZREG    EQU      JDECP+13
*
         REF      MDFSAV            STORE
MBSSAV   EQU      MDFSAV+1          L0,D3
*
         REF      KBKON,K4BAS,K6BAS
         REF      KABA
K30E     EQU      KBKON
K3E0     EQU      KBKON+1
K30F     EQU      KBKON+2
K3F0     EQU      KBKON+3
K3FF     EQU      KBKON+4
K2FFFF   EQU      KBKON+5
KF00F0   EQU      KBKON+8
K303     EQU      KBKON+9
K4SPAC   EQU      K4BAS+1
K4AST    EQU      K4BAS+2
KUNPKA   EQU      K6BAS+1
KUNPK4   EQU      K6BAS+2           UNPKA+1
KMSG     EQU      K6BAS+3           MSG AREA
         REF      SSSAV                                                 COBOL42M
SSSD1    EQU      SSSAV+11                                              COBOL42M
         END
