         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.2 - M.C'
* 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
* ALIGNMENT PROC
ORGA     CNAME
         PROC
         BOUND    8
         PEND
* EXTERNAL REFERENCES
         REF      BBA00             REGISTER LOAD
         REF      BBB00             MOVE-2
         REF      BBC00             MOVE
         REF      BBD00             EXAMINE
         REF      BBG00             ADD,SUBTRACT
         REF      BBH00             MULTIPLY,DIVIDE
         REF      BBI00             I/O
         REF      BBM00             ACCEPT,DISPLAY
         REF      BBP00             ALTER
         REF      BBT00             PROGRAM FLOW, TESTS
         REF      BCB00             CONDITIONAL-1
         REF      BCC00             CONDITIONAL-2
         REF      BCD00             SORT
         REF      BCE00             SET UP/DOWN BY
         REF      BCF00             CORRESPONDING
         REF      BCT00             TRACE
         REF      SSS10,SSS18       CORRESPONDING,GRP SWITCHES
         REF      PH42E             PHASE 4,2 EXIT
         REF      WRPOF
         REF      RDMCF
         REF      LIT340            WRITE POOL
         REF      PDBQ
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
         REF      ON:LINE,PIX06,PIA06
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      LNKSF,SLNKF
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
* REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
RB       EQU      R6                BIN
RF       EQU      V2                FILE CNTL
RE       EQU      4                 EVEN
RO       EQU      5                 ODD
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'                                                  CIR7
* R REGISTERS                                                           CR
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
CRF      EQU      CRV2              FILE CNTL
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES                                                              C0
CCAL1    EQU      X'0400'           CAL1                                C04
CLI      EQU      X'2200'           LI                                  C22
CLW      EQU      X'3200'                                               C32
CSTW     EQU      X'3500'           STW                                 C35
CSTS     EQU      X'4700'           STS                                 C47
CEOR     EQU      X'4800'           EOR                                 C48
COR      EQU      X'4900'           OR                                  C49
CMBS     EQU      X'6100'           MBS                                 C61
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
CBAL     EQU      X'6AB0'           BAL,L1
CLB      EQU      X'7200'                                               C72
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
DARC     EQU      X'0419'           COMMON
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'           TEMP STG
* DATA DEF
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADL     EQU      X'0626'           LOC. CNTR
DADA     EQU      X'052D'           AN
DADX     EQU      X'0328'           EXTERNAL NAME
* DEFINITIONS/DECLARATIONS
DAPI     EQU      X'0341'           INTERNAL LABEL
DAPP     EQU      X'0246'           PRIORITY SEGMENTATION
* 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
* REGISTER SAVE LEVELS
DSS      EQU      1                 SUBSCRIPT
DSL      EQU      2                 STORE
DSG      EQU      4                 GENERATOR
* TEMP REGISTER SAVE AREAS
DTB      EQU      9                 BIN
DTF      EQU      18                FLP
DTCSX    EQU      20                CORRESPONDING SXR1,SXR2
DTD1     EQU      10                DECA - SUBSCRIPT
DTD2     EQU      14                DECA - STORE
DTD4     EQU      22                DECA - GENERATORS
DTWA     EQU      28                WA TMP WORK AREA
DTBA     EQU      DTWA*4            BA TMP WORK AREA                    22
*
CJIA     EQU      X'981'            AN
*
* BUFFERS,INDICATORS
         DEF      MCBUF,MDBUF
         DEF      MCLIT,MCLIT1,MLBUF
         DEF      JINTE             INTL NO
         DEF      JDECP,JDSIZ
         DEF      JSXR,JSSCX,JSXSX
         DEF      JCSXR             CSXR SAVE
         DEF      JAIXC,JADXC,JSORT
         DEF      JAIDW             DATA REF
         DEF      JTTBS             TTBS TABLE
         DEF      JCREF             CONDITION FLAG                      COBOL42A
* CONSTANTS
         DEF      KBKON,K4BAS,K6BAS
         DEF      KCVTD             SUBROUTINE NAME
         DEF      KABA
* SAVE AREAS
         DEF      SSSAV
         DEF      LRASAV            LOAD,STORE
         DEF      MDFSAV            STORE
         DEF      BBCSAV            MOVE
         DEF      BBOSAV            I/O
         DEF      BCASAV            CONDITIONAL
