         SYSTEM   SIG7FDP
         SYSTEM   BPM
         TITLE    'PHASE 4.1 - PREF,PDEF'
* 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      6                 BIN
*CONDITION CODE EQUIVALENCES
CM       EQU      1                 NEGATIVE
CP       EQU      2                 POSITIVE
CZ       EQU      3                 ZERO(RESET)
CL       EQU      CM                LESS                                ADI
CG       EQU      CP                GREATER                             ADI
CE       EQU      CZ                EQUAL(RESET)
CV       EQU      4                 OVERFLOW
CC       EQU      8                 CARRY OVER
CA       EQU      CP                AND BIT
CB       EQU      CV                BIT COMPARE
         DEF      AA20 *************
         DEF      AA30              REGISTER LOAD
         DEF      AA80,AA84
         DEF      ABA00             PROCEDURE DEF
         DEF      ABT00,ABT36
         DEF      ABV00             ALTER
         DEF      ABX00             ENTER
         DEF      ABP00             PERFORM
         DEF      ABP01,ABP20
         DEF      ABP60
         DEF      ACI00             READY
         DEF      ACJ00             RESET
         REF      RDCRF
         REF      RDECF
         REF      WRPOF
         REF      WRMCF
         REF      DIAG
         REF      PDBK              MAX. INTL NO.(HALF-WORD)
         REF      AA01,AA02,AA03    M.C. RETURNS
         REF      AA09,AA092        DIAG RETURNS
         REF      AA10,AA11,AA12    WRITE MCF RETURNS/SUBR.
         REF      AA15,AA16,AA17    INTL DEF
         REF      AA18,AA19         INTL REF
         REF      AA46              BIN ADCON
         REF      AA49,AA50,AA51,AA52  ADCON
         REF      AA60,AA61         ADCON REF
         REF      AAC00             READ
         REF      ACP00             PERFORM VARYING
         REF      ACW00             SEARCH
         REF      ADC00
         REF      ADI00,ADI02       REF
         REF      ADO30             DCB BASE
         REF      PIA02,PIA06,PIA22
         REF      PII00,PII02,PII20,PII22
         REF      PIL06,PIL22
         REF      PIX06
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PPI10,PPI30
         REF      GADNO             ADCON NO.
         REF      JAKON,JADAT,JASAV,JAMOD
         REF      MEXER
         REF      STBAS             DATA STACK
         REF      PDBXA             LINE NO.
         REF      ALTGB,ALTGC,ALTGP
         REF      ADL00,JAIXC
         REF      PDBDBG,PDBDBGC                                        COBOL41B
         REF      PID11                                                 COBOL41B
         REF      JMCRD                                                 COBOL41B
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RCEF     CNAME    0                                                     APR00
RECF     CNAME    1                                                     APR01
RCRF     CNAME    2                                                     APR02
         PROC                                                           APR04
         DO       NAME>1                                                APR10
LF       BAL,L1   AAC00             READ CRF CLUSTER                    APR11
         ELSE                                                           APR12
         DO       NAME                                                  APR13
LF       BAL,L1   AAE00             READ ECF CLUSTER                    APR14
         ELSE                                                           APR15
