         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.2 - LOAD SUBROUTINES'
* 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
* 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      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      PRL02,PRL22
         REF      PRT00,PRT02,PRT06,PRT20,PRT22,PRT26
         REF      PDB00,PDB02,PDB06
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDL10,PDL12,PDL16
         REF      PPI10,PPI12
         REF      PIY00,PIY01,PIY02,PIY03
         REF      PIY20,PIY21,PIY22,PIY23
         REF      PIY30,PIY31,PIY32,PIY33
         REF      PIZ30,PIZ32
         REF      MTL20
         REF      SSB00,SSB01,SSB02
         REF      SSL00,SSL01,SSL02
         REF      SSS00,SSS01,SSS02
         REF      LNKSF,MDF65
         REF      LIT00,LIT05
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      VPP10,VPP30,LITF
         REF      VBIDX
         DEF      ARTHF,RFLDF,NOVF
* 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
RF       EQU      V2                FILE CNTL
SR1      EQU      8                 SR1
SR3      EQU      X'A'              SR3
* BA(D-)                                                                CBD
CBD0     EQU      X'30'                                                 CBD0
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'3C'
* INDEX REGISTERS                                                       CIR
CIR1     EQU      2                                                     CIR1
CIR2     EQU      4                                                     CIR2
CIR3     EQU      6                                                     CIR3
CIR4     EQU      8                                                     CIR4
CIR5     EQU      X'A'                                                  CIR5
CIR6     EQU      X'C'                                                  CIR6
CIR7     EQU      X'E'
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
CRD0     EQU      X'C0'                                                 CR12
CRD1     EQU      X'D0'                                                 CR13
CRD2     EQU      X'E0'                                                 CR14
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRI      EQU      CRB+X'10'         INDEX
CRF      EQU      CRV2              FILE CNTL
CP1      EQU      CRV2              PREG 1
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES                                                              C0
CCAL1    EQU      X'0400'           CAL1                                C04
CLD      EQU      X'1200'                                               C12
CLCD     EQU      X'1A00'
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
CLW      EQU      X'3200'
CSTW     EQU      X'3500'           STW                                 C35
CDW      EQU      X'3600'
CLCW     EQU      X'3A00'
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
CSAS     EQU      X'400'            RA SETTING - SAS
CSAD     EQU      X'500'            RA SETTING - SAD
COR      EQU      X'4900'           OR                                  C49
CLH      EQU      X'5200'                                                2
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
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
CSTB     EQU      X'7500'                                               C75
CDSA     EQU      X'7C00'
CDL      EQU      X'7E00'                                               C795
CPACK    EQU      X'7600'                                               C76
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
* 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
DGFZ     EQU      6                 FL'0.E8'
DCVB     EQU      X'10'             DECA CONVERT PSEUDO CLASS           00
* ENTRY POINTS
         DEF      LRA00,LRA01,LRA02
         DEF      LRA92
         DEF      LRR00,LRR01,LRR02
         DEF      LRD00,LRD01
         DEF      LRD10,LRD11,LRD20,LRD21
         DEF      LRD40,LRD41,LRD42
         DEF      LRD60,LRD61,LRD62,LRD80,LRD81,LRD82
         DEF      LRL00,LRL01
         DEF      LRN00
         DEF      MRR00
         DEF      MRR10,MRR11,MRR12
         DEF      MRR40,MRR41,MRR42
         DEF      MRR60,MRR61,MRR62,MRR80,MRR81,MRR82
         DEF      NRR10,NRR11,NRR12
         DEF      NRR16
         DEF      NRR22                                                 COBOL42O
         DEF      NRR40,NRR41,NRR42
         DEF      NRR60,NRR61,NRR62
         DEF      NRR70,NRR71,NRR72
         DEF      NRR80,NRR81,NRR82
         DEF      NRD00,NRD01,NRD02
         DEF      ORR03,ORR04,ORR05,ORR06,ORR07,ORR08
         DEF      ORD12,ORD22,ORD23,ORD24
         DEF      ORD42,ORD44,ORD48
*
* LOAD REGISTER                                                         010
* SFLD,RFLD CLASS UNKNOWN                                               000
LRA00    RES      0                                                     00000
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRA01    RES      0                                                     00010
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        R2 = HA(CLOC)                                  0002 2
*                        R4 = SFLD TYPE(BITS 26,27): 0 = DATA NAME
*                                                   1 = LITERAL
*                                                   2 = REGISTER
*                        R5 = HA(CLOC)-1                                002 5
*                        R6 = RFLD CLASS                                1162 6
*                        R7 = SFLD CLASS                                0102 7
*                        V0 = RECEIVING REGISTER(RREG)                  2112 8
*                        D1 = SREG IF REGISTER TO REGISTER
*                        L0 = LINK REGISTER                             0004 8
*                        R4,D- REGISTERS VOLATILE                       0002 9
LRA02    RES      0
         CI,R4    X'20'             CHECK DATA TYPE                     00042
         BANZ     LRR02             LOAD REGISTER(=X'2-')
         CI,R4    X'10'                                                 00044
         BAZ      LRD02             LOAD DNAM (=X'0-')
         B        LRL02             LOAD LITERAL(=X'1-')
*                                                                       63
*                                                                       70
* LOAD REGISTER FROM REGISTER(=X'2-') - NUMERIC ONLY
* ** VALID MOVES: DEC* TO FLL,FLS,BIN        (DEC PACKED IN DECA)       010  1
*                 FLL TO DEC*,FLS,BIN                                   010  2
*                 BIN TO DEC*,FLL,FLS                                   010  3
*                 FLS TO DEC*,FLL,BIN                                   010  4
*                        V1 = DECPS IF SFLD CLASS = NC AND               1
*                                      RFLD CLASS = BIN/FLP              2
*                           = DECPR IF SFLD CLASS = BIN/FLP AND          3
*                                      RFLD CLASS = NC                   4
*                          = SUBFR IF RFLD = INDEX
* *** ND/NC SFLDS CANNOT BE CONVERTED TO INDEX EXCEPT FROM DATA TO REGISTER***
*                        D1 = SREG IF SFLD CLASS = BIN/FLP               5
* *** SREG/RREG = DECA(ASSUMED) IF SFLD/RFLD = NC                        6
LRR00    RES      0                                                     01000
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRR01    RES      0                                                     01010
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        D1 = SREG
LRR02    RES      0
         CI,R7    X'C'              CHECK SFLD CLASS
         BL       MRR12             SFLD = NC