* ENTRY POINTS
         DEF      COB42             PHASE 4.2 ENTRY POINT
         DEF      BAA02             READ RETURN
         REF      VRPPD,LITF,NOVF
         REF      RFLDF,ARTHF
         DEF      VRPF,BAA46,BAA52
         DEF      VRPMD,VRSAV,BAA48
         DEF      BAA40,BAA42                                            2
*
* PHASE 4.2 - MASTER CONTROL                                            BAA0
COB42    RES      0                 PHASE 4.2 ENTRY POINT
*                                                                       BAA02
BAA02    RES      0                                                     BAA020
         RMCF                       READ CLUSTER                        BAA022
         LI,R5    -1                LOAD BYTE INDEX                     BAA032
         LH,R1    0,R2              LOAD CLNG,CNTL
         LB,R4    R2,R5             LOAD,CHECK CNTL
         CI,R4    X'4F'
         BGZ      BAA20             MCF CLUSTER                         BAA036
* POF CLUSTER                                                           BAA04
         BNEZ     BAA05             NOT E-O-POF                         BAA042
* E-O-POF                                                               BAA045
         LI,L1    BAA04             SET LINK REGISTER
* CHECK,WRITE LITERAL POOL
*                        L1 = LINK REGISTER                              4
BAA03    RES      0                                                      5
         LW,V1    MCLIT+1           CHECK FOR LITERAL POOL
         BEZ      *L1               NO. LITERAL POOL NOT FORMED          7
* LITERAL POOL FORMED                                                    8
         CI,V1    X'100'            CHECK FULL BUFFER
         BAZ      BAA032            NO.
* FULL BUFFER
         LW,L0    L1                SET LINK RIGISTER
         LAB,R3   LIT340,1          WRITE FULL BUFFER
BAA032   RES      0
         AI,V1    9                 CLNG = (BLNG+9)/2                    9
         SLS,V1   -1                                                    10
         STH,V1   MCLIT             STORE CLNG                          11
         WPOF     ,BA(MCLIT)+1,,0   WRITE LITERAL POOL                  12
BAA04    RES      0
         LI,L1    BAA08             SET LINK REGISTER                   BAA046
         B        BAA07
BAA05    RES      0                                                     BAA050
         CI,R4    X'47'             LINE NUMBER                         COBOL42A
         BNE      BAA051            NO.                                 COBOL42A
         LH,R4    1,R2              YES.                                COBOL42A
         STW,R4   PDBX              STORE SUB LINE #                    COBOL42A
         AI,R2    1                                                     COBOL42A
         LH,R4    0,R2                                                  COBOL42A
         AI,R2    -1                                                    COBOL42A
         STH,R4   PDBX              MOVE LINE #                         COBOL42A
         MTW,0    ON:LINE
         BEZ      BAA051
         LW,R4    PDBX              YES.
         LW,11    LINER             GET PREV LINE ID                    COBOL42A
         SCS,11   16                                                    COBOL42A
         CW,R4    11                                                    COBOL42A
         BG       BAA0500           GREATER..STILL IN SEQ               COBOL42A
         BE       BAA050            SAME..NEED VERB #                   COBOL42A
         AND,11   =X'FFFF0FFF'      GET RID OF PREV VERB #              COBOL42A
         CW,R4    11                                                    COBOL42A
         BG       BAA0500           SUB WENT UP..IN SEQ                 COBOL42A
BAA050   RES      0                                                     COBOL42A
         LW,R4    LINER             PREV LINE ID                        COBOL42A
         SCS,R4   16                                                    COBOL42A
         AI,R4    X'1000'             PLUS VERB #                       COBOL42A
BAA0500  RES      0                                                     COBOL42A
         SCS,R4   16                PUT IN RUN-TIME FORM                COBOL42A
         STW,R4   LINER             SET UP STATEMENT FLAGS
         MTB,0    ON:LINE                                               COBOL42A
         BEZ      1STLINE                                               COBOL42A
         BAL,11   PIX06
         TEXT     ':DBG'
         BAL,11   PIA06
LINER    DATA     0
BAA051   RES      0                                                     COBOL42A
         AI,R1    -DAPP             CHECK FOR PRIORITY SEGMENT
         BNEZ     BAA06             NO.
* PRIORITY SEGMENT
         BAL,L1   BAA03             CHECK,WRITE LITERAL POOL            14
         STW,R1   MCLIT+1           INITIALIZE DISPL,BSIZ
BAA06    RES      0
         LI,L1    BAA02             SET LINK REGISTER                   BAA052