LF       BAL,L1   *AF(3)            READ CRF/ECF CLUSTER                APR16
         FIN                                                            APR17
         FIN                                                            APR18
         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                                                     APR43
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
WMCF     CNAME    1                                                     APW01
         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       NAME                                                  APW80
         DO       NUM(AF(4))
         B        WRMCF             WRITE MCF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1    AF(3)             LOAD LINK REGISTER
         B        WRMCF             TO WRITE MCF CLUSTER
         ELSE                                                           APW812
         BAL,L1   WRMCF             WRITE MCF CLUSTER                   APW813
         FIN                                                            APW814
         FIN                                                            APW818
         ELSE                                                           APW82
         DO       NUM(AF(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1    AF(3)             LOAD LINK REGISTER
         B        WRPOF             TO WRITE POF CLUSTER
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         FIN                                                            APW85
         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              WRITE DMF CLUSTER
         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
* DIAG CODE BASE EQUIVALENCES
XPS      EQU      139               S DIAG CODE BASE - PROCEDURE
XPW      EQU      147               W DIAG CODE BASE - PROCEDURE
XRS      EQU      160               S DIAG CODE BASE - PARAMETER
XRW      EQU      163               W DIAG CODE BASE - PARAMETER
XEW      EQU       227              W DIAG CODE BASE - PROCEDURE        COBOL41B
*                                                                       AA0
CRR1     EQU      X'10'             R1
CBDN     EQU      X'700'          A DATA NAME REF(NOT COND/SUBS/FILE/PROABX061
CBPIM    EQU      X'466B'         A PAR TO INTL ADJUSTMENT              ABA301
CBPN     EQU      X'1000'         A PAR/SEC NAME REFERENCE(NOT EXTERNAL)ABT045
CBPOM    EQU      X'666A'         A PROCEDURE DEF OPTION VALUE ADJ.     ABA001
CBPS     EQU      X'400'          A PAR/SEC NAME REF(NOT DATA/COND/FILE)ABX063
CCAP     EQU      X'4000'         A PREF ALTERED PAR                    ABA103
CCOVO    EQU      X'200'            PREF WITHIN OVERLAY ONLY            ABA18826
CCPX     EQU      X'2400'           PREF PERFORM/SORT EXIT
CDFPS    EQU      X'E00'          A FLOATING POINT SINGLE CLASS         ADI725
CDIM     EQU      7                 NDIM MASK
CDIXD    EQU      X'C00'          A INDEX DATA CLASS                    ADI707
CDIXN    EQU      X'FCC00'        A INDEX NAME                          ADI241
CEBNO    EQU      X'500'            EXIT TABLE BASE NO.
CISAV    EQU      X'80000'          SAVE REF FLAG                       ADI455
CLOP     EQU      X'80'           A LAST OPERAND                        A
CMI      EQU      4                 MISCELLANEOUS SEG INCREMENT
CJINT    EQU      X'60B9D'          INTEGER                             57
CPSV     EQU      28                FROM,BY RESERVE
* MCF CLUSTER CLNG,CNTL
DACI     EQU      X'04C1'           TRACE CLNG,CNTL
DABT     EQU      X'4C0'            GO TO/EXIT
DABX     EQU      X'4C1'            ENTER
DAARL    EQU      -X'30'            REGISTER LOAD CNTL ADJ.
* MCF CLUSTER OPTIONS
DBTD     EQU      X'100'            DIRECT GO TO DEPENDING ON OPTION    ABT024
* POF CLUSTER CLNG;CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           ABSOLUTE VALUE
DAII     EQU      X'0402'           INTERNAL LABEL
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIL     EQU      X'0406'           LOC. CNTR
DAIX     EQU      X'0108'           EXTERNAL NAME
DAID     EQU      X'0609'           DATA
DAIE     EQU      6                 POINTER WORD CNTL ADJUSTMENT
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARE     EQU      X'0415'           EXIT TABLE
DARB     EQU      X'0417'           BRANCH TABLE
* DATA DEF
DADL     EQU      X'0626'           LOC. CNTR
DADP     EQU      X'0624'           PAR/SEC NAME
DADX     EQU      X'0328'           EXTERNAL NAME
DADD     EQU      X'0829'           DATA REF
DADB     EQU      X'0621'
*  DEFINITIONS/DECLARATIONS
DAPI     EQU      X'0341'           INTERNAL LABEL
DAPD     EQU      X'0343'           PAR/SEC NAME
DAPE     EQU      -X'7F1'           ENTRY POINT ADJUSTMENT
DAPX     EQU      X'0447'           LINE NO.
* OP CODES
CLI      EQU      X'2200'                                                1
CLW      EQU      X'3200'           LW
CMTW     EQU      X'3300'                                                2
CSTW     EQU      X'3500'                                                3
CBLE     EQU      X'6820'                                                4
CBNE     EQU      X'6930'                                                5
DBAL     EQU      X'6AB0'           OP CODE - BAL,L1
DBBR     EQU      X'6800'         P OP CODE - B                         ABT123
DBCAL    EQU      X'0410'           OP CODE - CAL1,1
DBLI     EQU      X'2200'           OP CODE - LI
DBLW     EQU      X'3200'         P OP CODE - LW
DBSTW    EQU      X'3500'         P OP CODE - STW
* INDEX REGISTER USAGE
CRB      EQU      X'60'             BIN                                  7
CRD2     EQU      D2*16
DIRB     EQU      X'60'             BIN DATA
DIRL     EQU      X'B0'             LINK
* REF DATA TYPE CONTROL SETTINGS
IBCI     EQU      X'60'             INTEGER ONLY                        ABP131
* PREF CNTL
IPBT     EQU      X'42'             GO TO
IPBV     EQU      X'40'             ALTER TPT
IPBVD    EQU      X'140'            ALTERED PAR
IPBX     EQU       4                ENTER
IPBP     EQU      X'62'             PERFORM
IPBPT    EQU      X'22'             PERFORM THRU
* POINTER WORD CNTL
DDPN     EQU      X'0080'           PNAM                                COBOL41B
DDPX     EQU      X'0080'           XNAM (=PNAM)                        COBOL41B
DDPB     EQU      X'0100'           BIN/INDEX
DDPFL    EQU      X'0200'           FLP
DDPD     EQU      X'4000'           PACKED DECIMAL
DDPBA    EQU      X'5000'           DISPLAY
DDPF     EQU      X'5180'           FILE                                COBOL41B
* FORMAT,WRITE EXTERNAL REF CLUSTER                                     AA20
*                        R2 = HA(CLOC)+1                                AA2 2
*                        V1 = OP CODE                                   AA2 8
AA20     RES      0                                                     AA200
         LI,L1    AA02              SET WRITE LINK REGISTER             AA201
AA21     RES      0                                                     AA210
         LW,R4    R2                LOAD HA(CLOC)                       AA211
AA22     RES      0                                                     AA213
         LH,R1    0,R4              LOAD,MASK CLNG                      AA2132
         AND,R1   K27F                                                  AA2134
AA23     RES      0                                                     AA2140
         AI,R1    DAIX              FORM XREF CLNG,CNTL                 AA2142
         STH,V1   0,R4              STORE OP CODE/OPTION                AA2144
         AI,R4    -1                SET HA(CLOC)                        AA2146
AA24     RES      0
         STH,R1   0,R4              STORE XREF CLNG,CNTL                AA2148
         AW,R4    R4                CLOC TO BA                          AA217
         B        WRMCF             WRITE MCF CLUSTER                   AA218
*                                                                       AA25
* FORMAT,WRITE BIN LOAD CLUSTER                                         AA30
*                        R4 = HA(CLOC)                                  AA300 4
*                        R5 = HA(CLOC)-1                                AA300 5
*                        R6 = CLNG,CNTL                                 AA300 6
*                        V0 VOLATILE                                    AA300 9
AA30     RES      0                                                     AA300
         LI,V0    DIRB+X'D'         SET LOAD BIN REGISTER OPTION
         LH,R6    0,R4              LOAD CLNG,CNTL
         AI,R6    DAARL             SET REGISTER LOAD CNTL              ABT022
         STH,R6   0,R4                                                  ABT023
*                        V0 = LOAD REGISTER                             AA302 8
         STH,V0   1,R5              STORE LOAD REGISTER                 AA322
         AW,R4    R4                SET BA(CLOC)                        ABT026
         STW,L1   SAVL1
         BAL,L1   ADL00
         LW,L1    SAVL1
         B        WRMCF             WRITE LOAD REGISTER CLUSTER         ABT027
*                                                                       ABT03
* FORM XREF ADCON CLNG,CNTL                                             AA556
*                        R2 = HA(CLOC)+3                                AA5562
AA55     RES      0                                                     AA550
         MTW,CMI  GADNO             ADCON NO. = ADCON NO.+1             AA5563
         LW,D2    GADNO             LOAD ADCON NO9                      AA552
AA56     RES      0                                                     AA560
         LW,R4    R2                SET HA(CLOC)                        AA5564
         AI,R4    -3                                                    AA5565
AA57     RES      0                                                     AA5570
         AI,R2    -2                SET HA(CLOC)+1                      AA5571
         LH,V0    1,R2              LOAD,MASK CLNG                      AA5572
         AND,V0   K27F                                                  AA5573
         AI,V0    DADX              FORM XREF ADCON CLNG,CNTL           AA5574
* COMPLETE,WRITE XREF ADCON CLUSTER                                     AA56
*                        R2 = HA(CLOC)+1                                AA56 2
*                        R4 = HA(CLOC)                                  AA56 4
*                        V0 = XREF ADCON CLNG,CNTL                      AA56 6
*                        V1 = ADCON BASE NO.                            AA56 8
*                        D1 = CONSTANT PORTION                          AA56 9
*                        D2 = ADCON NO.                                 AA56 9
AA58     RES      0                                                     AA5580
         STH,V0   0,R4              STORE XREF CLNG,CNTL                AA561
         STH,D1   1,R2              STORE CONSTANT PORTION              AA562
         STH,V1   0,R2              STORE ADCON BASE NO.                AA563
         STH,D2   1,R4              STORE ADCON NO.                     AA564
         AW,R4    R4                HA(CLOC) TO BA                      AA567
         B        WRPOF             WRITE ADCON CLUSTER                 AA569
* XNAM TO STACK                                                         41
AA80     RES      0                                                     ABT0603
*                        R3 = HA(STKTOP)                                ABT06063
*                        R4 = HA(XNAM)                                  44
*                        R1,R5 VOLATILE                                 45
         AW,R4    R4                HA(XNAM) TO BA                      50
         LB,R1    0,R4              LOAD CLNG
         LW,R5    R3                LOAD MBS RO(=STKTOP)                50
         STB,R1   R5                CLNG TO RO
         AW,R5    R5                HA(STKTOP) TO BA                    53
         MBS,R4   0                 MOVE THRU XNAM                      54
         LW,R4    R3                LOAD HA(THRU XNAM)                  55
         LW,R3    R5                BA(STKTOP) TO HA                    56
         SLS,R3   -1                STKTOP TO HA                        ABT069
         B        *L1               RETURN                              ABT071
*                        R4 = HA(THRU XNAM)                             59
*
* AFFIX -:                                                              61
*                        R2 = HA(XNAM)                                  62
AA84     RES      0                                                     63
         LW,R4    R2                LOAD HA(XNAM)                       64
*                        R4 = HA(XNAM)                                  65
         LI,V0    X'2E7'            LOAD BLNG ADJ.,CHAR.(='X')          66
*                        V0 = CHAR.                                     67
*                        R1,R5,V0 VOLATILE                              68
         LH,R5    1,R4              LOAD,MASK BLNG                      70
         LI,R1    X'FF00'                                                2
         AND,R1   R5                                                    72
         EOR,R5   R1                                                    73
         AI,R5    X'7A00'           FORM,STORE ':(1ST CHAR)'             5
         STH,R5   1,R4                                                   6
         AW,R1    V0                ADJUST BLNG,AFFIX CHAR.              7
         LI,V0    0                 CLEAR OFFSET                        79
         STH,V0   0,R4                                                  80
         AI,R4    -1                ADJUST HA(CLOC)                     81
         STH,R1   1,R4              STORE BLNG,'CHAR.'                  11
         AI,R1    X'700'            CLNG = (BLNG+7+2)/2                 12
         SLS,R1   -1                                                    13
         STH,R1   0,R4              STORE CLNG                          83
         B        *L1               RETURN                              84
*                        R1 = CLNG,CNTL                                 85
*                        R4 = HA(-:XNAM)                                86
*
* PROCEDURE DEFINITION              TYPE = X'73'                        ABA
ABA00    RES      0                                                     ABA00
*                        R6 = OPT,SOPT                                  ABA0 6
*                        R7 = REF TYPE BYTE,PRIORITY NO.(PRTYP,PNO)     ABA00 7
         AI,R6    CBPOM             CHECK DEF TYPE                      ABA001
         BCR,CZ   ABA25             PARAGRAPH(PAR)                      ABA002
         BCS,CP   ABA24             NOT SECTION DEF                     ABA003
* SECTION (SEC) OR DECLARATIVE SEC(DSEC)                                ABA01
*                        R6 = X'FEFE' - SEC                             ABA01 61
*                           = X'FEFF' - DSEC                            ABA01 62
* *** DECLARATIVE FLAG SET/RESET WHEN HEADER/TRAILER ENCOUNTERED******
         LH,V1    1,R5              LOAD,SAVE PDNO
         STW,V1   JPTYP
* *** ONLY FOR DECLARATIVE SO PAR TYPE CAN BE USED ***
         LI,V0    DAPD-1            LOAD SEC DEF CLNG,CNTL              ABA013
         CB,R7    JPNO              CHECK PRIORITY NO.(PNO)             ABA014
         BCR,CE   ABA02             =CURRENT PRIORITY NO.(CPNO)         ABA015
         STB,R7   JPNO              CPNO = PNO                          ABA016
         WMCF     ,BA(KAPP)         WRITE PRIORITY SEGMENT DECLARATION  ABA017
*                        R5 = HA(CLOC)+1                                ABA02 5
*                        R7 = PRTYP,PNO                                 ABA02 7
*                        V0 = PAR/SEC DEF CLNG,CNTL                     ABA02 8
ABA02    RES      0                                                     ABA020
         WMCF     ,BA(MLINE)+2      WRITE LINE NO. CLUSTER
         LW,R4    R5                SET HA(CLOC)+1                      ABA021
         LH,V1    2,R4              SAVE EXIT TABLE ENTRY NO.(XNO)      ABA022
         LH,D3    2,R2              *    TRACE NAME NO.                 ABA023
         CI,R7    0                 CHECK ENTER COBOL FLAG              ABA024
         BCR,CM   ABA04             DOWN                                ABA025
* ENTRY POINT - REFERENCED IN ENTER COBOL STMT                          ABA03
         STH,V1   3,R2              STORE XNO                           ABA031
         LH,R5    1,R4              LOAD,STORE PROCEDURE DEF NO.(PDNO)  ABA032
         STH,R5   2,R4                                                  ABA033
         AH,V0    0,R2              FORM CLNG,CNTL
         AI,V0    DAPE                                                  ABA035
         AI,R4    2                 SET HA(CLOC)-1                      ABA036
* PAR/SEC DEF ONLY                                                      ABA04
ABA04    RES      0                                                     ABA040
         LH,L1    1,R4
         STW,L1   TMPNO
         AI,R4    1                 SET HA(CLOC)                        ABA041
*                        R4 = HA(CLOC)                                  ABA0492
*                        V0 = CLNG,CNTL                                 ABA0498
         BAL,L1   AA11+1            WRITE DEF CLUSTER                   ABA053
*                        D3 = TRACE NAME NO./0
         CI,D3    0                 CHECK FOR TRACE                     ABA054
         BCR,CZ   ABA07             NO TRACE                            ABA055
         BAL,L1   ACJ02             WRITE TRACE CLUSTER
*                        R6 = 0 IF PAR/DPAR                             ABA0696
*                           = - IF SEC/DSEC                             ABA06962
*                        V1 = XNO                                       ABA0699
ABA07    RES      0                                                     ABA070
         STH,R7   V1                SAVE PRTYP,PNO                      ABA071
         CI,R6    0                 CHECK DEF TYPE                      ABA072
         BCR,CZ   ABA08             PAR/DPAR                            ABA073
* SECTION DEF                                                           ABA08
         STW,V1   JSTYP             SAVE SEC PRTYP,PNO,PXNO             ABA081
         MTW,0    PDBDBGC                                               COBOL41B
         BEZ      ABA075                                                COBOL41B
         LCI      15                                                    COBOL41B
         STM,R1   SAVL2                                                 COBOL41B
         LI,V0    CMTW              OP CODE TO TEST RUN-TIME SWT MTW,0  COBOL41B
         LW,D3    PDBDBG            BASE DISPL OF DEBUG-CONTENTS        COBOL41B
         AI,D3    -61               2  WORD IN FRONT OF DEBUG-ITEM      COBOL41B
         BAL,L1   PID11             GEN INST WITH WA RESOLUTION         COBOL41B
*        GENERATE  BEZ  %+2                                             COBOL41B
*                  CLUSTER FOR  BAL  *XNO                               COBOL41B
*        THEN DECREMENT DEBUG COUNTER                                   COBOL41B
         BAL,L1   PIL06                                                 COBOL41B
         BEZ      2                 * WRITE BEZ %+2                     COBOL41B
         LW,V1    JPTYP             SAVE JPTYP                          COBOL41B
         STH,R7   JPTYP             SET PAR PRTYP                       COBOL41B
         BAL,L1   ABA23             * WRITE EXIT TABLE CLUSTER          COBOL41B
         STW,V1   JPTYP             RESTORE JPTYP                       COBOL41B
         LCI      15                                                    COBOL41B
         LM,R1    SAVL2                                                 COBOL41B
         MTW,-1   PDBDBGC                                               COBOL41B
ABA075   RES      0                                                     COBOL41B
* *** PAR REF TYPE BITS RESET WHEN PDNO SAVED*****
         B        AA02                                                  ABA083
* PARAGRAPH DEF                                                         ABA10
ABA08    RES      0                                                     ABA100
         STW,V1   JPTYP             SAVE PAR PRTYP,PNO,PXNO             ABA101
         CI,R7    CCAP              CHECK ALTER FLAG                    ABA102
         BANZ     ABA09             UP.                                  2
         CI,R7    X'8000'           CHECK ENTER COBOL FLAG               3
         BCR,CB   AA02              DOWN                                ABA103
         B        ABA10             UP. POSSIBLE ALTER.                  5
* ALTERED PAR                                                           ABA104
ABA09    RES      0                                                      7
         CI,R7    CCPX              CHECK FOR PERFORM ALSO              ABA105
         BCR,CB   ABA10             NO. ALTERED ONLY.                   ABA106
* S*****PARAGRAPH BOTH ALTERED AND PERFORMED***                         ABA107
         LI,R1    XPS               LOAD DIAG CODE                      ABA1072
         BAL,L1   DIAG              WRITE DMF CLUSTER                   ABA1074
ABA10    RES      0                                                     ABA1080
         LI,V0    0                 LOAD PREF CNTL                      ABA1082
         RCRF                       READ NEXT CLUSTER                   ABA1083
         LH,D0    0,R2              MASK,CHECK STMT TYPE                ABA1084
         AND,D0   K3FF                                                  ABA1085
         AI,D0    -X'DB'                                                ABA1086
         BEZ      ABA14             GO TO ...                           ABA1087
         CI,R7    CCAP              CHECK ALTER FLAG                     9
         BAZ      AA03              DOWN. ENTER COBOL ONLY              10
         CI,D0    3                 SEE IF CTRL BYTE WAS MOVE CLUSTER   COBOL41B
         BNE      ABA11             NO                                  COBOL41B
         MTW,0    PDBDBG            SEE IF DEBUGGING                    COBOL41B
          BEZ     ABA11             NO                                  COBOL41B
          LI,L1   ABA105            SET RETURN                          COBOL41B
         XW,L1    JMCRD             SET UP RETURN FROM 41D              COBOL41B
         LCI      15                                                    COBOL41B
         STM,R1   SAVL2             SAVE REGISTERS                      COBOL41B
          B       AA03              PROCESS DEBUG MOVE CLUSTERS         COBOL41B
ABA105   RES      0                                                     COBOL41B
         LCI      15                                                    COBOL41B
         LM,R1    SAVL2                                                 COBOL41B
         XW,L1    JMCRD             RESTORE JMCRD                       COBOL41B
          B       ABA10             GET NEXT CLUSTER                    COBOL41B
* S*****ALTERED PAR NOT GO TO*******                                    ABA11
ABA11    RES      0                                                     ABA110
         LI,L1    ABA16-2           SET LINK REGISTER
         LI,R1    XPS+1             LOAD DIAG CODE                      ABA112
         LW,D0    R2                NLOC FLAG = CLOC                    ABA113
         B        ADP10             SET C:ERR IND.                      ABA115
* NOT PREF                                                              ABA12
ABA12    RES      0                                                     ABA120
         CI,V2    X'FF00'           CHECK FOR GO TO. (SYNTAX ONLY)      ABA122
         BAZ      ABA13             YES.                                12
* NOT GO TO. - GO TO DEPENDING ON                                       13
         CI,R7    CCAP              CHECK ALTER FLAG                    14
         BAZ      AA03              DOWN. ENTER COBOL ONLY              15
         B        ABA11+1           UP.                                 16
ABA13    RES      0                                                     17
         LI,R1    XPW               LOAD DIAG CODE                      ABA132
         B        ADP10             SET C:ERR IND.                      ABA133
* W*****GO TO C:ERR GENERATED FOR GO TO.***                             ABA136
* GO TO....                                                             ABA14
ABA14    RES      0                                                     ABA140
         BAL,L1   ADP02             CHECK PREF                          ABA142
         B        ABA12             NOT PREF
*                        R2 = HA(CLOC)                                  ABA15 0
*                        R4 = HA(CLOC)-1                                ABA15 2
*                        D0 = NLOC FLAG                                 ABA15 9
         LH,D1    JPTYP             LOAD,CHECK PRTYP
         CI,D1    CCAP
         BANZ     ABA15             ALTER FLAG UP
* ENTER COBOL ONLY, POSSIBLE EXTERNAL ALTER
         AI,D1    CCAP              RAISE ALTER FLAG
         STH,D1   JPTYP
         B        ABA154
ABA15    RES      0
         LH,D1    1,R4
         AND,D1   L(X'2')
         BEZ      ABA154
         LCI      15
         STM,R1   SAVL1
         LI,D2    0
         LBAL     PDD04,DADB,D0     **** ASSIGN BUFFER
         LW,R7    ALTGC
         CI,R7    50
         BL       ABA151
         LI,R1    122
         BAL,L1   DIAG
         B        ABA152
ABA151   STW,D1   ALTGB,R7          SAVE BUFFER ADDRESS
         LW,V0    TMPNO
         STH,V0   ALTGP,R7
         MTW,1    ALTGC
         LBAL     PRA01,CLW+CRR1    **** WRITE LW,R1  (ALTGB)
         BAL,L1   PIL06
         BNEZ     2                 **** WRITE BNEZ  %+2
ABA152   LCI      15
         LM,R1    SAVL1
ABA154   RES      0
         LI,D1    DADP              LOAD PREF ADCON CLNG,CNTL           ABA152
         LH,D3    2,R4              LOAD PDNO                           ABA154
         LI,L1    ABA22             SET LINK REGISTER                   ABA155
*                        R7 = PREF TYPE IND.                            ABA16 3
*                        V1 = XNO                                       ABA16 4
*                        D1 = EXIT TABLE CLUSTER CLNG,CNTL              ABA16 5
*                        D3 = PDNO/LOC CNTR OFFSET                      ABA16 7
*                        L1 = LINK REGISTER                             ABA16 9
ABA16    RES      0                                                     ABA160
         LW,D2    V1                LOAD XNO                            ABA163
         AI,D2    -1                XNO = XNO-1(=WA DISPL)              ABA164
         SLS,D2   2                 WA DISPL TO BA                      ABA165
         CI,R7    0                 CHECK PREF TYPE                     ABA166
         BGEZ     ABA18             >/= 0, GO TO ROOT/OVERLAY           ABA167
* GO TO XNAM/C:ERR                                                      ABA17
         LI,V1    CEBNO             LOAD EXIT TBL BASE NO.              ABA162
         LI,D1    0                 CLEAR CONSTANT PORTION              ABA172
         B        AA56              FORMAT,WRITE XREF EXIT TBL CLUSTER
* GO TO ROOT/OVERLAY                                                    ABA18
*                        D2 = XNO                                       ABA18 6
ABA18    RES      0                                                     ABA180
         BEZ      ABA20             = 0, GO TO ROOT                     ABA182
* GO TO OVERLAY                                                         ABA19
         AI,D1    1                 SET PREF OFFSET ADCON CLNG,CNTL     ABA192
         STB,R7   D3                FORM PNO,PDNO/OFFSET                ABA194
         OR,V1    K102              RAISE OVERLAY FLAG                  ABA196
         STW,V1   JPTYP                                                 ABA197
ABA20    RES      0                                                     ABA200
         LI,R7    CEBNO             LOAD EXIT TABLE BASE NO.            ABA202
         STH,R7   D2                FORM EXIT TBL BASE,XNO              ABA204
         WMCF     ,X'36',,0         WRITE EXIT TABLE CLUSTER
ABA22    RES      0                                                     ABA220
         LI,L1    AA01              SET LINK REGISTER                   ABA222
         LW,R2    D0                LOAD NLOC FLAG                      ABA223
ABA23    RES      0                                                     ABA230
*        WMCF     ,BA(MPXC)+2,,0    WRITE EXIT CLUSTER
         WMCF     ,BA(JAMOD)+6,,0   WRITE EXIT CLUSTER
* DPAR/SECTION TRAILER/INTERNAL LABEL(INTL)                             ABA24
ABA24    RES      0                                                     ABA240
         BDR,R6   ABA30             SECTION TRAILER/INTL                ABA242
* PARAGRAPH DEF                                                         ABA25
ABA25    RES      0                                                     ABA250
         LI,L0    ABA29             SET RETURN TO PROCESS DEF           ABA254
         LH,V1    3,R2                  LOAD CURRENT INTL NO.
* CHECK INTL RANGE                                                      ABA26
*                        V1 = CURRENT INTL NO./0
*                        L0 = LINK REGISTER                             ABA26 9
ABA26    RES      0
         LI,R1    1                 LOAD INDEX                          ABA262
         LH,R4    JINTL,R1          LOAD PREVIOUS INTL RANGE            ABA263
         STH,V1   JINTL,R1              SAVE CURRENT INTL NO.
         CH,R4    PDBK              CHECK PREVIOUS INTL RANGE,MAX RANGE ABA266
         BLE      ABA27             </= MAX. RANGE                      ABA267
* > MAX. RANGE                                                          ABA268
         STH,R4   PDBK              UPDATE MAX. INTL RANGE              ABA269
* CHECK FOR EXIT PARAGRAPH                                              ABA27
ABA27    RES      0                                                     ABA270
         LW,V1    JPTYP             LOAD PREF TYPE,PNO,XNO              ABA272
         LH,R7    V1                LOAD PREF TYPE,PNO                  ABA273
         CI,R7    CCAP              CHECK ALTER FLAG                    ABA274
         BANZ     *L0               UP. ALTERED PAR.                    ABA275
         CI,R7    CCPX+X'8000'      CHECK PERFORM/SORT/ENTER FLAG
         BAZ      *L0               NO. NOT PERFORMED.                  ABA277
* E-O-PERFORM/SORT PROCEDURE                                            ABA28
ABA28    RES      0                                                     ABA280
         BAL,L1   ABA23             WRITE EXIT TABLE CLUSTER            ABA282
         LI,D1    DADL              LOAD LOC CNTR REF ADCON CLNG,CNTL   ABA284
         LI,D3    0                 CLEAR OFFSET                        ABA285
         LH,R7    JSTYP             GET CURRENT PRIORITY                COBOL41B
         AND,R7   K3FF              MASK PNO                            ABA286
         BAL,L1   ABA16             FORMAT,WRITE EXIT TABLE CLUSTER     ABA288
         B        *L0               RETURN                              ABA289
ABA29    RES      0                                                     ABA290
         LI,V0    DAPD              LOAD PAR DEF CLNG,CNTL              ABA252
         LH,R7    1,R2              RELOAD PREF TYPE,PNO                ABA292
         B        ABA02             TO PROCESS PAR DEF                  ABA294
* SECTION TRAILER/INTL                                                  ABA30
ABA30    RES      0                                                     ABA300
         AI,R6    -X'6A'            CHECK FOR INTL
         BGEZ     ABA40             INTL DEF
* SECTION TRAILER                                                       ABA31
         LI,V1    0                     CURRENT INTL NO. = 0
         BAL,L0   ABA26             CHECK FOR,WRITE PAR EXIT CLUSTER    ABA311
         LW,V1    JSTYP             SEC PRTYP,PNO,PXNO TO EXIT CLUSTER  ABA314
         STW,V1   JPTYP                                                 ABA315
         LI,L0    AA02              SET LINK REGISTER                   ABA318
         B        ABA27+1           CHECK,WRITE SEC EXIT
* INTERNAL LABEL(INTL)                                                  ABA400
ABA40    RES      0                                                     ABA400
         LW,R1    JSTDB             CHECK SEARCH FLAG
         BEZ      AA03+3            DOWN. WRITE INTL DEF.
* SEARCH N.S. INTL DEF
         B        ACW00
* GO TO                             TYPE = X'5B'                        ABT
ABT00    RES      0                                                     ABT00
         CI,R6    1                 CHECK FOR DEPENDING ON OPTION       ABT001
         BAZ      ABT30             NO. NOT DEPENDING ON                ABT002
* GO TO DEPENDING ON                                                    ABT01
         LI,V2    IBCI              LOAD REF CONTROL                    ABT011
         BAL,L1   ADI02             CHECK DEPENDING ON FIELD            ABT012
* S*****INVALID DEPENDING ON FIELD**                                    ABT014
         B        AA03                                                  ABT015
* VALID DEPENDING ON FLD                                                ABT016
         BAL,L1   AA30              FORMAT,WRITE BIN LOAD CLUSTER       ABT022
         LI,R3    HA(STBAS)         RESET STKTOP                        ABT032
         LI,D0    DBTD              LOAD DIRECT GO TO DEPENDNG ON OPTIONABT033
         LI,D1    0                 PROCEDURE REF COUNT(PCNT) = 0       ABT034
         LI,V0    IPBT              LOAD PREF CNTL                      ABT036
         BAL,L1   ADP00             CHECK PREF                          ABT037
ABT04    RES      0                                                     ABT040
         B        ABT08             ERR/XNAM                            ABT042
*                        R7 = PNO                                       ABT0437
* PAR/SEC NAME(PNAM)                                                    ABT0439
         CI,R7    0                 CHECK PREF                          ABT044
         BEZ      ABT06             PNO = 0, ROOT                       ABT045
* DIFFERENT OVERLAY                                                     ABT05
         LI,D0    DBTD+X'100'       LOAD INDIRECT GO TO OPTION          COBOL41B
         SLS,R7   8                 SHIFT PN0 FOR LB OF OVERLAY         COBOL41B
ABT06    RES      0                                                     ABT060
         STH,R7   0,R3              STORE PNO                           ABT062
         AI,R3    1                 UPDATE STKTOP                       ABT063
         LH,V1    2,R4              LOAD,STORE PDNO                     ABT064
         STH,V1   0,R3                                                  ABT065
         AI,R3    1                 UPDATE STKTOP                       ABT066
ABT08    RES      0
         AI,D1    -1                PCNT = PCNT-1                       ABT072
         CI,V2    CLOP              LAST OP FLAG UP                     ABT073
         BANZ     ABT10             YES, E-O-PREFS                      ABT074
         LI,L0    ABT04             SET LINK REGISTER                   ABT076
         B        ADP01             TO PROCESS NEXT PROCEDURE NAME      ABT078
* E-O-GO TO PREFS                                                       ABT10
ABT10    RES      0                                                     ABT100
         LW,D3    JINTL             LOAD INTL NO.+1                     ABT101
         AI,D3    1                                                     ABT102
         SW,D0    D1                FORM,STORE OPTION,PCNT              ABT103
         STH,D0   D3                                                    ABT104
         LI,D2    DABT              LOAD GO TO CLNG,CNTL                ABT105
         WMCF     ,X'3A'            WRITE GO TO CLUSTER (IN REGISTERS)  ABT106
         LI,R6    HA(STBAS)         LOAD HA(STKTOP)                     ABT107
         LI,V0    DAIP              LOAD RELOCATABLE CLNG,CNTL          ABT111
         LI,V1    DBBR              LOAD B OP CODE                      ABT112
         CI,D0    DBTD+X'100'       CHECK FOR DIRECT GO TO OPTION       ABT113
         BL       ABT14             YES. DIRECT GO TO                   ABT114
* NOT DIRECT GO TO                                                      ABT1149
         LI,V2    DAIP+1            LOAD OFFSET CLNG,CNTL               ABT115
         LI,V1    0                 CLEAR OP CODE                       ABT116
ABT14    RES      0                                                     ABT140
*                        R6 = STKTOP                                    ABT1406
         LW,R4    R6                LOAD HA(CLOC)                       ABT141
         AI,R4    -1                                                    ABT142
         LH,R1    0,R6              CHECK PREF TYPE                     ABT143
         BCR,CZ   ABT17             IN ROOT/SAME OVERLAY                ABT144
         BCS,CP   ABT16             IN DIFFERENT OVERLAY                ABT145
* EXTERNAL NAME REF(XREF)                                               ABT15
         AI,R4    1                 RESET HA(CLOC)                      ABT152
         BAL,L1   AA22+1            FORMAT,WRITE XREF CLUSTER           ABT153
*                        R1 = XREF CLNG,CNTL                            ABT1531
         SLS,R1   -8                UPDATE STKTOP                       ABT154
         AW,R6    R1                                                    ABT155
         BDR,R6   ABT20                                                 ABT158
* PREF IN DIFFERENT OVERLAY                                             ABT16
ABT16    RES      0                                                     ABT160
         STH,V2   0,R4              STORE OFFSET CLNG,CNTL              ABT161
         B        ABT18                                                 ABT162
* PREF IN ROOT/SAME OVERLAY                                             ABT17
ABT17    RES      0                                                     ABT170
         STH,V0   0,R4              STORE RELOCATABLE CLNG,CNTL         ABT171
         STH,V1   0,R6              STORE B OP CODE                     ABT173
ABT18    RES      0                                                     ABT180
         AI,R6    2                 UPDATE STKLOC                       ABT181
         AW,R4    R4                CLOC TO BA                          ABT191
         BAL,L1   WRMCF             WRITE CLUSTER                       ABT192
ABT20    RES      0                                                     ABT200
         BIR,D1   ABT14             MORE PREFS                          ABT202
* E-O-PREFS                                                             ABT22
         B        AA15              FORMAT WRITE INTL+1 DEF CLUSTER     ABT222
* GO TO PROCEDURE NAME.                                                 ABT30
ABT30    RES      0                                                     ABT300
         LI,V1    DBBR              OP = B
         LI,V0    IPBT              LOAD PREF CNTL                      ABT303
         BAL,L1   ADP02             CHECK PREF                          ABT304
         B        AA20              ERR/XNAM                            ABT305
*                        R7 = PNO                                       ABT3057
* PAR/SEC NAME(PNAM)                                                    ABT32
         LH,D2    2,R4              LOAD PDNO
         LI,L1    ABT40             SET LINK REGISTER                   ABT322
* GENERATE BRANCH CLUSTERS                                              ABT36
ABT36    RES      0                                                     ABT360
*                        R7 = PNO                                       ABT3607
*                        D2 = PDNO                                      ABT3608
         CI,R7    0                 CHECK PREF TYPE                     ABT362
         BEZ      ABT38             PNO = 0, ROOT                       ABT363
* OVERLAY                                                               ABT37
         STH,D2   MAIPO+1           STORE PDNO                          ABT372
         LW,D2    KARBX             LOAD BRANCH TBL REF CLNG,CNTL EXU   ABT373
         STH,R7   D3                STORE PNO                           ABT374
         LI,R4    BA(MAIPO)         LOAD BA(CLOC)                       ABT376
         B        WRMCF             WRITE BRANCH TBL REF CLUSTER        ABT377
*                        LI,R1  OFFSET CLUSTER WRITTEN                  ABT3798
*                        EXU    BRANCH TABLE(,R1) IN D2,D3              ABT3799
* ROOT/SAME OVERLAY                                                     ABT38
ABT38    RES      0                                                     ABT380
         STH,D2   D3                STORE PDNO
         LW,D2    KAIPB             LOAD PREF CLNG,CNTL BAL,L1          ABT382
         B        *L1               RETURN                              ABT384
*                        BAL,L1 PDNO CLUSTER IN D2,D3                   ABT3899
ABT40    RES      0                                                     ABT400
         WMCF     ,X'38',AA02       WRITE BRANCH CLUSTER, RETURN        ABT402
* ALTER                             TYPE = X'52'                        ABV
ABV00    RES      0                                                     ABV00
         LI,V0    IPBV              LOAD TPT PREF CNTL                  ABV002
         BAL,L1   ADP02             CHECK PREF                          ABV003
         B        ABV30             XNAM                                ABV004
* TPT PAR/SEC NAME(PNAM)                                                ABV04
*                        R7 = PNO                                       ABV0047
         LH,D3    2,R4              FORM,SAVE PNO,PDNO                  ABV042
         STB,R7   D3                                                    ABV043
* ALTERED PROCEDURE REF                                                 ABV06
ABV06    RES      0                                                     ABV060
         LI,V0    IPBVD             LOAD ALTERED PREF CNTL              ABV062
         BAL,L0   ADP01             CHECK ALTERED PREF                  ABV063
         B        ABV32             XNAM                                ABV064
*                        R7 = PNO                                       ABV0647
* PAR/SEC NAM                                                           ABV12
         LH,D2    1,R4
         AND,D2   L(X'2')
         STW,D2   ALTF1
         BEZ      ABV07
         LH,D2    2,R4
         STH,D2   MERA+1
ABV07    RES      0
         LH,D2    D3                LOAD,CHECK TPT PREF TYPE            ABV142
         BEZ      ABV18             = 0, TPT ROOT SEGMENT
         BLEZ     ABV22             < 0, TPT XNAM                       ABV144
* TPT OVERLAY                                                           ABV15
         CH,D2    JPNO              COMPARE TPT PNO,CPNO                ABV152
         BNE      ABV16             NOT=                                ABV153
         CB,R7    JPNO              COMPARE ALTERED PNO,CPNO            ABV154
         BE       ABV18             =, EFFECTIVELY ROOT
* GENERATE TPT PREF ADCON,LOAD ADCON                                    ABV16
ABV16    RES      0                                                     ABV160
         STW,D3   MDVAL             STORE PNO,PDNO                      ABV162
         LI,V0    DBLW+DIRL         LOAD OP CODE - LW,LINK REG          ABV163
         BAL,L1   AA60              FORMAT WRITE ADCON REF CLUSTER      ABV164
         LI,V0    DADP+1            LOAD ADCON PNO,OFFSET CLNG,CNTL     ABV166
         LI,L1    ABV22             SET LINK REGISTER                   ABV167
         B        AA52+1            FORMAT,WRITE PREF OFFSET CLUSTER    ABV168
ABV18    RES      0
         LI,L1    ABV22             SET LINK REGISTER                   ABV201
         LI,D2    DAIP              LOAD PREF CLNG,CNTL                 ABV204
         LI,V1    DBLI+DIRL         LOAD LI,L1
*                        V1 = OP CODE
*                        D2 = CLNG,CNTL
*                        D3 = PDNO
*                        L1 = LINK REGISTER
ABV20    RES      0
         STH,V1   D3                STORE OP CODE
         LI,R4    X'3A'             LOAD BA(CLOC) - REGISTER            ABV205
         B        WRMCF             WRITE PREF CLUSTER                  ABV206
* ALTER EXIT TABLE ENTRY                                                ABV22
ABV22    RES      0                                                     ABV220
         MTW,0    ALTF1
         BEZ      ABV23
         LB,V1    TMON1
         BEZ      ABV23             ALTER ROOT SEGMENT
         WMCF     ,BA(MERA),AA02    WRITE ALTER CONTROL CLUSTER
ABV23    RES      0
         LH,V1    2,R2              LOAD,STORE EXIT TABLE NO.           ABV222
         AI,V1    -1                   (EXIT NO. TO DISPL)              ABV223
         STH,V1   MENO                                                  ABV224
         WMCF     ,BA(MERC),AA02    WRITE EXIT TABLE REF CLUSTER        ABV226
* TPT EXTERNAL NAME(XNAM)                                               ABV30
ABV30    RES      0                                                     ABV300
         LI,D3    0
         STW,D3   ALTF1
         LI,D3    X'80000'          SET XNAM IND.                       ABV302
         LI,V1    DBLI+DIRL         LOAD OP CODE - LI,LINK REG          ABV303
         LI,L1    ABV06             SET LINK REGISTER                   ABV304
         B        AA21              FORMAT,WRITE XREF CLUSTER           ABV306
* ALTERED XNAM                                                          ABV32
ABV32    RES      0                                                     ABV320
         LH,D2    D3                LOAD,CHECK TPT PREF TYPE            ABV322
         BEZ      ABV34             = 0, TPT ROOT SEGMENT               ABV323
         BLEZ     ABV34+1           < 0, TPT XNAM                       ABV324
* S*****XNAM ALTERED TO PROCEED TO OVERLAY SEGMENT***                   ABV33
         DX       XPS+4             WRITE DMF CLUSTER                   ABV332
         CH,D2    JPNO              COMPARE TPT PNO,CPNO                ABV334
         BNE      AA02              NOT=, OVERLAY REF VIOLATION
* ** REF TO DIFFERENT OVERLAY CANNOT BE ALLOWED ***
ABV34    RES      0                                                     ABV340
         BAL,L1   ABV18+1           WRITE LI,L1 PREF
         BAL,L1   AA84              AFFIX X:
         LI,V1    DBSTW+DIRL        LOAD OP CODE - STW,LINK REG         ABV344
         LAB,L1   AA22+1,AA02       WRITE STW,L1 X:XNAM
         PAGE                                                            2
* ENTER                             TYPE = X'57'                        ABX
*                        R6 = STMT OPTION(=-,PARAMETER COUNT(PCNT)       4
ABX00    RES      0                                                     ABX00
         LI,D3    X'7F'             MASK PONT                            6
         AND,D3   R6                                                     7
         LW,D0    D3                SAVE PCNT                            8
         LBAL     PIA22,DBLI+CRD2   WRITE LI,D2 PCNT
*                                                                       11
         LI,V1    0                 CLEAR OFFSET                        ABX002
         STH,V1   0,R5                                                  ABX003
         LW,R4    R2                LOAD HA(CLOC)
         BAL,L1   AA80              XNAM TO STACK
         LI,V1    DBAL+X'40'        LOAD BAL,D3                         13
         BAL,L1   AA22              WRITE BAL,D3 XNAM
*                                                                       15
         CI,D0    0                 CHECK PCNT                          16
         BEZ      AA02              =0, NO PARAMETERS                   17
*                        D0 = PCNT                                      18
ABX04    RES      0                                                     ABX040
         LI,V0    IPBX              LOAD PREF CNTL                      ABX044
         BAL,L0   ADP01             CHECK PARAMETER                     ABX045
*                        R2 = HA(CLOC)                                  ABX0452
*                        R4 = HA(CLOC)-1                                ABX0454
         B        ABX10             DATA/COND/FILE NAME
* PAR/SEC NAME OR XNAM                                                  ABX05
*                        R7 = PNO/XNAM IND.                             ABX05 7
         CI,R7    0                 CHECK PREF TYPE                     ABX052
         BGEZ     ABX08             PAR/SEC NAME                        ABX053
* XNAM                                                                  ABX06
*                        V1 = 0(=ADCON BASE NO.)                        ABX06 9
         LH,R1    0,R2              LOAD,MASK CLNG                       1
         AND,R1   K27F                                                   2
         AI,R1    DAIX+DAIE         SET ENTER XREF CLNG,CNTL             3
         LI,V1    DDPX              LOAD,STORE XNAM POINTER CNTL         4
         STH,V1   0,R2                                                   5
         LH,V1    2,R4                                                  COBOL41B
         CI,V1    X'7AC5'           SEE IF PARAMETER IS C:ERR           COBOL41B
         BNE      ABX07             NO                                  COBOL41B
         STW,R1   SAVL1             SAVE R1                             COBOL41B
         LI,R1    XPS+2             ISSUE DIAG 141 IF C:ERR             COBOL41B
         BAL,L1   DIAG                                                  COBOL41B
         LW,R1    SAVL1             RESTORE R1                          COBOL41B
ABX07    RES      0                                                     COBOL41B
         LAB,L1   AA24,ABX22        WRITE XREF POINTER WORD              6
* PROCEDURE NAME                                                        ABX08
ABX08    RES      0                                                     ABX080
         LH,D2    2,R4              LOAD PDNO                            8
         LI,V1    DDPN              LOAD PREF POINTER CNTL               9
         LAB,D1   ABX20,DAIP+DAIE   WRITE PREF POINTER WORD             10
*                        V2 = REF TYPE,STMT OPTION                      ABX09 8
* DATA/COND/FILE NAME                                                   ABX10
ABX10    RES      0                                                     ABX100
         CI,V2    CBPN                                                  ABX102
         BANZ     ABX11             DEFINED                             ABX103
* S*****UNDEFINED PARAMETER NAME****                                    ABX105
         LI,R1    XRS               LOAD DIAG CODE                      ABX106
         B        ADP10             SET XNAM INDICES                    ABX107
*                                                                       ABX11
ABX11    RES      0                                                     ABX110
         CI,V2    CBDN-CBPS         CHECK REF TYPE                      ABX112
         BAZ      ABX14             DATA NAME                           ABX113
         CI,V2    X'200'
         BAZ      ABX13             CONDITION NAME
* FILE NAME                                                             ABX12
         LH,R7     1,R2                DDB NO.,-
         BAL,L1   ADO30             OBTAIN DDP BASE NO.                 ABX122
         LI,V1    DDPF              LOAD FREF POINTER CNTL              12
         B        ABX19             TO COMPLETE,WRITE DREF ADCON        ABX126
* S*****CONDITION NAME USED AS PARAMETER***                             ABX13
ABX13    RES      0                                                     ABX130
         DX       XRS+1             WRITE DMF CLUSTER                   ABX132
* DATA NAME(DREF)                                                       ABX14
ABX14    RES      0                                                     ABX140
         LH,R7    2,R2              LOAD,COMBINE BASE NO.,DISPL         ABX141
         LH,D3    3,R4
         STH,R7   D3                                                    ABX142
         LH,R7    2,R4              LOAD,CHECK DATA TYPE
         CI,R7    CDIXN                                                 ABX144
         BCS,CE   ABX15             NOT INDEX NAME                      ABX145
* W*****INDEX NAME USED AS PARAMETER***                                 ABX146
         LI,R1    XRW               LOAD DIAG CODE                      ABX147
         BAL,L1   DIAG              WRITE DMF CLUSTER                   ABX148
         B        ABX18                                                 ABX149
ABX15    RES      0                                                     ABX150
         CI,R7    CDIM              CHECK NDIM                          ABX151
         BCR,CB   ABX16             NDIM = 0,NOT DIMENSIONED.           ABX152
* W*****DIMENSIONED DATA USED AS PARAMETER***                           ABX153
         LI,R1    XRW-1             LOAD DIAG CODE                      ABX154
         BAL,L1   DIAG              WRITE DMF CLUSTER                   ABX155
ABX16    RES      0                                                     ABX160
         AND,R7   K20F              MASK,TEST CLASS                     ABX161
         CI,R7    CDIXD                                                 ABX162
         BCR,CL   ABX17             WA DATA                             ABX163
* BA DATA                                                               ABX164
         LI,V1    DDPBA             LOAD BAREF POINTER CNTL             14
         LI,D2    0                 SET FOR BA DREF                     15
         CI,R7    X'800'            CHECK CLASS                         16
         BAZ      ABX19+1           DISPLAY FLD                         17
* NC DATA                                                               18
         LH,V1    4,R4              LOAD, POSITION BSIZ                 19
         SLS,V1   8                                                     20
         AND,V1   K20F              MAX. 'F'
         AI,V1    DDPD              SET DREF POINTER CNTL               21
         B        ABX19+1           WRITE DREF POINTER WORD             22
* WA DATA - FIXED LENGTH                                                ABX17
ABX17    RES      0                                                     ABX170
         LI,V1    DDPFL             LOAD FLREF POINTER CNTL             24
         CI,R7    CDFPS             CHECK CLASS                         ABX171
         BCS,CL   ABX18             INDEX OR BIN DATA                   ABX172
* FLP DATA                                                              ABX173
         BE       ABX19             FLS DATA                            26
* FLL DATA                                                              27
         AI,V1    DDPFL             SET FLL POINTER CNTL                28
         B        ABX19                                                 ABX178
* INDEX/BIN DATA                                                        ABX18
ABX18    RES      0                                                     ABX180
         LI,V1    DDPB              LOAD BREF POINTER CNTL              30
ABX19    RES      0                                                     ABX190
         LI,D2    2                 SET FOR WA DREF                     32
         LI,D1    DAID+DAIE         LOAD ENTER DREF CLNG,CNTL           33
*                        R7 = POINTER CNTL                              33
*                        D1 = POINTER WORD CLNG,CNTL                    34
*                        D2 = PDNO/ADDR RESOLUTION                      35
*                        D3 = BASE,DISPL IF F/DREF                      36
ABX20    RES      0                                                     37
         STH,V1   D2                STORE POINTER CNTL                  38
         WMCF     ,X'36'            WRITE POINTER WORD CLUSTER
*                        D0 = PCNT                                      40
* PREF/DREF/XREF ADCON WRITTEN                                          ABX20
ABX22    RES      0                                                     41
         BDR,D0   ABX04             PCNT = PCNT-1                       42
* E-O-PARAMETERS                                                        43
         B        AA02              RETURN                              44
*                                                                       41
*
* PERFORM                           TYPE = X'61'                        ABW
*                        R6 = REF TYPE,STMT OPTION(=VARYING CNT(VCNT))
ABP00    RES      0                                                     ABW00
         STB,R6   JBPVC             SAVE VCNT
         AI,R3    CPSV              RESERVE BUFFER
* ** RESERVE FOR (VARYING) FROM,BY CLUSTERS ***
         LI,V0    IPBP              LOAD PREF CNTL                      ABW002
         LI,L1    ABP16             SET LINK REGISTER
ABP01    RES      0
         STW,L1   JBPSAV            SAVE LINK REGISTER
         AI,R3    3                 HA(STKTOP) = HA(STKTOP)+3           11
         STD,R3   JBPXN             SET XNAM STACK INDEX
         BAL,L1   ADP02             CHECK PREF                          ABW003
         B        ABP04             XNAM                                ABW004
* PAR/SEC NAME                                                          ABW02
ABP02    RES      0                                                     ABW020
         LH,D1    2,R2              LOAD XNO                            ABW022
         LH,D2    2,R4              LOAD PDNO                           ABW024
         B        ABP06                                                 ABW028
* XNAM                                                                  ABW04
ABP04    RES      0                                                     ABW040
         LI,D1    CDPXN             XNAM IND. TO XNO                    ABW042
         LI,D2    CDPXN             *            PDNO                   ABW043
         STW,R4   JBPXN+1           SET THRU XNAM STACK INDEX
         AI,R3    3                 HA(STKTOP) = HA(STKTOP)+3
*                                                                       ABW06
ABP06    RES      0                                                     ABW060
         LW,D0    R7                THRU PNO = PERFORM PNO              ABW062
ABP08    RES      0                                                     ABW080
         LW,D3    R7                SAVE PERFORM PNO                    ABW082
         LI,R2    0                 RESET NLOC                          ABW183
         CI,R6    CLOP              CHECK LAST OP FLAG                  ABW064
         BANZ     ABP14             UP. PERFORM A (THRU B).
* PERFORM A......                                                       ABW08
         RCRF     R4,-1             READ NEXT CLUSTER
         LH,V2    1,R4              LOAD,CHECK THRU OPTION
         CI,V2    1
         BAZ      ABP14             DOWN. NOT THRU B
* *** MAKE SURE VARYING COUNT DOES NOT EFFECT TEST**********
* PERFORM A THRU B
         LW,R6    V2                LOAD OPTION
         BAL,L1   ADP03             CHECK THRU PREF.
         B        ABP12             PERFORM A THRU XNAM
* PERFORM A THRU PAR/SEC NAME                                           ABW14
         LH,D1    2,R2              LOAD XNO                            ABW142
ABP10    RES      0
         XW,R7    D0                SET PERFORM, THRU PNO               ABW162
         B        ABP08
* PERFORM A THRU XNAM                                                   ABW12
ABP12    RES      0
         STW,R2   JBPXN+1           SAVE THRU XNAM STACK INDEX
         LAB,D1   ABP10,CDPXN       XNAM IND. TO XNO
ABP14    RES      0                                                      1
         CI,D1    CDPXN             CHECK THRU XNO                       2
         BNE      *JBPSAV           NOT THRU XNAM                        3
* THRU XNAM                                                              4
         XW,R4    JBPXN+1           LOAD,CHECK XNO STACK INDEX           5
         CW,R4    JBPXN                                                  6
         BGE      ABP15             >/=. THRU B.                         7
* NOT THRU                                                               8
         AI,R4    1                 SET HA( THRU XNAM)
         BAL,L1   AA80              THRU XNAM TO STACK                   9
*                        R4 = HA(THRU XNAM)                             10
ABP15    RES      0                                                     11
         BAL,L1   AA84+1            AFFIX X:                            12
         XW,R4    JBPXN+1           RESTORE HA(NLOC),SET THRU XNAM INDEX14
         B        *JBPSAV           RETURN                              15
*
ABP16    RES      0                                                     ABW160
         CI,R6    CLOP
         BAZ      ABP50             DOWN.  PERFORM A (THRU B)......
* PERFORM A (THRU B).                                                   ABW18
ABP18    RES      0                                                     ABW180
*                        R7 = PERFORM PNO                               ABW1805
*                        D0 = THRU PNO                                  ABW1806
*                        D1 = THRU XNO                                  ABW1807
*                        D2 = PERFORM PDNO                              ABW1808
         LI,L0    AA02              SET LINK REGISTER                   ABW182
* GENERATE PERFORM LINKAGE                                              ABW20
ABP20    RES      0                                                     ABW200
         CI,R7    0                 CHECK PERFORM PNO                   ABW202
         BLZ      ABP24             < 0, PERFORM XNAM                   ABW204
* PERFORM PAR/SEC NAME                                                  ABW22
         BAL,L1   ABT36+1           CHECK, FORMAT BRANCH PREF CLUSTER   ABW222
* CHECK PERFORM STMT PNO                                                ABW24
*                        D0 = THRU PNO                                  ABW24 8
ABP24    RES      0                                                     ABW240
         LI,R6    3                 LOAD LOC CNTR OFFSET                ABW242
         LH,R7    JPNO              LOAD, CHECK CPNO                    ABW244
         BEZ      ABP28             = 0, PERFORM IN ROOT                ABW245
         CI,D0    0                 THRU PREF PNO=CPNO
         BE       ABP28             =, EFFECTIVELY IN ROOT              ABW247
         CI,D0    0                 CHECK FOR THRU XNAM                 ABW248
         BLZ      ABP28             XNAM, EFFECTIVELY IN ROOT           ABW249
* PERFORM IN DIFFERENT OVERLAY                                          ABW26
ABP26    RES      0                                                     ABW260
         LI,V0    DADL+1            LOAD LOC CNTR ADCON CLNG,CNTL       ABW262
         MTW,CMI  GADNO             INCR ADNO
         STH,R7   R6                PNO,OFFSET
         STW,R6   MDVAL
         STW,V0   MADC              CLNG,CNTL
         WMCF     ,BA(GADNO)-2
         LI,V0    DBLW+DIRL         LOAD OP CODE - LW,LINK REG          ABW264
         LI,L1    ABP30             SET LINK REGISTER                   ABW265
         B        AA61              FORMAT,WRITE ADCON REF CLUSTER      ABW266
* PERFORM IN ROOT/SAME OVERLAY                                          ABW28
ABP28    RES      0                                                     ABW280
         STH,R6   MAILL+1           STORE OFFSET                        ABW282
         WMCF     ,BA(MAILL)        WRITE LOC CNTR REF CLUSTER          ABW284
* SET EXIT TABLE ENTRY                                                  ABW30
*                        D1 = THRU XNO/XNAM IND.                        ABW30 9
ABP30    RES      0                                                     ABW300
         CI,D1    0                 CHECK THRU XNO                      ABW302
         BGEZ     ABP34             >/= 0, THRU PAR/SEC NAME            ABW304
* THRU XNAM                                                             ABW32
         LW,R4    JBPXN+1           LOAD HA(CLOC)
         LI,V1    DBSTW+DIRL        LOAD OP CODE - STW,LINK REG         ABW324
         LI,L1    ABP36             SET LINK REGISTER                   ABW326
         B        AA22              FORMAT,WRITE XREF CLUSTER           ABW327
* THRU PAR/SEC NAME                                                     ABW34
ABP34    RES      0                                                     ABW340
         AI,D1    -1                XNO = XNO-1(=EXIT TABLE WA DISPL)   ABW342
         STH,D1   MENO              STORE XNO DISPL                     ABW343
         WMCF     ,BA(MERC)         WRITE STW,L1 EXIT TABLE CLUSTER     ABW344
* PERFORM BRANCH                                                        ABW36
ABP36    RES      0                                                     ABW360
*                        D2,D3 = BRANCH CLUSTER/XNAM IND.               ABW36 8
         STW,R4   JBPSAV            SAVE BA(STORE CLUSTER)              ABW361
         CI,D2    CDPXN             CHECK FOR XNAM                      ABW362
         BNE      ABP40             NO. PERFORM PAR/SEC NAME            ABW363
* PERFORM XNAM                                                          ABW38
         LI,V1    DBAL              LOAD OP CODE - BAL,L1               ABW382
         LW,R4    JBPXN             LOAD HA(CLOC)
         LI,L1    ABP42             SET LINK REGISTER                   ABW386
         B        AA22              FORMAT,WRITE BRANCH XNAM CLUSTER    ABW387
* PERFORM PAR/SEC NAME                                                  ABW40
*                        D2,D3 = BRANCH CLUSTER                         ABW40 8
ABP40    RES      0                                                     ABW400
         WMCF     ,X'38'            WRITE BRANCH CLUSTER(FROM REGISTER) ABW404
* RESET EXIT TABLE ENTRY                                                ABW42
ABP42    RES      0                                                     ABW420
         LW,R4    JBPSAV            LOAD BA(CLOC)                       ABW422
         LW,L1    L0                LOAD LINK REGISTER
         BEZ      ABP43
         BAL,L1   WRMCF             WRITE STW,L1  XNO
         CI,D2    X'10000'
         BAZ      *L0               PERFORM ROOT/XNAM
         B        ABP45
* TIMES OPTION
ABP43    LI,D3    -2                SET %- VALUE
         CI,D2    X'10000'          CHECK OVERLAY FLAG
         BAZ      ABP44             DOWN. PERFORM ROOT/XNAM
* PERFORM OVERLAY
         BAL,L0   ABP45
         WMCF     ,BA(MAIPO)        WRITE LI,R1 PDNO OFFSET
         LI,D3    -5                %- VALUE = 5
ABP44    RES      0
         LW,D1    R5                RESTORE ADCON NO.
         LBAL     PRA02,CMTW+X'F0'  WRITE MTW,-1 ADCON
         LBAL     PIL22,CBNE        WRITE BNEZ %-2/3
         LW,R4    JBPSAV            LOAD BA(CLOC)
         BAL,L1   WRMCF             WRITE STW,L1 XNO
         CI,R3    0                 CHECK DATA NAME TIMES FLAG          ABW592
         BEZ      AA02              DOWN. INTEGER TIMES                 ABW593
         LAB,L1   PPI10,AA01        WRITE INTL DEF.
ABP45    BAL,L1   PIA06
         LI,R7    0                 **** WRITE LI,R7  0
         LI,L1    -X'10'
         AWM,L1   JAIXC
         BAL,L1   PIX06
         TEXT     ':ALT'            **** ADCON C:ALT
         LI,L1    X'10'
         AWM,L1   JAIXC
         B        *L0
*                                                                       ABW429
ABP50    RES      0                                                     ABW500
         LCI      4                 SAVE PERFORM PROC. INFO.             4
         STM,D0   JBPPI                                                  5
         CI,V2    X'1F'             CHECK PERFORM OPTION                ABW504
         BANZ     ACP00             UNTIL/VARYING OPTION
* TIMES OPTION                                                          ABW52
         LI,V2    IBCI              LOAD REF OPTION                     ABW542
         BAL,L1   ADI02             CHECK REF                           ABW543
         B        AA01              INVALID TIMES FIELD                 ABW544
* VALID TIMES FLD                                                       11
         CI,R6    CJINT             CHECK TIMES FLD TYPE                12
         BE       ABP56             INTEGER TIMES                       13
         BG       AA02              ZERO TIMES - NOP
* DATA NAME TIMES                                                       14
         BAL,L1   AA30              FORMAT,WRITE BIN LOAD CLUSTER       ABW552
* **                     RB = INTEGER VALUE                             21
         LW,D3    JINTL             LOAD INTL NO.+1
         AI,D3    1
         LBAL     PII22,CBLE        WRITE BLEZ  INTL NO.                24
         B        ABP57                                                 ABW558
* INTEGER TIMES                                                         ABW56
ABP56    RES      0                                                     ABW560
         LH,D1    5,R5              LOAD,CHECK INTEGER VALUE            31
         LH,V0    4,R4
         BLZ      AA02              <0, NOP.
* VALID INTEGER TIMES                                                   33
         AND,V0   K307                (INTEGER </= (2**19)-1)
         CH,V0    4,R4              TRUNCATE
         BE       %+3               NO
******** TRUNCATE INTEGER **********
         DX       221
         CI,V0    0
         BNE      %+3
         CI,D1    0
         BE       AA02              0 TIMES
         AI,V0    CLI+CRB           WRITE LI,RB INTEGER
         BAL,L1   PIA02
* *
         LI,R3    0                 LOWER DATA NAME TIMES FLAG          ABW566
ABP57    RES      0                                                     ABW570
         MTW,CMI  GADNO             ADCON NO. = ADCON NO.+1             36
         LBAL     PRA00,CSTW+CRB    WRITE STW,RB ADCON                  37
*                        D1 = ADCON NO.                                 38
         LW,R5    D1                SAVE ADCON NO.                      39
         LI,L0    0                 SET TIMES LINK = 0
* GENERATE PERFORM LINKAGE                                              42
*                        L0 = LINK REGISTER                             43
ABP60    RES      0                                                     44
         LD,D0    JBPPI             LOAD PERFORM PROC. INFO.
         LW,D2    JBPPI+2
         LW,R7    JBPPI+3                                               20
         B        ABP20             GENERATE PERFORM LINKAGE            45
*
* READY TRACE                       TYPE = X'6E'                        ACI
ACI00    RES      0                                                     ACI00
* RESET TRACE                       TYPE = X'6F'                        ACJ
ACJ00    RES      0                                                     ACJ00
*                        R1 = CNTL-X'DO'
         AI,R1    -12               MAKE OPTION X'1E1/X'1F'             COBOL41B
         STH,R1   D3                STORE TRACE OPTION
         LI,L1    AA02              SET LINK REGISTER                   AA0922
ACJ02    RES      0
         LI,D2    DACI              LOAD TRACE CLNG,CNTL
         WMCF     ,X'3A',,0         WRITE TRACE CLUSTER
* PROCEDURE REFERENCES             "PREF"                               ADP0
*
CDPN     EQU      X'400'            PAR/SEC NAME OR XNAM                ADP
CDPP     EQU      X'1000'           PAR/SEC NAME                        ADP
CDPX     EQU      X'2000'           XNAM                                ADP
CDPPO    EQU      X'100'            PAR NAME ONLY                       ADP
CDPSO    EQU      X'200'            SECTION NAME ONLY
CDPNO    EQU      X'40'             PREF ONLY                           ADP
CDPNX    EQU      X'20'             EXIT IF NOT VALID PREF
CDPRO    EQU       4                ROOT ONLY                           ADP
CDPCP    EQU      2                 PNO = CPNO, EFFECTIVELY ROOT        ADP
CDPXN    EQU      X'A0000'          XNAM IND.                           ADP
CDPDO    EQU      X'400'
*
ADP00    RES      0                                                     ADP00
*                        R2 = 0 CLUSTER NOT READ OR,                    ADP00 2
*                           = HA(CLOC)                                  ADP00 3
*                        V0 = PREF CNTL                                 ADP00 6
*                        L1 = LINK REGISTER                             ADP00 7
*                        R1,R4,V2 VOLATILE                              ADP00 8
*                        R3,R5,R6,V1, D REGISTERS NOT USED              ADP00 9
*                        IF PREF ONLY +1 RETURN FOR XNAM/ERR            ADP00 9
*                                     +2 RETURN FOR PAR/SEC NAME        ADP00 9
         CI,R2    0                 CHECK CLOC                          ADP002
         BNEZ     ADP02             NOT= 0, CLUSTER READ                ADP003
         LW,L0    L1                SAVE LINK REGISTER                  ADP004
ADP01    RES      0                                                     ADP01
         RCRF                       READ NEXT CLUSTER                   ADP012
         LW,L1    L0                RESTORE LINK REGISTER               ADP014
ADP02    RES      0                                                     ADP02
         LW,R4    R2                SET HA(CLOC)-1                      ADP022
         AI,R4    -1                                                    ADP023
ADP03    RES      0                                                     ADP03
         LH,V2    1,R4              LOAD,CHECK STMT OPTION              ADP033
         BGEZ     ADP06             NOT NAME/LIT REF                    ADP034
* NAME/LIT REF                                                          ADP04
         CI,V2    CDPN              CHECK REF TYPE                      ADP042
         BANZ     ADP20             PAR/SEC NAME OR XNAM                ADP043
* UNDEFINED,DATA, OR LIT                                                ADP06
ADP06    RES      0                                                     ADP06
         CI,V0    CDPNO             CHECK FOR PNAM ONLY                 ADP062
         BAZ      *L1               NO. RETURN                          ADP063
* S*****INVALID PROCEDURE REFERENCE*                                    ADP08
ADP08    RES      0                                                     ADP08
         LI,R1    XPS+2             LOAD DIAG CODE                      ADP082
         CI,V0    CDPNX             CHECK FOR ERROR EXIT                ADP084
         BANZ     AA092-2           YES. RETURN TO M.C.
* SET FOR ERR REF                                                       ADP10
ADP10    RES      0                                                     ADP10
         LI,R4    DAIX+X'500'       LOAD,STORE ERR REF CLNG             ADP102
         STW,R4   MEXER+1                                               ADP103
         LI,R2    BA(MEXER)+6       LOAD BA(CLOC)                        3
         B        ADP22                                                  4
*                                                                        4
* PAR,SEC NAME OR XNAM                                                  ADP20
ADP20    RES      0                                                     ADP20
         CI,V2    CDPP              CHECK FOR PAR/SEC NAME              ADP202
         BANZ     ADP30             PAR/SEC NAME                        ADP203
         CI,V2    CDPX              CHECK FOR XNAM                      ADP204
         BAZ      ADP06             NO. UNDEFINED PREF
* XNAM                                                                  ADP22
         LI,R1    0                 CLEAR INCREMENT                     ADP222
         STH,R1   1,R4                                                  ADP223
         AW,R2    R2                HA(CLOC) TO BA                       6
* W*****EXTERNAL REFERENCE**********
*   IF EXTERNAL REFERENCE IS A COBOL RUN-TIME ROUTINE (I.E., NAME STARTS
*   WITH C:), ISSUE THE WARNING DIAGNOSTIC 159 OTHERWISE ISSUE
*   DIAGNOSTIC 234 WHICH INFORMS THE PROGRAMMER THAT A PROCEDURE NAME
*   WAS UNDEFINED.
*
         LW,R4    R2                EXTERNAL NAME BEGINS IN BYTE 1
         LI,R1    0                   OF SECOND WORD OF CLUSTER
         LW,R5    L(X'02000006')
         MBS,R4   5
         CW,R1    L(X'0000C37A')    TEST IF NAME BEGINS WITH 'C:'
         BE       %+3
         LI,R1    234               IF NOT, ISSUE DIAGNOSTIC 234
         B        %+2
         LI,R1    159               IF YES, ISSUE WARNING DIAGNOSTIC 159
*                        R1 = DIAG CODE
*                        R2 = BA(CLOC)                                   9
ADP22    RES      0                                                     10
         LW,R4    R3                HA(CLOC) = HA(STKTOP)               12
         LB,R7    0,R2              CLNG TO MBS RO                      13
         STB,R7   R3                                                    14
         AI,R7    X'80'             RAISE XNAM FLAG                     15
         STB,R7   0,R2                                                  16
         AW,R3    R3                CLNG,HA(STKTOP) TO BA               17
         MBS,R2   0                 XNAM CLUSTER TO STACK               18
         SLS,R3   -1                BA(STKTOP) TO HA                    19
         LW,R2    R4                LOAD HA(CLOC)                       20
         AI,R4    -1
         LI,R7    CDPXN             LOAD XNAM IND.                      ADP224
         CI,V0    CDPNO             CHECK FOR PNAM ONLY                 ADP2242
         BANZ     DIAG              YES. XNAM RETURN
         AI,L1    1                 SET NORMAL RETURN                   ADP225
         B        DIAG              WRITE DMF CLUSTER                   30
* PAR/SEC NAME                                                          ADP30
ADP30    RES      0                                                     ADP30
         AI,L1    1                 SET NORMAL RETURN                   ADP302
         LH,R7    1,R2              LOAD,MASK PNO                       ADP303
         STB,R7   TMON1
         AND,R7   K3FF                                                  ADP304
         BEZ      ADP34             PNO = 0, ROOT                       ADP305
         CI,V0    CDPRO             CHECK FOR ROOT ONLY                 ADP306
         BAZ      ADP32             NO. NOT ROOT ONLY                   ADP307
* S*****IMPROPER REFERENCE TO OVERLAY***                                ADP31
         LB,R1    JPNO              LOAD CPNO
         SW,R7    R1                PNO = PNO-CPNO
         LI,R1     XEW              LOAD DIAG CODE                      COBOL41B
         CI,R7    0                 CHECK PNO
         BEZ      DIAG              = 0, PNO = CPNO
         BDR,L1   ADP10             NOT=, USE C:ERR.
* PROPER OVERLAY SEGMENT REFERENCE                                      ADP32
ADP32    RES      0                                                     ADP32
         CI,V0    CDPCP             CHECK FOR CPNO                      ADP322
         BAZ      ADP34             NO.                                 ADP323
         CB,R7    JPNO              COMPARE PNO,CPNO                    ADP324
         BNE      ADP34             NOT=                                ADP325
         LI,R7    0                 =, PNO = 0 (EFFECTIVELY ROOT)       ADP326
* PROPER PRIORITY SEGMENT REF                                           ADP34
ADP34    RES      0                                                     ADP34
         CI,V0    CDPPO             CHECK FOR PAR NAME ONLY             ADP342
         BAZ      ADP36             NO.                                 ADP343
         CI,V2    X'200'            CHECK FOR PAR NAME                  ADP344
         BANZ     *L1               YES. PAR NAME - RETURN              ADP345
* S*****INVALID SEC NAME REFERENCE**                                    ADP35
         LI,R1    XPS+3             LOAD DIAG CODE                      ADP354
         B        AA092             RETURN TO M.C.                      ADP355
*                                                                       ADP36
ADP36    RES      0                                                     ADP36
         CI,V0    CDPSO             CHECK FOR SECTION NAME ONLY
         BAZ      *L1               NO.
         CI,V0    CDPDO             CHECK DECLARATIVE ONLY FLAG
         BANZ     ADP38             UP. DECLATATIVE SECTION ONLY
* *** FOR SORT ONLY ****************
         CI,V2    X'2300'           CHECK FOR SECTION
         BAZ      *L1               YES. SECTION NAME                   ADP365
* W*****INVALID PAR/DECLARATIVE SECTION/XNAM REFERENCE***
         LI,R1    XPS+5             LOAD DIAG CODE                      ADP374
         B        DIAG              WRITE DMF CLUSTER
* DECLARATIVE SECTION ONLY - USE
ADP38    RES      0
         CI,V2    X'100'            CHECK DECLARATIVE FLAG
         BAZ      ADP39             DOWN. NOT DECLARATIVE
         CI,V2    X'200'            CHECK FOR SECTION
         BAZ      *L1               YES. DECLARATIVE SECTION.
* S*****INVALID NON-DECLARATIVE USAGE***
ADP39    RES      0
         LAB,R1   AA092,XPS+6       WRITE DMF CLUSTER
*
TMPNO    RES      1
ALTF1    RES      1                 ALTERED FLAG
TMON1    RES      1                 PNO ALTERED
SAVL1    RES      15
SAVL2    RES      15                                                    COBOL41B
K307     DATA     7
K27F     DATA     X'7F00'           CLNG MASK - XREF                    AA213
K102     GEN,8,24 2,0               OVERLAY PREF FLAG                   ABA184
KARBX    GEN,16,16 DARB,X'6700'     BRANCH TABL REF CLNG,CNTL           ABT364
KAIPB    GEN,16,16 DAIP,DBBR        PAR/SEC - B
MERA     DATA     X'04CA0000'       ALTER CONTROL
         DATA     0
K20F     EQU      JAKON+2           CLASS
K2F00F   EQU      JAKON+3           TYPE,NDIM
K303     EQU      JAKON+5
K3FF     EQU      JAKON+6           BYTE MASK
KAPP     EQU      JAKON+X'24'       PRIORITY SEGMENT DECLA.
JSTYP    EQU      JADAT             SEC TYPE,PNO,PDNO
JDISP    EQU      JADAT+1           DISPLAY PLIST NO.
JFDEC    EQU      JADAT+2           DECLA.FLAG
JTDB     EQU      JADAT+3           TDB/DDB NO.,0
JBPVC    EQU      JADAT+X'1F'       VARYING CNT
JBPPI    EQU      JADAT+X'20'       PERFORM PROC. INFO.
*        RES      4
JBPXN    EQU      JADAT+X'24'       PERFORM XNAM INDEX
*        RES      2                 THRU XNAM INDEX
JBPID    EQU      JADAT+X'26'       INTL NO.
*        RES      3
JSTDB    EQU      JADAT+X'31'       SEARCH FLAG
JBPSAV   EQU      JASAV+X'19'       LINK
MADC     EQU      GADNO-1           -,CLNG,CNTL
MDVAL    EQU      GADNO+1           VALUE
*                                   BASE,DISPL/XNAM
MERC     EQU      JAMOD             ETREF    STW,L1
MENO     EQU      JAMOD+1           *        XNO
MPXC     EQU      JAMOD+1           -,PERFORM EXIT
JPTYP    EQU      JAMOD+2           PAR TYP,PNO,XNO
JPNO     EQU      JAMOD+3           CPNO
MPRC     EQU      JAMOD+3           -,PREF
MPROP    EQU      JAMOD+4           *        OP,PDNO
MAIPO    EQU      JAMOD+5           PREF OFFSET   LI,R1
MADRC    EQU      JAMOD+6           -,ADREF
MADROP   EQU      JAMOD+7           *        OP,ADCON NO
JINTL    EQU      JAMOD+13          INTL DEF,NO.
MLINE    EQU      JAMOD+15          LINE NO.
MAILL    EQU      JAMOD+18          LCREF    LI,L1
MAIAL    EQU      JAMOD+20          ABS VAL  LI,RB
         END