* SFLD = INDEX/BIN/FLP
         BNE      MRR42             SFLD = BIN/FLP
         B        MRR22             SFLD = INDEX
*                                                                        8
* LOAD REGISTER FROM DATA                                               020
*                        R6 = RREG,RFLD CLASS                           10
*                              (RREG=INTERMEDIATE LOAD REGISTER(ILREG)  11
*                                 IF SFLD CLASS = BIN/FLP AND           12
*                                    RFLD CLASS = NC                    13
LRD00    RES      0                                                     02000
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRD01    RES      0                                                     02010
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
LRD02    RES      0
         CI,R7    X'C'              CHECK SFLD CLASS                    02022
         BGE      LRD42             SFLD = INDEX/BIN/FLP
* SFLD = NC/ND                                                          020
         CI,R7    8                 CHECK SFLD CLASS                    02042
         BGE      LRD22             SFLD CLASS = NC
* SFLD = ND                                                             0206
         B        LRD12                                                 02064
* LOAD NEGATIVE REGISTER FROM DATA
LRN00    RES      0
         LH,R7    0,R2              LOAD,MASK SFLD CLASS
         AND,R7   K30F
LRN01    RES      0
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
LRN02    RES      0
         LI,R4    CLCW-CLW          RAISE NEGATE FLAG
         STH,R4   JRNEG
         BAL,L0   LRD02             LOAD DATA
         MTB,8    JRNEG             LOWER NEGATE FLAG
         B        LRA93             RETURN
* SFLD = ND                                                             0210
LRD10    RES      0                                                     02100
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRD11    RES      0                                                     02110
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
LRD12    RES      0                                                     02120
         STW,L0   LRALNK            SAVE CURRENT LINK                   02112
         LH,V1    3,R5              LOAD DSIZS
         CI,V1    1                 CHECK FOR ODD/EVEN BSIZ             02124
         BANZ     LRD22+1           ODD BSIZ. PACK(,CONVERT)             4
* EVEN BSIZ - MBS,PACK(,CONVERT)                                         5
         AI,R7    2                 SFLD CLASS = NCS,NCU                11
         LBAL     SSS02-1,CRE       CHECK SUBSCRIPTS                    12
         AI,V0    X'F0000'          RAISE SUBSCRIPT FLAG                13
         BAL,L1   LRD44             RESET INDEX FLAGS                   14
*                                   SAVE BASE,DISPL,SXR                 15
         MTW,0    LNKSF
         BNEZ     LRD14             IN LINKAGE SECTION
         CI,V0    0                 CHECK SUBSCRIPT FLAG                17
         BLZ      LRD14             UP. SUBSCRIPTED                     18
* NOT SUBSCRIPTED                                                       19
         BAL,L1   PID16             WRITE                               20
         LI,RE    0                 ****   LI,RE                        21
         LI,D3    0                 CLEAR BASE,DISPL                    22
LRD14    RES      0                                                     23
         LAB,L0   NRD02,LRD24       WRITE MBS,DSIZ BA(SFLD) TO UNPKA    24
* SFLD = NC                                                             0220
LRD20    RES      0                                                     02200
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRD21    RES      0                                                     02210
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
LRD22    RES      0                                                     02220
         STW,L0   LRALNK            SAVE CURRENT LINK                   02212
         BAL,L1   SSB01             CHECK SUBSCRIPTING
         BAL,L1   LRD44             RESET INDEX FLAGS                   31
*                                   SAVE BASE,DISPL,SXR                 32
         BAL,L1   ORD11             DL NC/PACK ND                       33
LRD24    RES      0
         LH,V0    JRNEG             LOAD,CHECK NEGATE FLAG
         BEZ      LRD26             DOWN. NO NEGATION
* UP. NEGATE DECA
         BAL,L1   PIL06             WRITE
         BIR,D3   1                 ****  BIR,D3 %+1   CHANGE SIGN
LRD26    RES      0
         LW,V0    LRAREG            RELOAD RREG
         LH,V1    4,R5              LOAD DECPS
         BAL,L0   MRR12             CONVERT
         B        *LRALNK           RETURN
* SFLD = INDEX/BIN                                                      1140
* SFLD = FLS                                                            0262
* SFLD = FLL                                                            0282
LRD40    RES      0                                                     02400
LRD60    RES      0                                                     02600
LRD80    RES      0                                                     02800
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
LRD41    RES      0                                                     02410
LRD61    RES      0                                                     02610
LRD81    RES      0                                                     02810
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V0 = ILREG
LRD42    RES      0                                                     02420
LRD62    RES      0
LRD82    RES      0                                                     02820
         LW,V1    V0                SAVE RREG                           02421
         BAL,L1   SSB01             CHECK SUBSCRIPTING
         LI,L1    ORD42             SET LW LINK                         41
* CHECK,SET INDEX FLAGS                                                 42
         CI,R7    X'E'              CHECK SFLD CLASS                    43
         BGE      LRD43             SFLD = FLP                          44
* SFLD = INDEX/BIN                                                      45
         STW,D3   JIFLD             SAVE BASE,DISPL                     46
         STW,V0   JIFLDS            *    SXR                            47
         CI,R7    X'D'              CHECK SFLD CLASS                    48
         BE       LRD45             SFLD = BIN                          49
* SFLD = INDEX                                                          50
         LH,R4    4,R5              SUBFC = SUBFO                       51
         STH,R4   R4                                                    52
         OR,V1    K310              FORCE SREG ODD
         STS,V1   LRASAV
         STS,V1   LRAREG
         B        LRD45+1
* SFLD = FLP                                                            54
LRD43    RES      0                                                     55
         BE       LRD44             SFLD = FLS                          56
* SFLD = FLL                                                            57
         LI,L1    ORD48             SET LD LINK                         58
* RESET INDEX FLAGS                                                     59
*                        L1 = LINK REGISTER                             59
LRD44    RES      0                                                     60
         LI,R4    0                 LOWER INDEX LOAD FLAG               61
         STW,R4   JIFLD                                                 62
LRD45    RES      0
         LI,R4    -1                SUBFC,SUBFO = -1                    64
         STW,R4   JSUBF                                                 65
* SAVE BASE, DISPL,SXR                                                  66
         LI,R4    R2                CHECK SXR
         CW,R4    JSXR
         BNE      LRD46             NOT= SAVE SXR
* *** SAVE PARAMETERS ONLY IF SXR = R2 ***
*                        R7 = SFLD CLASS
         STW,R7   JRFLD             SAVE CLASS
         STW,D3   JSFLD             SAVE BASE DISPL                     67
         STW,V0   JSFLDS            *    SXR                            68
LRD46    RES      0
         BAL,L1   *L1               RETURN                              69
* ***    BAL,L1   ORD42             SFLD = INDEX/BIN/FLS
* ***    BAL,L1   ORD48             SFLD = FLL
         LD,V0    LRAREG            RESTORE ILREG,DECPR
         LW,D1    V0                SREG. = ILREG
         CI,R7    X'C'              CHECK SFLD CLASS
         BNE      MRR42             SFLD = BIN/FLP
         B        MRR22             SFLD = INDEX
*
* LOAD REGISTER WITH LITERAL
LRL00    RES      0                                                     03000
LRL01    RES      0                                                     03010
         BAL,L1   LRA91             SAVE REGISTERS,LOAD PARAMETERS
LRL02    RES      0
         BAL,L1   LIT00             POOL(,CONVERT) LITERAL
         LH,R7    0,R2              LOAD,MASK SFLD CLASS
         AND,R7   K30F
         B        LRD02
*
* SFLD CLASS KNOWN                                                      11
* SFLD = INDEX/BIN/FLP                                                  12
* RFLD = INDEX                                                          20
MRR00    RES      0                                                     13
         LI,R7    X'C'              SFLD CLASS = INDEX
         LI,R6    X'7C'             LOAD RREG,RFLD CLASS(=INDEX)
         LI,D1    CRI               SREG = INDEX REGISTER
         LH,V1    4,R5              LOAD SUBFR
MRR01    RES      0
         BAL,L1   MRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V1 = SUBFR
MRR02    RES      0                                                     21
         STW,L0   MRALNK            SAVE LINK REGISTER                  32
         EXU      MRR08-X'D',R7     EXECUTE ON SFLD CLASS
* SFLD LOADED                                                           40
         LI,R7    X'C'              SFLD CLASS = INDEX                  33
         LI,V1    -1                SET SUBF = -1(INTEGER)              34
         STW,V1   JSUBF                                                 35
         LD,V0    LRAREG            RESTORE RREG(/ILREG),SUBFR(/DECPR)  42
         LW,D1    V0                SREG = RREG(/ILREG)                 43
         BAL,L0   MRR22+1           COMPLETE INDEX LOAD
         B        *MRALNK           RETURN
* SFLD CLASS BRANCH TABLE                                               0108
         B        MRR22+1           INDEX
MRR08    RES      0                                                     111680
         BAL,L1   ORR06             BIN
         BAL,L0   NRR62             FLS
         BAL,L0   NRR82             FLL
         BAL,L0   NRR12             NC
*
* SFLD = NC                                                             1110
MRR10    RES      0                                                     11100
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
MRR11    RES      0                                                     11110
         BAL,L1   MRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V1 = DECPS
MRR12    RES      0                                                     11120
         CI,R6    X'C'              CHECK RFLD CLASS                     2
         BL       MRR14             RFLD = NC                            3
* RFLD = INDEX/BIN/FLP                                                   3
* *** R7 SETTING NOT ESSENTIAL FOR NC TO BIN CONVERSION ***
         BG       NRR12             RFLD = BIN/FLP                       4
*                                   WRITE LI,P1 RREG,DECPS               7
*                                   ****  BAL,L1 C:CD-                   8
* RFLD = INDEX                                                           5
         LAB,R7   MRR02,DCVB        CONVERT TO INDEX                     6
* *** ND/NC SFLDS CANNOT BE CONVERTED TO INDEX EXCEPT FROM DATA TO REGISTER***13
* RFLD = NC
MRR14    RES      0                                                      4
         SW,V1    LRAREG+1          DECPS = DECPS-DECPR(=-SHIFT CNT)
         LI,D3    X'FFFF'           CHECK EXCESSIVE SHIFT               COBOL42O
         AND,D3   V1                0 OR EXCESSIVE SHIFT COUNT?         COBOL42O
         BEZ      *L0               = 0, ALIGNED
         LCW,D3   V1                LOAD SHIFT CNT
         LBAL     PIA22,CDSA        WRITE DSA SHIFT CNT
         B        *L0               RETURN
*                                                                        2
* SFLD = INDEX                                                           3
MRR20    RES      0                                                    1
MRR21    RES      0                                                    2
*                        R6 = RFLD CLASS                                 1
*                        V0 = RREG                                       2
*                        V1 = SUBFR IF RFLD = INDEX                      6
*                        D1 = SREG                                       1
MRR22    RES      0                                                    3
         STW,L0   MRALNK            SAVE LINK REGISTER                  27
         LW,D0    V0                SAVE RREG.                           3
         LW,V0    D1                LOAD SREG                            4
         CI,R6    X'C'              CHECK RFLD CLASS                    10
         BE       NRR32             RFLD = INDEX NAME/DATA            10
* RFLD = BIN/FLP/NC
         BAL,L0   NRR22             CONVERT INDEX
         AI,R7    1                 SFLD CLASS = BIN
         LW,L0    MRALNK            LOAD LINK REGISTER
         CI,R6    X'C'              CHECK RFLD CLASS
         BGE      MRR42+2           RFLD = BIN/FLP
         LI,V1    0                 DECPS = 0
         STW,V1   LRASAV+3
         STW,V1   JDECP
         B        NRR16             CONVERT
*
* SFLD = BIN                                                            0242
* SFLD = FLS                                                            1160
* SFLD = FLL                                                            1180
MRR40    RES      0                                                     11400
MRR60    RES      0                                                     11600
MRR80    RES      0                                                     11800
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
MRR41    RES      0
MRR61    RES      0
MRR81    RES      0
         BAL,L1   MRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V1 = DECPR IF RFLD = NC
MRR42    RES      0                                                     11420
MRR62    RES      0                                                     11620
MRR82    RES      0                                                     11820
         CI,R6    X'C'              CHECK RFLD CLASS                    23
         BL       NRR16             RFLD = NC                            5
         EXU      MRR46-X'C',R6     EXECUTE ON RFLD CLASS               41
         B        *L0               RETURN
* RFLD CLASS BRANCH TABLE                                               1168
MRR46    RES      0                                                     44
         B        MRR02             INDEX
         EXU      MRR48-X'D',R7     BIN                                 45
         EXU      MRR68-X'D',R7     FLS                                 46
         EXU      MRR88-X'D',R7     FLL                                 47
* SFLD CLASS BRANCH TABLES                                              49
* RFLD = BIN(/INDEX)                                                    50
MRR48    RES      0                                                     51
         BAL,L1   ORR06             BIN                                 52
         B        NRR62             FLS                                 53
         B        NRR82             FLL                                 54
* RFLD = FLS                                                            55
MRR68    RES      0                                                     11680
         B        NRR42             BIN                                 57
         BAL,L1   ORR06             FLS                                 58
         B        NRR92             FLL
* RFLD = FLL
MRR88    RES      0                                                     11880
         B        NRR42             BIN                                 62
         B        NRR72             FLS                                 63
         BAL,L1   ORR08             FLL
*                                                                       20
* SFLD,RFLD CLASS KNOWN                                                 200
*                                                                       2120
* SFLD = NC, RFLD = INDEX/BIN/FLP                                       2112
NRR10    RES      0                                                     21100
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
NRR11    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        R6 = RFLD CLASS                                2112 6
*                        V0 = RREG
*                        V1 = DECPS
NRR12    RES      0                                                     21120
         LW,D3    V1                LOAD DECPS
         BAL,L1   ORR14             WRITE LI,P1 RREG,DECPS
         BAL,L1   PIX02             WRITE BAL,L1 C:CD-
         B        *L0               RETURN                              21268
*
* SFLD = INDEX/BIN/FLP, RFLD = NC                                       2130
*                        D1 = SREG
*                        V1 = DECPR
NRR16    RES      0
         LW,V0    D1                LOAD SREG
         LW,D3    V1                LOAD DECPR
* *** ALTERNATE ENTRY *******
         BAL,L1   ORR14             WRITE LI,P1 SREG,-
         LW,V0    KCVTD-8,R7        LOAD C:C-D NAME
         BAL,L1   PIX02+1           WRITE BAL,L1 C:C-D
* *** NO CHECK FOR UNSIGNED*********
         B        *L0
* SFLD = INDEX
* RFLD NOT= INDEX                                                       12
NRR22    RES      0
         LW,D3    JSUBF             LOAD,CHECK SUBFC                     2
         BLZ      NRR29+1           < 0, INTEGER                         5
* INDEX NOT CONVERTED                                                   16
         LI,R1    -1                NEW SUBFC = -1(INTEGER)           11
         CI,D3    X'E0000'          CHECK SUBFC                          3
         BAZ      NRR27-1           = 1/0                                6
* SUBFC NOT= 1/0                                                         7
NRR23    RES      0
         BAL,L1   ORR22             CHECK SUBFO                          7
* SUBFC POOLED
*                        V0 = DW,SREG                                    6
*                        D3 = SUBFC BASE(=8),DISPL                       3
         BAL,L1   PRL22             WRITE DW,SREG SUBFC                 61
* SUBFO = 1/0                                                            8
* **                     LW,SREG SREG/DW,SREG,SUBFC WRITTEN              9
         B        NRR26             SUBFO = 1/0                         10
* SUBFO = -1                                                            11
NRR24    RES      0
         CI,R1    0                 CHECK SUBFR                         13
         BLZ      NRR28             = -1, INTEGER
* SUBFO >/= 0                                                           15
         LI,D3    -1                LOAD -1                             16
NRR25    RES      0
         AND,V0   K3F0              MASK SREG                           19
         AI,V0    CAI+X'F'          FORM AI,SREG -                      18
         LH,L1    JSET              SET UP/DOWN
         BNEZ     NRR28             YES
         B        NRR27+2           WRITE AI,SREG -1
* SUBFO = 1/0                                                           18
NRR26    RES      0
         CI,R1    0                 CHECK SUBFR                         19
         BGE      NRR28             >/= 0
* SUBFR = -1                                                            21
         LI,D3    1                 LOAD 1                              22
NRR27    RES      0
         AND,V0   K3F0              MASK SREG
         AI,V0    CAI               FORM AI,SREG                        22
         BAL,L1   PIA22             WRITE AI,SREG +/-1                  23
*                        V0 = -,SREG                                    24
NRR28    RES      0
         AND,V0   K3F0              MASK SREG                           26
         LW,D1    V0                RESTORE SREG                        27
*                        R1 = NEW SUBFC
*                        D0 = RREG                                      28
NRR29    RES      0
         STH,R1   JSUBF             SUBFC = NEW SUBFC
         LW,V0    D0                RESTORE RREG
         B        *L0               RETURN                              10922
*                                                                       30
* RFLD = INDEX                                                          60
*                        V1 = SUBFR                                      1
NRR32    RES      0
         AI,R6    1                 RFLD CLASS = BIN
         CH,V1    JSUBF             COMPARE SUBFR,SUBFC                  2
         BE       NRR29+1           SUBFR = SUNFC
* SUBFR NOT= SUBFC                                                       4
         LW,D3    JSUBF             LOAD CHECK SUBFC,SUBFO               5
         BEZ      NRR29+1           = 0, I5DEX DATA
* SFLD NOT= INDEX DATA                                                   7
         LW,R1    V1                NEW SUBFC = SUBFR                    8
         BDR,V1   NRR36             SUBFR > 1
* SUBFR = 0/1                                                           10
         BNEZ     NRR35             SUBFR NOT= 0(=1)
* SUBFR = 0                                                             34
         BAL,L1   ORR32             CHECK SUBFO                         35
         B        NRR33             SUBFO NOT= S4&FC
* SUBFO = SUBFC                                                         37
*                        V1 = SUBFO                                     38
         CI,V1    0                 CHECK SUBFO                         39
         BGE      NRR29+1           >/= 0
         B        NRR25-1           = -1, WRITE AI,SREG -1              41
* SUBFO NOT= SUBFC                                                      42
*                        V1 = SUBFO                                     43
NRR33    RES      0
         CI,V1    1                 CHECK SUBFO                         44
         BLE      NRR35             </= 1
* SUBFO > 1
         LW,R1    V1                SUBFR = SUBFO                       46
NRR34    RES      0
         LAB,L1   ORR24,NRR28-1     > 1. W9ITE 3W,S9EG SFLD             48
* SUBFR = 1                                                             49
NRR35    RES      0
         CI,D3    X'20000'          CHECK SUBFC                         50
         BGE      NRR23             > 1.
         BAZ      NRR29+1           = 0/1
         B        NRR25-1           = -1
NRR36    RES      0
* SUBFR > 1                                                             29
         BAL,L1   ORR32             CHECK SUBFO,SUBFC                   61
         BAL,L1   NRR39             SUBFO NOT= SUBFC
* SUBFO = SUBFC                                                         63
         CI,D3    X'20000'          CHECK SUBFC                         64
         BGE      NRR38             SUBFC
* SUBFC < 2                                                             13
*                        R4 = 1                                         66
         STH,R1   D3,R4             STORE SUBFR                         67
*                        D3 = SUBFC,SUBFR                               68
NRR37    RES      0
         AI,V0    CMI               LOAD MI,SREG                        39
         CI,D3    0                 CHECK SUBFC                         69
         BGE      NRR27+2           >/= 0. WRITE MI,SREG SUBFC
* SUBFC = -1                                                            71
         BAL,L1   PIA22             WRITE MI,SREG SUBFR                 41
         LCW,D3   R1                LOAD -SUBFR                         73
         B        NRR25             WRITE AI,SREG -SUBFR
* SUBFC >/=2                                                            20
NRR38    RES      0
         BAL,L1   ORR22             CHECK SUBFO                         81
* SUBFC POOLED                                                          82
*                        V0 = DW,SREG                                   60
*                        D3 = SUBFC BASE,DISPL                          12
         BAL,L1   PRL22             WRITE DW,SREG SUBFC                  8
* SUBFO = 1/0                                                           83
         AI,R1    X'20000'          SET SUBFC > 1                       84
* SUBFO = -1                                                            85
         AI,R1    X'F0000'          SET SUBFC >/< 0                     86
         LW,D3    R1                LOAD SUBFC,SUBFR                    87
         AND,V0   K3F0              MASK SREG                           88
         B        NRR37
* SUBFO NOT= SUBFC                                                      90
*                        V1 = SUBFO                                     91
NRR39    RES      0
         CW,R1    V1                COMPARE SUBFR,SUBFO                 93
         BE       NRR34             SUBFR = SUBFO
* SUBFR  NOT= SUBFO                                                     35
         CI,D3    X'FFFF'           CHECK SUBFO                         95
         BANZ     *L1               NOT= 0                              96
* SUBFO = 0                                                             97
         BGE      NRR29+1           SUBFC NOT= -1
         B        NRR25-1           = -1, WRITE AI,SREG -1
* SFLD = BIN, RFLD = FLP                                                2140
NRR40    RES      0                                                     21400
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F                                                  3
NRR41    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
NRR42    RES      0                                                     21420
         BAL,L1   ORR05             WRITE LW,RREG SREG(FORCE EVEN)
         BAL,L1   ORR03             WRITE LI,RREG+1 0
* CONVERT BIN TO FLP                                                    2144
*                        V0 = OP CODE - LI,RREG+1
         AI,V0    CS-CLI-CRR1       FORM OP CODE - S,RREG
         LBAL     PIA02,CSAD+X'78',D1 WRITE SAD,RREG -8
         AI,V0    CEOR-CS           FORM OP CODE - EOR,RREG             21462
         LBAL     PRG02,DGFZ,D1     WRITE EOR,RREG L(FS'0.E8')
         AI,V0    CFAL-CEOR         FORM OP CODE - FAL,RREG
         BAL,L1   PIY01             WRITE FAL,RREG L(FL'0.E8')          21465
*                        R6 = RFLD CLASS
         CI,R6    X'E'              RFLD = FLS
         BNE      NRR46             NO
* RFLD = FLS
*                        V1 = ORIG. RREG
NRR44    RES      0
         LI,D1    X'E0'             MASK RREG(EVEN)
         AND,D1   V1
         LBAL     ORR07,CLI+CP1     WRITE LI,P1 RREG(EVEN)
         BAL,L1   PIX06             WRITE
         TEXT     ':CFE'            ****  BAL,L1 C:CFE
*                        V1 = ORIGINAL RREG
NRR46    RES      0
         CI,V1    X'10'             CHECK FOR EVEN RREG
         BAZ      *L0               YES. RETURN
* ODD RREG
         LI,D1    X'E0'             MASK RRGE(EVEN)
         AND,D1   V1
         LW,V0    V1                RESTORE ORIGINAL RREG
         BAL,L1   ORR06             WRITE LW,RREG  RREG-1
* ******LOAD INTO ODD REGISTER IN V1 CAN BE DONE(V1 NOT= RREG+1)********
         B        *L0               RETURN                              21484
* FLS TO BIN                                                            2160
NRR60    RES      0                                                     21600
         LH,R7    0,R2              LOAD,MASK,SFLD CLASS
         AND,R7   K30F
NRR61    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V0 = RECEIVING REGISTER(RREG)                  2162 8
*                        D1 = SENDING REGISTER (SREG)                   2162 9
NRR62    RES      0                                                     21620
         BAL,L1   ORR05             WRITE LW,RREG  SREG(FORCE EVEN)
         BAL,L1   ORR03             WRITE LI,RREG+1 0
* CONVERT FLP TO BIN
NRR64    RES      0
* **                     RREG,RREG+1 = FLS,0/FLL                        217001
*                        V0 = OP CODE - LW/LD,RREG                      217008
* ***                    R1 VOLATILE
         AND,V0   K3E0              MASK,SAVE RREG(FORCE EVEN)
         LW,D1    V0
         LBAL     ORR07,CLH+CRR1    WRITE LH,R1 RREG   LOAD SIGN,CHAR'C
         BAL,L1   PIA26             WRITE
         SCS,R1   8                 ****     POSITION SIGN,CHAR'C
         LBAL     PIA02,CSTB+CRR1   WRITE STB,R1 RREG  STORE SIGN
*                        D1 = RREG
         BAL,L1   PIA26             WRITE
         LAW,R1   R1                ****     SET CHAR'C +
         BAL,L1   PIY33             WRITE
         LH,R1    R1                ****     LOAD CHAR'C
         BAL,L1   PIY33             WRITE
         SLS,R1   2                 ****     CHAR'C  TO BIN EXP
         BAL,L1   PIY33             WRITE
         AI,R1    -X'118'           ****     ADJUST BIN EXP FOR INTEGER
         SLS,D1   4                 POSITION RREG
         AI,D1    CS+CIR1           FORM SAD,RREG  0,R1
         LI,D3    CSAD
         STH,D1   D3
         LAB,L1   WRPOF,NRR46       WRITE SAD,RREG  7,R1
* FLS TO FLL
NRR70    RES      0
         LH,R7    0,R2              LOAD,MASK SFLD CLASS
         AND,R7   K30F
NRR71    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        V0 = RREG
*                        D1 = SREG
NRR72    RES      0
         BAL,L1   ORR06             WRITE LW,RREG SREG
         BAL,L1   ORR03             WRITE LI,RREG+1 0
         B        *L0               RETURN
* FLL TO BIN                                                            2182
NRR80    RES      0                                                     21800
         LH,R7    0,R2              LOAD,MASK SFLD CLASS
         AND,R7   K30F
NRR81    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
*                        D1 = SENDING REGISTER (SREG)                   2182 9
NRR82    RES      0
         LW,V1    V0                SAVE RREG
         AND,V0   K3E0              FORCE EVEN
         LAB,L1   ORR08,NRR64       WRITE LD, RREG SREG
* FLL TO FLS
NRR90    RES      0
         LH,R7    0,R2              SFLD CLASS
         AND,R7   K30F
NRR91    RES      0
         BAL,L1   NRA91             SAVE REG, LOAD PARAMETERS
*                        V0 = RREG
*                        D1 = SREG
NRR92    RES      0
         LW,V1    V0                SAVE RREG
         AND,V0   K3E0              FORCE EVEN
         LAB,L1   ORR08,NRR44
* ND TO UNPACK AREA(UNPKA)                                              120
NRD00    RES      0
         LH,R7    0,R2              LOAD,MASK SFLD CLASS
         AND,R7   K30F
NRD01    RES      0
         BAL,L1   NRA91             SAVE REGISTERS,LOAD PARAMETERS
         LBAL     SSS02-1,CRE       CHECK SUBSCRIPTS
         B        NRD02             SUBSCRIPTED
         MTW,0    LNKSF
         BNEZ     NRD02             IN LINKAGE SECTION
         BAL,L1   PID16             WRITE
         LI,RE    0                 ****  LI,RE BA(SFLD)
* *** BBE74 ENTRY ******************
         LI,D3    0                 CLEAR BASE,DISPL
*                        V0 = MBS,RE(=BA(ND FLD(+SUBSCR)))
*                        V1 = BSIZ(</= 31)                              1202 7
*                        D3 = ND BASE,DISPL                             1212 9
*                          = 0 IF NOT SUBSCRIPTED
* **                     RE = BA(ND FLD(,SUBSCR.))                      1202 1
NRD02    RES      0
         LI,D2    0                 SET BA ADDR. RES.(=0)               12022
         STB,V1   D2                BSIZ TO CONSTANT PORTION            12023
         LW,V1    D3                SAVE SUBSCRIPT FLAG
*                        D2 = BSIZ,0                                    120898
         LW,D3    KUNPKA            LOAD UNPKA BASE(=6),DISPL(=1)       12024
         LBAL     PDD04,DADD,D0     WRITE ADCON BSIZ,BA(UNPKA)          12026
*                        D1 = ADCON NO.                                 120269
         AI,V0    CLW+X'10'         FORM OP CODE - LW,RO
         BAL,L1   PRA01             WRITE LW,RO  ADCON
         MTW,0    LITF
         BNEZ     NRD03             LITERAL SFLD
         STW,V0   TMPV0
         STD,L0   VRSAV
         LI,L0    0
         XW,L0    ARTHF
         BEZ      %+2
         STW,L0   RFLDF             SET SAVE VAR ADDR FLAG
         SLS,V0   -4
         AND,V0   L(X'E')           RO FOR VAR REC
         BAL,L0   VPP10             RESOLVE VAR REC
         LW,V0    TMPV0
         LD,L0    VRSAV
NRD03    AI,V0    CMBS-CLW-X'10'    FORM OP CODE - MBS,RE
         MTW,0    LNKSF
         BNEZ     NRD05             IN LINKAGE SECTION
         LB,D3    D2                LOAD BSIZ
         XW,D3    V1                EXCHANGE BSIZ,SUBSCRIPT FLAG
         BEZ      NRD04             SUBSCRIPT FLAG DOWN.  RE = BA(SFLD)
* RE = SFLD SUBSCRIPT
         LAB,L1   PID10,NRD06       WRITE MBS,RE BA(SFLD)
* RE = BA(SFLD)
NRD05    LI,D3    0                 IN LINKAGE SECTION
         STW,D3   LNKSF
         LB,V1    D2                SIZE
NRD04    RES      0
         BAL,L1   PIA22             WRITE MBS,RE 0
NRD06    RES      0
         MTW,1    NOVF
         LI,V0    CPACK             LOAD PACK,-
         LW,D3    K6BAS             LOAD UNPKA BASE,DISPL-1
         BAL,L1   ORD12+1           WRITE PACK,L UNPKA
         B        *L0               RETURN                              20084
*                                                                       1212
* CLEAR ODD REGISTER                                                    3004
*                        V0 = RECEIVING REGISTER(RREG)                  3004 8
*                        D1 = SENDING REGISTER (SREG)                   3004 9
ORR03    RES      0
         AND,V0   K3E0              FORCE EVEN
ORR04    RES      0                                                     30040
         AI,V0    CLI1              FORM OP CODE - LI,REG+1             30042
         LAB,D3   PIA22,0           WRITE LI,RREG+1 0                   30044
ORR05    RES      0                                                     30050
         LW,V1    V0                SAVE RREG
         AND,V0   K3E0              FORCE EVEN
* CHECK,LOAD SINGLE
*                        V0 = RECEIVING REGISTER(RREG)                  3006 8
*                        D1 = SENDING REGISTER (SREG)                   3006 9
ORR06    RES      0                                                     30060
         CW,V0    D1                COMPARE RREG(EVEN),SREG
         BE       *L1               =, LOAD UNNECESSARY
         AI,V0    CLW               FORM OP CODE - LW,RREG              30062
ORR07    RES      0                                                     30070
*                        V0 = OP CODE - LW/LD,RREG                      300708
*                        D1 = SREG                                      300709
         SLS,D1   -4                POSITION SREG FOR RA                30072
         B        PIA02             WRITE LW/LD,RREG                    30074
* CHECK,LOAD DOUBLE
*                        D1 = SENDING REGISTER (SREG)                   3008 9
ORR08    RES      0                                                     30080
         CW,V0    D1                COMPARE RREG,SREG
         BE       *L1               =, LOAD UNNECESSARY
         AI,V0    CLD               FORM OP CODE - LD,RREG              30082
         B        ORR07                                                 30084
*
* WRITE LI,P1 SREG/RREG(,DECPS)
*                        V0 = SREG/RREG
*                        D3 = DECPS/DECPR
ORR14    RES      0
         AI,V0    -X'40'            RREG = RREG-4
         AND,V0   K3F0              MASK,POSITION RREG
         SLS,V0   -4
         AI,V0    CLI+CP1           FORM LI,P1 RREG,-
* **                     RREG - 4 USED
         B        PIA22             WRITE LI,P1 RREG/SREG/(,DECPS/DECPR)
*
* CHECK SUBFO                                                            1
*                        V0 = SREG                                       2
*                        D3 = SUBFC,SUBFO                                3
ORR22    RES      0                                                      4
         CI,D3    X'FFFE'           CHECK SUBFO                          8
         BAZ      ORR24             = 1/0                                5
         CI,D3    X'8000'           CHECK INTEGER FLAG                  31
         BAZ      ORR26             DOWN. SUBFO >/= 2                    6
* SUBFO = INTEGER
         AI,L1    1                 SET LINK REGISTER                    7
* SUBFO < 2                                                             25
ORR24    RES      0
         LW,D3    JIFLD             LOAD INDEX BASE,DISPL               12
         BEZ      ORR25             = 0, SFLD NOT INDEX/BIN              8
* SFLD = BIN/INDEX
         AI,L1    1                 SET LINK REGISTER
         AI,V0    CLW               FORM LW,SREG -(,SXR)                15
         AW,V0    JIFLDS                                                16
         B        PID11             WRITE LW,SREG INDEX(,SXR)            9
* SFLD NOT BIN/INDEX
ORR25    RES      0
         LW,D3    JSUBF             RESTORE SUBFC,SUBFO
         AI,L1    -1                RESET LINK REGISTER                 10
* POOL SUBFC                                                            11
*                        V0 = SREG                                      50
*                        D3 = SUBFC,SUBFS                                3
ORR26    RES      0                                                     12
         SLS,D3   -16               POSITION SUBFC                       7
         AI,V0    CDW               FORM DW,SREG                        53
         B        LIT05             POOL SUBFC                          54
*                        V0 = DW,R7                                      9
*                        D3 = SUBFC BASE(=8),DISPL                      10
*
* CHECK SUBFO,SUBFC                                                     13
ORR32    RES      0                                                     14
         LI,R4    1                 LOAD,CHECK SUBFO                    16
         LH,V1    D3,R4                                                 17
* ** V1 (=SUBFR ON ENTRY) CAN BE USED***                                15
         CH,V1    D3                                                    18
         BE       *L1,R4            SUBFO = SUBFC                       19
* SUBFO NOT= SUBFC                                                      20
         B        *L1                                                   21
*                        V1 = SUBFO                                     22
*
* DL NC/PACK ND                                                         81
*                        R7 = SFLD CLASS                                82
ORD11    RES      0                                                     83
         CI,R7    8                 CHECK SFLD CLASS                    84
         BANZ     ORD22             SFLD = NC                           85
* SFLD = ND                                                             86
         AI,R7    2                 SFLD CLASS = NCS/NCU                87
* PACK ND
*                        V1 = BSIZ                                      1212 7
*                        D3 = ND BASE,DISPL                             1222 9
*                        V0 = ND INDEX/0(NO BYTE OFFSET/SUBSCR.)        1212 6
ORD12    RES      0
         AI,V0    CPACK             FORM OP CODE - PACK,L -(,X)         12126
         SLS,V1   3                 FORM PACKED DECIMAL BSIZ(LSIZ)      12122
         AI,V1    X'10'             *    = BSIZ/2 + 1                   12123
         B        ORD24             PACK
*
* WRITE DECIMAL INSTRUCTION
*                        V0 = NC INDEX/0(NO BYTE OFFSET/SUBSCRIPT)
*                        D3 = BASE,DISPL                                1224 9
ORD22    RES      0
         LH,V1    3,R2              LOAD LSIZ(=BSIZ)
ORD23    RES      0
         AI,V0    CDL               FORM OP CODE - DL,- -(,X)
         SLS,V1   4                 POSITION LSIZ
ORD24    RES      0
         AND,V1   K3F0                                                  12224
* ** ENTRY FROM BIN/FLP LOAD
*                        V1 = RREG FOR INDEX/BIN/FLP
*                           = L FOR NC
*                        L1 = LINK REGISTER
ORD30    AW,V0    V1                FORM OP CODE - DEC.INSTR,L -(,X)
         STD,L0   VRSAV
         MTW,0    NOVF
         BNEZ     ORD32             NO VAR REC NEEDED
         LI,L0    0
         XW,L0    ARTHF
         BEZ      %+2
         STW,L0   RFLDF             SET SAVE VAR ADDR FLAG
         BAL,L0   VPP30             RESOLVE VAR REC
ORD32    LI,L0    0
         STW,L0   VBIDX             RESET VBIDX
         STW,L0   NOVF
         LD,L0    VRSAV
         MTW,0    LNKSF
         BNEZ     MDF65+2
         CI,D3    0                 CHECK BASE,DISPL
         BEZ      PIA22             = 0, WRITE DEC.INSTR.,L ND/NC,X
         B        PID11             WRITE DEC INSTR,L ND/NC(,X)
* BIN/FLP DREF
*                        R6 = RFLD CLASS                                1242 4
*                        R7 = SFLD CLASS                                1242 5
*                        V0 = INDEX REGISTER/0(NO SUBSCRIPTS)           1242 6
*                        V1 = RREG                                      1242 7
*                        D3 = BASE,DISPL                                1242 9
* SFLD = BIN                                                            1240
* SFLD = FLS                                                            1260
ORD42    RES      0
         AI,V0    CLW               FORM OP CODE - LW,-  -(,XR)         12422
         MTW,2    VBIDX
ORD44    RES      0
         AH,V0    JRNEG             (FORM LCW/LCD,R-  -(,SXR))
* *** NO CHECK FOR UNSIGNED*********
         B        ORD30             WRITE LOAD INSTR
* SFLD = FLL                                                            1280
ORD48    RES      0
         AI,V0    CLD               FORM OP CODE - LD,-  -(,XR)         12822
         MTW,3    VBIDX
         B        ORD44
*                                                                       10
LRA90    RES      0
LRA91    RES      0
         LCI      10                SAVE REGISTERS
         STM,R6   LRASAV                                                00003
         LI,L0    LRA93             SET LINK REGISTER
* SET LOAD PARAMETER REGISTERS
*                        R6 = REGISTER,CLASS                            0002 6
LRA92    RES      0
         LI,V0    X'F0'             MASK SAVE RECEIVING REGISTER(RREG)  00022
         AND,V0   R6                                                    00023
         EOR,R6   V0                SAVE RFLD CLASS                     00024
         STD,V0   LRAREG            SAVE RREG/SREG,DECPR/DECPS
         B        *L1               TO LOAD
LRA93    RES      0
         LCI      10                RESTORE REGISTERS
         LM,R6    LRASAV                                                00904
         B        *L0               RETURN                              00922
MRA90    RES      0
MRA91    RES      0
         LCI      10                SAVE REGISTERS
         STM,R6   MRASAV                                                11103
         BAL,L0   LRA92             SET PARAMETERS
         LCI      10                RESTORE REGISTERS
         LM,R6    MRASAV                                                10904
         B        *L0               RETURN                              10922
NRA90    RES      0
NRA91    RES      0
         LCI      10                SAVE REGISTERS
         STM,R6   NRASAV                                                21303
         BAL,L0   LRA92             SET PARAMETERS
         LCI      10                RESTORE REGISTERS
         LM,R6    NRASAV                                                20904
         B        *L0               RETURN                              20922
*
         BOUND    8
VRSAV    RES      2
TMPV0    RES      1
NOVF     DATA     0
RFLDF    DATA     0
ARTHF    DATA     0
         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
K201     EQU      KBKON+10
K310     EQU      KBKON+13
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      JDECP,JDSIZ
JSAVD    EQU      JDECP+14          SAVE DECA FLAG
JSFLD    EQU      JDSIZ+4
JSFLDS   EQU      JDSIZ+5
JIFLD    EQU      JDSIZ+15          INDEX BASE,DISPL
JIFLDS   EQU      JDSIZ+16          INDEX SUBSCRIPT FLAG
JSUBF    EQU      JDSIZ+17          INDEX SUBFC,
JRFLD    EQU      JDSIZ+18          RFLD CLASS
JRNEG    EQU      JDSIZ+19          NEGATE FLAG
JSET     EQU      JDSIZ+24          SET UP/DOWN
         REF      JSXR
         REF      KCVTD             SUBROUTINE NAME
         REF      LRASAV            LOAD,STORE
MRASAV   EQU      LRASAV+10         R6-D3
NRASAV   EQU      MRASAV+10         R6-D3
*        BOUND    8
LRAREG   EQU      NRASAV+10         RREG/SREG,DECPR/DECPS
LRALNK   EQU      LRAREG+2          CURRENT LINK
MRALNK   EQU      LRALNK+1          CURRENT LINK
NRALNK   EQU      MRALNK+1          CURRENT LINK
         END