BAA07    RES      0
         LW,R4    R2                LOAD HA(CLOC)                       BAA062
         AW,R4    R4                HA(CLOC) TO BA                      BAA063
         B        WRPOF             WRITE POF CLUSTER                   BAA064
1STLINE  RES      0                                                     COBOL42A
         MTB,1    ON:LINE                                               COBOL42A
         B        BAA051            NO BAL TO DEBUGGER 1ST LINE         COBOL42A
* E-O-POF                                                               BAA08
BAA08    RES      0                                                     BAA080
         LW,R7    PDBZ+3            WA(DBINDX) TO BA
         SLS,R7   2
         STW,R7   PDBZ+3
         LW,D1    GADNO             SET BLNG OF ADCONS
         AI,D1    4
         STH,D1   PDBQ
         B        PH42E             RETURN TO 4.0
* MCF CLUSTER                                                           BAA20
BAA20    RES      0                                                     BAA200
         AW,R5    R2                SET HA(CLOC)-1                      BAA202
         LH,R6    1,R5              LOAD 2ND,3RD HALF-WORDS             BAA203
         LH,D1    1,R2                                                  BAA204
         LI,V0    R2                INITIALIZE SXR,DECA SAVE INDICATORS
         LI,V1    0
         STD,V0   JSXR
         STD,V1   JZREG             CLEAR ZERO REG. FLAG
         STW,V1   LNKSF
         STW,V1   SLNKF
         STH,V1   MDBUF-1           CLEAR SET DOWN BY FLAG              COBOL42A
         STW,V1   VRPF              RESET VRPF
         STW,V1   LITF
         STW,V1   NOVF
         AI,R4    -X'C0'            CHECK FOR LOAD CLUSTER
         BGEZ     BAA22
         STD,V0   VRSAV
         BAL,L1   BAA50
         LH,D1    1,R2              THIRD HALF WORD
         B        BBA00             LOAD REGISTER
BAA22    CI,R4    X'F0'             CHECK INVALID MCF
         BANZ     BAA02             INVALID MCF CLUSTER
* VALID MCF CLUSTER
BAA24    RES      0                                                     33
         LI,R3    0
         STW,R3   ARTHF
         STW,R3   RFLDF
         STW,R3   VRPMD             RESET COUNT
         STW,R3   VRPPD
         LI,R3    BA(MCBUF)
BAA25    RES      0
         AW,R2    R2                HA(CLOC) TO BA
         LB,R1    0,R2              CLNG TO MBS U1(=C)
         STW,R1   TMPL1
         AW,R1    R1
         CI,R1    255
         BLE      BAA251            CLNG < 255 BYTES
         AI,R1    -255
         STB,R1   R3
         MBS,R2   0
         LI,R1    255
BAA251   STB,R1   R3
         LW,R1    TMPL1
         MBS,R2   0                 MOVE DATA CLUSTER
         LI,R2    HA(MCBUF)         LOAD HA(MCF BUFFER)                 10
         LI,R3    HA(MCBUF)-1       LOAD HA(MCBUF-1
         EXU      BAA30,R4          STMT CLUSTER
         CI,R4    X'E'
         BE       BAA02             BWZ/*WZ
*                        R1 = CLNG
*                        R2 = HA(CLOC)
*                        R3 = HA(MCBUF)-1
*                        R4 = CNTL-X'C0'
*                        R5 = HA(CLOC)-1
*                        R6 = 2ND HALF WORD
*                        D1 = 3RD HALF WORD
* READ REQUST
         SLS,R2   -1     BA(NLOC) TO HA
BAA26    RES      0                                                     12
         LW,R5    R2                LOAD HA(NLOC)-1
         AI,R5    -1
         BAL,L1   BAA48
         EXU      BAA32,R4          EXECUTE ON STMT CNTL
*                        R2 = HA(NLOC)
*                        R5 = HA(NLOC)-1
* STATEMENT BRANCH TABLE
BAA30    RES      0                                                     BAA300
         B        BBT00             EXIT/GO TO                          BAA300
         B        BCT00             TRACE
         B        BBI00             I/O CALL                            BAA302
         B        BBM00             ACCEPT/DISPLAY                      BAA303
         BAL,L1   RDMCF             MOVE
         BAL,L1   RDMCF             MOVE-2
         BAL,L1   RDMCF             DATA MANIPULATION
         B        BBG00             A/S/M/D
         B        BBH00             COMPUTE
         BAL,L1   RDMCF             SET UP/DOWN BY
         B        BBP00             ALTER
         BAL,L1   RDMCF             CONDITIONAL-1
         BAL,L1   RDMCF             CONDITIONAL-2
         B        BCD00             SORT
         STW,D1   JINTE             BWZ/*WZ INTL RESERVE
         B        BCF00             CORRESPONDING
* ALTERNATE EXECUTE TABLE
BAA32    RES      0
         B        BAA44             SAVE DATA                           14
         B        *L1               SAVE DATA - RETURN                  15
         BAL,L1   BAA45             SAVE,READ DATA                      16
         B        *SSBSAV           SAVE,READ DATA - RETURN             17
         B        BBC00             MOVE                                BAA306
         B        BBB00             MOVE-2
         B        BBD00             DATA MANIPULATION
         B        BBG00             ADD,SUBTRACT
         B        BBH00             MULTIPLY,DIVIDE
         B        BCE00             SET UP/DOWN BY
         RES      1     ************
         B        BCB00             CONDITIONAL-1
         B        BCC00             CONDITIONAL-2
         RES      1      ***********
         B        BAA02             BWZ/*WZ INTL RESERVE
*
* SAVE OPERAND
*                        R2 = HA(CLOC)
*                        L1 = LINK REGISTER
*                        R1,R3,R4,R5,R6 VOLATILE
BAA40    RES      0
         STW,L1   SSBSAV            SET LINK REGISTER                   21
         LAB,R4   BAA43,BAA32-BAA30+2 SET EXECUTE INDEX                 22
BAA42    RES      0                                                     23
         LI,R4    BAA32-BAA30       SET EXECUTE INDEX                   24
BAA43    RES      0                                                     25
         LI,R3    BA(MDBUF)-2
         B        BAA25
BAA44    RES      0                                                     28
         LI,R2    HA(MDBUF)-1       LOAD HA(CLOC)                       29
         LAB,R5   *L1,HA(MDBUF)-2   SET HA(CLOC)-1
BAA45    RES      0                                                     31
         LI,R4    3
         STW,L1   RSL1
         BAL,L1   BAA46             READ NEXT CLUSTER
         SLS,R2   1                 TO BA
         LW,L1    RSL1
         B        *L1
*
*  SAVE VARIABLE RECORD PARAMETERS
*
BAA46    STW,L1   VSL1
         RMCF     R5                READ NEXT MCF
         LW,L1    VSL1
BAA48    STD,V0   VRSAV
         LH,V0    0,R2              CONTROL BYTE
         AND,V0   L(X'F0')
         CI,V0    X'80'
         BNE      BAA54             NOT VAR LENGTH
BAA50    LH,V0    1,R2
         BGEZ     BAA54             NOT APPLICABLE
         SLD,V0   -8
         XW,R2    V0
         AND,R2   L(X'7F')
         AW,R2    V0
         LH,R2    0,R2
         XW,R2    V0
         STH,V0   1,R2              RESET D FIELD
         LB,V0    V1
         BNEZ     BAA51             VAR REC
BAA53    LI,V0    0
         STW,R2   VSL1
         LW,R2    VRPMD
         CI,R2    122
         BL       BAA530
         LI,R2    0
         STW,R2   VRPPD
BAA530   STW,V0   VRPF,R2           0 IN PARAM COUNT
         AI,R2    1
         STW,R2   VRPMD
         B        BAA54-1
BAA51    STW,R2   VSL1
         AW,R2    V0
         LH,V1    0,R2
         SLS,V1   22
         LW,V0    R2
         B        BAA510
BAA511   LI,R2    0
         STW,R2   VRPMD
         STW,R2   VRPPD
BAA510   LB,R2    V1
         AW,R2    VRPMD
         CI,R2    122
         BG       BAA511
         AW,V1    VRPMD
         STW,R2   VRPMD
         AI,V1    VRPF
         SLS,V1   2                 VRPF+DISP BA
         AW,V0    V0
         MBS,V0   0                 SAVE PARAM
         LW,R2    VSL1
BAA54    LD,V0    VRSAV             RETURN
         B       *L1
BAA52    STD,V0   VRSAV
         LH,V0    4,R2              'C2' - WRITE VAR REC
         AND,V0   L(X'FF')
         BEZ      BAA53
         B        BAA51
*                        R2 = HA(NLOC)
*                        R5 = HA(NLOC)-1
*                        R6 = OPTIONS NLOC
*
* SWITCHES
JSXSX    B        SSS18             GRP SWITCH
JSSCX    B        SSS10             CORRESPONDING SUBSCRIPT
* INDICATORS
         ORGA     COB42  *************************                      35
         BOUND    8
JSXR     DATA     R2                SUBSCRIPT INDEX REGISTER(SXR)
JSALL    DATA     0                 ALL ANLIT FLAG(=BSIZS)
JCSXR    DATA     0                 CSXR SAVE
JDECP    DATA     0                 DECP
JDSIZ    DATA     0                 DSIZ
JBSIZ    DATA     0                 BSIZ
JMBSIZ   RES      1                 SFLD M(OVED)BS CNT
JCSAV    DATA     0                 CONDITION MODE SAVE
JSFLD    RES      1                 SFLD BASE,DISPL
JSFLDS   DATA     CRR2              SFLD SUBSCRIPT FLAG
JTEXT    DATA     -1,-1,-1,-1,-1,-1 TEXT(/PLIST)FLAGS
JZREG    DATA     0                 ZERO REGISTER
JSAVD    DATA     0                 SAVE DECA FLAG
JTRC     DATA     -1                TRACE FLAG
JIFLD    DATA     0                 INDEX BASE,DISPL
JIFLDS   DATA     0                 INDEX SUBSCRIPT FLAG
JSUBF    RES      1                 SUBF
JRFLD    RES      1                 RFLD CLASS
JRNEG    DATA     0                 NEGATE FLAG
JCREF    DATA     0                 CONDITION FLAG
JUNSD    RES      1                 UNSIGNED FLAG
JDSIZR   RES      1                 DSIZR
JPSIZ    RES      1                 ANE PSIZ
JSET     DATA     0                 SET UP/DOWN
         BOUND    8
         DATA     DAII              INTL REF CLNG,CNTL
JINTE    RES      1                 INTL NO.
* M:LINK SORT PLIST
JSORT    GEN,16,16 DADA+X'A00',0    CLNG,CNTL,ADCON BASE(=0)
         GEN,16,8,8 0,20,2          ADCON NO.,AN BLNG,M:LINK CODE
         GEN,24,8 2,4               ACCOUNT FLAG,'NAME' BLNG
         TEXT     'SORT   :'        'NAME'
         TEXT     'SYS     '        ACCOUNT
JAIXL    GEN,16,16 DAIX+X'600',CBAL
         GEN,16,8,8 0,5,C'L'
         DATA     C':RLR'
JAIXC    GEN,16,16 DAIX+X'600',CBAL BAL,L1 XREF CLUSTER
         GEN,16,8,8 0,5,C'C'                                            21292
         RES      1                                                     21293
JADXC    GEN,16,16 DADX+X'600',0    C:--- ADCON CLUSTER
         DATA     0
         GEN,16,8,8 0,5,C'C'
         TEXT     ':ABA'
JAIDW    DATA     DAID              CNTL
         DATA     2                 OP CODE,WA ADDR.RES.
         DATA     0                 BASE,DISPL
JDAN     GEN,16,16  CJIA,0          AN CNTL, OPTION
         GEN,16,16  0,X'600'        SUBSCR,BASE
         GEN,16,16  DTBA,0          DISP,DSIZ
         GEN,16,16  0,0             BSIZ,DECP
         BOUND    8
JTTBS    GEN,16,8,8    DADA+X'700',4,0  TTBS TABLE
         GEN,16,8,8   0,16,1
         GEN,8,8,8,8  1,1,1,1
         GEN,8,8,8,8  1,1,1,1
         GEN,8,8,8,8  1,1,1,1
         GEN,8,8,8,8  1,1,1,1
* CONSTANTS
KBKON    RES      0
K30E     DATA     X'0E'
K3E0     DATA     X'E0'             RE MASK
K30F     DATA     X'0F'
K3F0     DATA     X'F0'
K3FF     DATA     X'FF'
K2FFFF   DATA     X'FFFF'           HALF-WORD MASK
K0FF     GEN,8,24 X'FF',0
K2FF     DATA     X'FF00'
KF00F0   GEN,16,16 -1,X'F0'
K303     DATA     3
K201     DATA     X'100'
K301     DATA     1
K301S    DATA     X'FFFFFFFC'
K310     DATA     X'10'
K4BAS    GEN,8,24 4,0               GLOBAL LIT BASE,DISPL(=0)
K4SPAC   GEN,8,24 4,DGSPC           SPACE BASE,DISPL
K4AST    GEN,8,24 4,DGAST           ASTERISK BASE,DISPL
K032     GEN,8,24 50,0              I:,DCB BASE NO.ADJ.
K0A      GEN,8,24 10,0              LABEL AREA BASE NO.
K064     GEN,8,24 100,0             RECORD,DCB BASE NO. ADJ.
K6BAS    GEN,8,24 6,0               TMP BASE
KUNPKA   GEN,8,24 6,1               UNPACK AREA BASE(=6),DISPL
KUNPK4   GEN,8,24 6,4               UNPKA+1
KMSG     GEN,8,24 6,DTBA            MSG AREA
* CONVERSION SUBROUTINE NAMES                                           2129
KCVTD    RES      0                                                     21280
         TEXT     ':CDB'            DEC TO INDEX(=BIN)                  21281
         TEXT     ':CDB'            DEC TO BIN                          21282
         TEXT     ':CDE'            DEC TO FLS
         TEXT     ':CDF'            DEC TO FLL                          21284
         TEXT     ':CBD'            INDEX'=BIN) TO DEC                  21285
         TEXT     ':CBD'            BIN TO DEC                          21286
         TEXT     ':CED'            FLS TO DEC                          21287
         TEXT     ':CFD'            FLL TO DEC                          21288
* DISPLAY
         TEXT     ':DBD'            DISPLAY INDEX
         TEXT     ':DBD'            DISPLAY BIN
         TEXT     ':DED'            DISPLAY FLS
         TEXT     ':DFD'            DISPLAY FLL
         TEXT     ':ERR'            ERROR
         TEXT     ':TRC'            TRACE
         TEXT     ':TRX'            TRACE EXIT
         TEXT     ':ERA'
         TEXT     ':ABA'
KFIG     GEN,8,8,8,8 C'0',C' ',X'7D',0 FIGCON CHAR.
KABA     GEN,8,24 X'FF',DAIX+X'600' BAL,SR1 C:ABA CLUSTER
         BAL,SR1  0
         TEXTC    'C:ABA'
* SAVE AREA
         ORGA     COB42  *************************                      39
SSSAV    RES      6                 R2 - R7
SSSV0    RES      4                 V0 - L1
SSSD0    RES      4                 D0 - D3
SSBSAV   RES      1                 LINK REGISTER
         BOUND    8                                                     81
LRASAV   RES      10                R6-D3
MRASAV   RES      10                R6-D3
NRASAV   RES      10                R6-D3
LRAREG   DATA     0,0               RREG/SREG,DECPR/DECPS
LRALNK   RES      1                 CURRENT LINK                        00
MRALNK   RES      1                 CURRENT LINK                        10
NRALNK   RES      1                 CURRENT LINK                        20
         BOUND    8
* *** BBCSAV+1 MUST BE BOUND 8 *****
MDFSAV   RES      3                 STORE
BBCSAV   RES      4                 MOVE
BBOSAV   RES      3                 I/O
BCASAV   RES      13                CONDITIONAL
         ORGA     COB42 ************************************************
* BUFFERS
MCBUF    RES      66                MCF BUFFER
         DATA     0                 CLNG,CNTL
MDBUF    RES      75                DATA BUFFER
MLBUF    GEN,16,16 CJIA,0           ALL '1 CHAR' CNTL,OPTION
         DATA     X'800'            BYTE OFFSET,BASE NO.(=8)
         DATA     1                 DISPL,DSIZ
         GEN,16,16  1,0             BSIZ,DECP
* LITERAL CLUSTER
         BOUND    8
MCLIT1   GEN,16,16 DADA,X'0800'     1 CHAR. LIT CLNG,CNTL
         GEN,16,16 X'FF',X'100'
MCLIT    GEN,8,16,8 0,DADA+X'7F00',8   CLNG,CNTL
         GEN,24,8 0,0               DISPL,BSIZ
         RES      64                LITERAL POOL
         BOUND    8
VRSAV    RES      2                 SAVE V0, V1
VSL1     RES      1                 SAVE L1
RSL1     RES      1
TMPL1    RES      1
VRPMD    DATA     0
VRPF     DATA     0                 VAR REC PARAM FLAG, DISP
         RES      122
         ORGA     COB42 ************************************************
         END
