         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.1 - MASTER CONTROL'
* 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
RI       EQU      R7                INDEX
*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      COB41             PHASE 4.1 ENTRY POINT
         DEF      AA00 *************
         DEF      AA01,AA02,AA03    M.C. RETURNS
         DEF      AA09,AA092        DIAG RETURNS
         DEF      AA10,AA11,AA12    WRITE MCF RETURNS/SUBR.
         DEF      AA14              BWZ/*WZ INTL RESERVE
         DEF      AA15,AA16,AA17    INTL DEF
         DEF      AA18,AA19         INTL REF
         DEF      AA46              BIN ADCON
         DEF      AA49,AA50,AA51,AA52  ADCON
         DEF      AA60,AA61         ADCON REF
         DEF      AAC00,AAE00       READ
         DEF      AAZ00
         DEF      JMCRD,JMCER,JRDF  RETURNS,READ
         DEF      JMCSX,JMCSI       SUBSCRIPT ERROR, INVS SWITCH
         DEF      JMCEX             EXHIBIT SWITCH
         DEF      JAKON             CONSTANTS
         DEF      JASAV             SAVE AREA
         DEF      JADAT             DATA
         DEF      JAMOD             MODEL CLUSTERS,BUFFER
         DEF      MCBUF             MCF CLUSTER BUF
         DEF      STBAS             DATA STACK
         DEF      SSTBS             SEARCH BUFFER
         DEF      KABCG
         DEF      MEXER,MAIOC
         DEF      JAIXC,JADXC
         DEF      KCVTD             SUBROUTINE NAME
         DEF      JFDEC
         REF      PH41E             4.1 EXIT
         REF      RDCRF
         REF      RDECF
         REF      RDRGF
         REF      WRPOF
         REF      WRMCF
         REF      DIAG
         REF      PDBK                                                   1
         REF      PDBP
         REF      PDBSA             NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBT              TEMP STG DISPL - BASE 6
         REF      PDBW
         REF      PDBXA             LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      ADI00,ADI02
         REF      ADO10,ADO30
         REF      ABL00             ACCEPT
         REF      ABG00             ADD
         REF      ABV00             ALTER
         REF      ABQ00             CLOSE
         REF      ABK00             COMPUTE
         REF      ABM00             DISPLAY
         REF      ABJ00             DIVIDE
         REF      ABX00             ENTER
         REF      ABD00             EXAMINE
         REF      ACE00             GENERATE
         REF      ABT00,ABT36
         REF      ABY00             IF
         REF      ACD00             INITIATE
         REF      ABC00             MOVE
         REF      ABI00             MULTIPLY
         REF      ABO00             OPEN
         REF      ABP00             PERFORM
         REF      ABR00             READ
         REF      ACA00             RELEASE
         REF      ACC00             RETURN
         REF      ABF00             SEARCH
         REF      ABS00             SEEK
         REF      ABE00             SET
         REF      ACB00             SORT
         REF      ABN00             STOP
         REF      ABH00             SUBTRACT
         REF      ACF00             TERMINATE
         REF      ABW00             WRITE
         REF      ACI00             READY
         REF      ACJ00             RESET
         REF      ACK00             EXHIBIT
         REF      ACW00             WHEN
         REF      ABA00             PROCEDURE DEF
         REF      ABB00             USE
         REF      ACL00
         REF      ACM00
         REF      ACN00
         REF      PDBPL
         REF      PIA22
         REF      LNKTB,LNKSZ,LNKCT
         REF      LNKR7
         REF      AEC00             CORRESPONDING  MOVE
         REF      AEG00             CORRESPONDING  ADD
         REF      AEH00             CORRESPONDING  SUBTRACT
         REF      ADJ06,ADJ22       SUBSCRIPT ERROR, INVS SWITCHES
         REF      AEC40,AEC50
         REF      ACB52,ACB54,ACB60,ACB70
         REF      ACP16             VARYING FROM
         REF      ABM10
         REF      PIA02
         REF      PII20                                                  2
         REF      PIX02,PIX06,OIX02
         REF      PRA00,PRA01,PRA02,PRA04,PRA20,PRA21,PRA22,PRA24
         REF      PDD00,PDD01,PDD02,PDD03,PDD04,PDD06,PDD08
         REF      PDB02,PDB06
         REF      PDX02,PDX06
         REF      PPI32                                                  4
         REF      AVI00
         REF      ECFRF
         REF      PDBDBG,PID11                                          COBOL41A
         REF      DBSIZE
         REF      ON:LINE,PIA06                                         COBOL41A
         REF      USEBRP            REF USE BEF REPORT FG       EL27275 COBOL41A
* 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
* ALIGNMENT PROC
ORGA     CNAME
         PROC
         BOUND    8
         PEND
* DIAG CODE BASE EQUIVALENCES
XFS      EQU      148               S DIAG CODE BASE - FILE,RECORD
XPN      EQU      22
XTO      EQU      122
* R REGISTERS
CRR7     EQU      X'70'
CRL1     EQU      X'B0'
*                                                                       AA0
CALNO    EQU      X'400'            LINE NO. CLNG,CNTL                  AAC043
CBGOSE   EQU      X'20000'          OSE
CBEOC    EQU      X'F0'             E-O-CORRESPONDING OPTION            AAE042
CFLAB    EQU      3                 LABEL IND.
CFOPT    EQU      X'40'             OPTIONAL FILE
CFRAN    EQU      X'80'             RANDOM ACCESS FILE
CRPF     EQU      X'2000'           REPORT FILE FLAG
CJIB     EQU      X'4098D'          BIN - COMPUTATIONAL
CJIFC    EQU      X'0390'           FIGCON
CMI      EQU      4                 MISCELLANEOUS SEG INCREMENT
* MCF CLUSTER CLNG,CNTL
DABC     EQU      X'04C4'           MOVE
DABO     EQU      X'9C2'            I/O CALL
DAEC     EQU      X'04CF'           CORRESPONDING
DABT     EQU      X'4C0'            GO TO/EXIT
DACE     EQU      X'04CE'           BWZ/*WZ INTL NO. RESERVE
DAGP     EQU      X'0A81'           GROUP RFLD
* POF CLUSTER CLNG,CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           CONSTANT
DAII     EQU      X'0402'           INTERNAL LABEL
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIL     EQU      X'0406'           LOC. CNTR
DAIX     EQU      X'0108'           XNAM
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARE     EQU      X'0415'           EXIT TABLE
* DATA DEF
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADA     EQU      X'052D'           AN DISPLAY
DADX     EQU      X'0328'           XNAM
* DEFINITIONS/DECLARATIONS
DAPI     EQU      X'0341'           INTERNAL LABEL
DAPD     EQU      X'343'            PAR DEF                              3
DAPP     EQU      X'0246'           PRIORITY SEGMENT
DAPX     EQU      X'0447'           LINO NO.
DAPZ     EQU      X'024F'           E-O-POF
* OP CODES
CLI      EQU      X'2200'           LI
CLW      EQU      X'3200'           LW
CSTW     EQU      X'3500'           STW
CIB      EQU      X'E800'           B *
DBAL     EQU      X'6AB0'
DBCAL    EQU      X'0410'
DBLI     EQU      X'2200'           OP CODE - LI
DBSTW    EQU      X'3500'         P OP CODE - STW
DBMTW    EQU      X'3310'           OP CODE MTW,1                       COBOL41A
* INDEX REGISTER USAGE
CRI      EQU      RI*16             INDEX
DIRB     EQU      X'60'             BIN DATA
DIRL     EQU      X'B0'             LINK
* REF DATA TYPE CONTROL SETTINGS
IBCS     EQU      X'9000'           MOVE SFLD                           ABC001
IBCG     EQU      X'2000'           GRP ONLY
IBCI     EQU      X'60'             INTEGER ONLY
IBCD     EQU      X'8800'           FOR RFLD DEBUG-ITEM
*
DTWA     EQU      36                WA TEMP WORK AREA
DTBA     EQU      DTWA*4            BA TEMP WORK AREA
         PAGE
AA00     RES      0
         LI,L1    AA01              RESET RETURN SWITCH
         STW,L1   JMCRD
         B        AA01
* SORT SWITCHES
         B        AA00              CLOSE OUTSORT
         B        ACB52+1           OPEN INPUT OUTSORT
         B        ACB70             CLOSE OUTSORT
         B        ACB54             OPEN OUTPUT OUTSORT
         B        ACB60             CLOSE SORTIN
         B        ACB54             OPEN INPUT SORTIN
         B        ACB52             OPEN OUTPUT SORTIN
*
         B        AA00 *************
* PERFORM VARYING SWITCHES
         B        ACP16             FROM
*
* CORRESPONDING ERROR RETURN
         MTB,4    MAEC+1            RAISE ERROR FLAG
* CORRESPONDING NORMAL RETURN
         B        AEC50             RETURN TO CORRESPONDING CONTROL
* PHASE 4.1 MASTER CONTROL                                              AA00
AA01     RES      0                                                     AA010
         CI,R2    0                 CHECK NLOC                          AA0141
         BNEZ     AA03              > 0, NEXT CLUSTER READ              AA0142
AA02     RES      0                                                     AA020
         BAL,L1   AAC00             READ CRF CLUSTER                    AA021
AA03     RES      0                                                     AA030
         LI,R5    1                 LOAD BYTE 1 INDEX                   AA042
         AW,R5    R2                LOAD HA(CLOC)+1                     AA044
         LH,R1    0,R2              LOAD CNTL
* ** ENTRY FROM ABA30(INTL)********
         LH,R6    0,R5              LOAD 2ND HALF-WORD(HW)              AA045
         AND,R1   K3FF              MASK,CHECK CNTL
         AI,R1    -X'C4'
         BGEZ     AA04              1ST STMT CLUSTER                    13
* NOT 1ST STMT CLUSTER                                                  14
         LI,L1    AA02                                                  20
         LH,D3    1,R2              LOAD 2ND HALF-WORD(INTL)            21
         AI,R6    X'2000'           CHECK OPTYP,OPTION                  22
         BEZ      PII20             WRITE B N.S.                        23
         CI,R6    X'FF7FE'          CHECK FOR INTL/FP/TP LABEL DEF.     24
         BAZ      PPI32             YES. INTL DEF.
         B        AA02              NO. IGNORE
* 1ST STMT CLUSTER
AA04     RES      0
         BAL,L1   AVI00             INIT VAR PARAM TABL
         LH,R7    1,R2              LOAD 3RD HW                         AA046
         LI,R3    HA(STBAS)         INITIALIZE STKTOP                   AA047
         LW,D3    MLINE+1           LOAD,STORE CURRENT LINE NO
         STW,D3   PDBXA
         EXU      AA06,R1           EXECUTE ON STMT TYPE
         WMCF     ,BA(MLINE)+2,,0   WRITE LINE NO. CLUSTER
*                        R2 = HA(CLOC)                                  AA0492
*                        R3 = HA(STBAS                                  AA0493
*                        R5 = HA(CLOC)+1                                AA0495
*                        R6 = 2ND HALFWORD                              AA0496
*                        R7 = 3RD HALFWORD                              AA0497
* ERROR RETURN                                                          AA09
AA09     RES      0                                                     AA090
*                        R1 = DIAG CODE                                 AA0901
         LI,L1    AA01              SET LINK REGISTER                   AA091
         B        DIAG              TO WRITE DMF CLUSTER                AA092
*                                                                       ABC09
         LI,L1    AA01              RESET SORT SWITCH
         STW,L1   JMCRD
AA092    RES      0                                                     AA0920
         LI,L1    AA02              SET LINK REGISTER                   AA0922
         B        DIAG              WRITE DMF CLUSTER                   AA0928
* COMPLETE,WRITE MCF CLUSTER                                            AA10
AA10     RES      0                                                     AA100
*                        R2 = HA(CLOC)-1                                AA1002
*                        R7 = OP CODE/OPTION                            AA1007
         STH,R7   1,R2              STORE OP CODE/OPTION                AA101
AA11     RES      0                                                     AA110
         LI,L1    AA02              SET RETURN                          AA1102
*                        R4 = HA(CLOC)                                  AA1104
*                        V0 = CLNG,CNTL                                 AA1108
         STH,V0   0,R4              STORE CLNG,CNTL                     AA111
AA12     RES      0                                                     AA120
*                        R4 = HA(CLOC)                                  AA1204
         AW,R4    R4                CLOC TO BA                          AA122
         B        WRMCF             WRITE MCF CLUSTER                   AA123
*
* CHECK,WRITE BWZ/*WZ INTL RESERVE CLUSTER
*                        R4,D2,D3 VOLATILE
AA14     RES      0
         LW,D3    JINTE             LOAD,CHECK INTL RESERVE COUNT
         BEZ      *L1               = 0, NO RESERVE
* NOT= 0, RESERVE
         LI,D2    0                 CLEAR INTL RESERVE
         STW,D2   JINTE
         AW,D3    JINTL             UPDATE INTL NO.
         XW,D3    JINTL             EXCHANGE UPDATED,CURRENT INTL NO.
         LI,D2    DACE              LOAD CNTL
         WMCF     ,X'3A',,0         WRITE BWZ/*WZ INTL RESERVE CLUSTER
* FORMAT,WRITE INTERNAL LABEL DEF NO.                                   AA15
AA15     RES      0                                                     AA150
         LI,L1    AA01              LOAD LINK REGISTER                  AA151
AA16     RES      0                                                     AA160
         MTW,1    JINTL             INTL NO. = INTL NO.+1               AA161
AA17     RES      0                                                     AA170
         LI,R4    BA(JINTL)         LOAD BA(CLOC)                       AA174
         B        WRMCF             WRITE MCF CLUSTER                   AA175
* FORMAT,WRITE INTL REF CLUSTER                                         AA18
AA18     RES      0                                                     AA180
         LI,V0    DAII              LOAD INTL REF CLNG,CNTL             AA182
         LW,R1    JINTL             LOAD INTL NO.                       AA184
*                        R1 = INTL NO                                   AA19 1
*                        V0 = CLNG,CNTL                                 AA19 4
*                        D2 = OP CODE(/OPTIONS)                         AA19 6
*                        L1 = LINK REGISTER                             AA19 8
*                        D3 VOLATILE                                    AA19 9
AA19     RES      0                                                     AA190
         STH,R1   D3                STORE INTL NO                       AA194
         STH,V0   D2                STORE CLNG,CNTL                     AA192
         WMCF     ,X'38',,0         WRITE INTL REF CLUSTER              AA198
* FORMAT,WRITE CONSTANT/BINARY ADCON CLUSTER                            AA46
*                        R4 = BA(ADCON CLUSTER)                         AA46 4
*                        R7 = CONSTANT PORTION - 1ST HALF WORD          AA46 7
*                        L1 = LINK REGISTER                             AA46 9
*                        CONSTANT PORTION 2ND HALF SET                  AA4609
AA46     RES      0                                                     AA460
         STH,R7   MDVAL             STORE CONSTANT PORTION              AA462
         LI,V0    DADB              LOAD,STORE CONSTANT/BINARY CLNG,CNTLAA463
         STW,V0   MADC                                                  AA464
         MTW,CMI  GADNO             UPDATE ADCON NO.                    AA465
         B        WRPOF             WRITE ADCON CLUSTER                 AA466
* COMPLETE,WRITE ADCON CLUSTER - DATA REF                               AA49
AA49     RES      0                                                     AA490
*                        R7 = CONSTANT PORTION                          AA4907
*                        D3 = BASE NO., DISPL                           AA4908
*                        R4 VOLATILE                                    AA4909
         LI,R6    2                 LOAD WA ADDR. RESOLUTION IND.       AA491
         STW,D3   MDVAL+1           STORE BASE NO., DISPL               AA492
         LI,V0    DADD              LOAD DREF ADCON CLNG,CNTL           AA493
*                        R6 = ADDR. RESOLUTION IND.                     AA4906
* FORMAT,WRITE ADCON CLUSTER                                            AA50
AA50     RES      0                                                     AA500
         MTW,CMI  GADNO             UPDATE ADCON NO.(ADNO)              AA501
*                        R6 = PNO/ADDR. RESOLUTION                      AA506
*                        R7 = INVARIANT PORTION                         AA507
*                        V0 = CLNG,CNTL                                 AA508
AA51     RES      0                                                     AA510
         STH,R7   R6                STORE CONSTANT VALUE                AA511
AA52     RES      0                                                     AA520
         STW,R6   MDVAL             STORE ADCON VALUE                   AA522
         STW,V0   MADC              STORE CLNG,CNTL                     AA521
         WPOF     ,BA(GADNO)-2,,0   WRITE ADCON CLUSTER
* FORMAT WRITE ADCON REF CLUSTER                                        AA60
AA60     RES      0                                                     AA600
         MTW,CMI  GADNO             UPDATE ADCON NO.(ADNO)              AA601
AA61     RES      0                                                     AA610
         LW,V1    GADNO             LOAD ADCON NO.(ADNO)                AA611
         SLS,V1   -2                ADCON NO.(=BA DISPL) TO WA          AA614
         STH,V0   V1                SET,STORE OP CODE,ADNO              AA612
         STW,V1   MADROP                                                AA613
         LI,R4    BA(MADRC)+2       SET BA(CLOC)                        AA614
         B        WRMCF             WRITE ADCON REF CLUSTER             AA615
*
* ECF READ BRANCH
         B        AAE00             READ ECF
* READ CRF                                                              AAC0
AAC00    RES      0                                                     AAC000
         STW,L1   AARSAV            SAVE LINK REGISTER                  AAC002
AAC02    RES      0                                                     AAC080
         BAL,L1   *JRD              READ NEXT CLUSTER
         BGEZ     AAC04             NOT E-O-F
* E-O-F
         LW,R2    PDBP              LOAD,CHECK RPF FLAG
         CI,R2    CRPF
         BAZ      AAC03             DOWN. E-O-PROGRAM.
* E-O-RPF
         AI,R2    -CRPF             LOWER RPF FLAG
         STW,R2   PDBP
         LI,R2    RDCRF             SET READ CRF SWITCH
         STW,R2   JRD
         B        AAC02             COMMENCE CRF PROCESSING
AAC03    RES      0
         LI,R2    BA(KCEOP)         LOAD BA(EOP CLUSTER)
AAC04    RES      0
         SLS,R2   -1                BA(CLOC) TO HA                      AAC024
         LH,L1    0,R2              LOAD,CHECK FOR LINE NO. CLUSTER     AAC042
         CI,L1    CALNO                                                 AAC043
         BNE      *AARSAV           NO. NOT LINE NO.                    AAC044
* LINE NO.                                                              AAC06
         LH,L1    1,R2              LOAD,STORE SUBLINE NO.              AAC062
         STW,L1   MLINE+1
         AI,R2    1                 HA(CLOC) = HA(CLOC)+1               AAC064
         LH,L1    0,R2              LOAD,STORE LINE NO.                 AAC065
         STH,L1   MLINE+1
         B        AAC02             READ NEXT CLUSTER                   AAC068
* READ ECF                                                              AAE0
AAE00    RES      0                                                     AAE000
         STW,L1   AARSAV            SAVE LINK REGISTER                  AAE002
         BAL,L1   RDECF             READ ECF CLUSTER                    AAE004
         LCW,L1   JECAB             SET A(I),!(I) FLAG
         AI,L1    1
         STW,L1   JECAB
         CI,R2    0        SIDR  771/1598
         BL       AAE02          EOF ON ECF
         SLS,R2   -1                BA(CLOC) TO HA                      AAE005
         LH,L1    0,R2              LOAD,CHECK CLNG FOR OPTION ONLY     AAE022
         CI,L1    X'400'                                                AAE024
         BL       AAE02
         CI,L1    X'80'
         BAZ      AAE01
         BAL,L1   AVI00             RESET VAR COUNTS
AAE01    AI,R2    1
         LH,L1    0,R2              SECOND HW
         AI,R2    -1
         AND,L1   L(X'F000')
         CI,L1    X'9000'
         BNE      *AARSAV
         MTW,1    ECFRF             DATA - CORR
         B        *AARSAV
* OPTION ONLY, E-O-CORRESPONDING ENTRIES                                AAE04
AAE02    EQU      %
         MTW,14   JECAB             A(I),B(I) FLAG = -1
         LW,L1    MAEC+1            CHECK OSE FLAG
         CI,L1    CBGOSE
         BAZ      *AARSAV           DOWN. NO OSE.
* OSE OPTION
         STH,L1   MCBUF+1           STORE N.S. INTL NO.
         B        *AARSAV           RETURN
*
* PROCEDURE DIVISION - USING
AAU00    LW,R1    LNKCT             LINKAGE TABLE COUNT
         CI,R1    100
         BGE      AAU02             TABLE OVERFLOW
         BAL,L1   AAU03                                                 COBOL41A
         LH,R6    2,R5
         LH,R7    2,R2
         AND,R7   K3FF
         STH,R7   R6                BASE,DISP
         LH,R7    3,R5              LENGTH
         AND,R7   K4FF
         LW,R1    LNKCT                                                 COBOL41A
         STW,R6   LNKTB,R1          SAVE BASE,DISP
         STH,R7   LNKSZ,R1             AND SIZE
         MTW,1    LNKCT             UPDATE COUNT
         LH,R1    0,R5              SECOND HW
         CI,R1    X'80'
         BANZ     AA02              END
         BAL,L1   AAC00             READ CRF CLUSTER
         LI,R5    1
         AW,R5    R2                SECOND HALF WORD
         B        AAU00
AAU02    RES      0
         DX       XTO,AA02          OVERFLOW
AAU03    LH,R1    0,R5              SECOND HW                           COBOL41A
         AND,R1   L(X'F000')                                            COBOL41A
         CI,R1    X'8000'                                               COBOL41A
         BNE      *L1               RESOLVED                            COBOL41A
         LI,R1    95                                                    COBOL41A
         B        DIAG              UNDEFINED DATA                      COBOL41A
*
* EXIT PROGRAM
AAP00    LW,D1    LNKL1
         LBAL     PRA01,CLW+CRL1    *** WRITE LW,L1 ADCON
         LI,D1    L1
         LBAL     PIA02,CIB         *** WRITE B *L1
         MTB,1    PDBPL             SET CALLED PROGRAM FLAG
         B        AA02
*
* CALL                              TYPE = X'4C'
*                       R6 = STMT OPTION
ABU00    LH,R1    0,R5
         AND,R1   K2FF7F
         CI,R1    X'B000'
         BNE      ABU02             BAD/MISSING PROGRAM-NAME
         LH,R1    0,R2              LOAD,MASK CLNG
         AND,R1   K27F
         AI,R1    X'0208'           FORM XREF CLNG,CNTL
         STH,R1   LNKC
         LI,R6    2
         AW,R6    R2
         AW,R6    R6
         LB,R1    0,R6              LINKAGE NAME LENGTH
         CI,R1    8
         BLE      ABU11
         LI,R1    9
         STB,R1   LNKC              TRUNCATE TO 8 CHARACTERS
         AI,R1    -1
ABU11    AI,R6    1
         LI,R7    BA(LNKC+2)+1
         STB,R1   R7
         MBS,R6   0                 MOVE LINKAGE NAME
         LI,R6    2
         AI,R1    2
         STB,R1   LNKC+1,R6         SET LENGTH
         LH,R1    0,R5
         CI,R1    X'80'
         BANZ     ABU03             NO USING FOLLOWS
         LW,D1    GADNO
         AI,D1    4
         STW,D1   ADCR7
ABU01    BAL,L1   AAC00             READ NEXT CRF CLUSTER
         LI,R5    1
         AW,R5    R2                SECOND HW ADDR
         BAL,L1   AAU03                                                 COBOL41A
         LH,D3    2,R5
         LH,V0    2,R2
         STH,V0   D3                BASE,DISP
         LB,V0    D3
         CI,V0    X'FF'
         BE       ABU05           IN LINKAGE SECTION
         LI,V0    0
         BAL,L1   PDD00             WRITE PARAMETER
ABU04    LH,R1    0,R5              STMT OPTION
         CI,R1    X'80'
         BAZ      ABU01             MORE DATA FOLLOWS
         LW,D1    ADCR7
         LBAL     PRA01,CLI+CRR7    *** WRITE LI,R7 PARAM ADDR
ABU03    LI,R4    BA(LNKC)
         BAL,L1   WRMCF
         B        AA02
ABU02    RES      0
         DX       XPN,AA02          BAD/MISSING PROGRAM-NAME
ABU05    LW,R1    LNKCT
         BEZ      ABU10             BAD DATA USAGE
         AND,D3   L(X'FFFFFF')
         AI,R1    -1
ABU06    CW,D3    LNKTB,R1          CHECK LNKTB
         BNE      ABU07
         LW,D3    R1
         LBAL     PIA22,CLI+CRR7    *** WRITE LI,R7 PARAM DISP
         LW,D1    LNKR7
         LBAL     PRA01,X'B27E'     *** WRITE LW,R7 *PARAM,R7
         LI,D2    0
         LBAL     PDD04,DADB,D0
         LBAL     PRA01,CSTW+CRR7   *** WRITE STW,R7 PARAM ADDR
         B        ABU04
ABU07    AI,R1    -1
         BGEZ     ABU06
ABU10    RES      0
         DX       X'5D',AA02        BAD DATA USAGE
* END PROGRAM                       TYPE = X'72'                        AAX
AAX00    RES      0                                                     AAX00
         CI,R6    DAPZ              CHECK OPTION
         BE       AAX08             FORCED E-O-PROGRAM                   2
         BANZ     AAX01             JUMP IF NOT END DECL        EL27275 COBOL41A
         STW,R6   USEBRP            RESET USE BEF REPORT FG     EL27275 COBOL41A
         B        AAX04             END DECL                    EL27375 COBOL41A
AAX01    RES      0                                             EL27275 COBOL41A
* DECLARATIVE HEADER                                                     5
         LI,R6    X'100'            LOAD DECLA FLAG
         LW,R2    PDBP              LOAD,CHECK RPF FLAG
         CI,R2    CRPF                                                  11
         BAZ      AAX02             DOWN. NOT RPF DECLARATIVES          12
* RPF DECLARATIVES                                                      13
         AI,R6    X'80'             RAISE RPF DECLARATIVE FLAG          14
AAX02    RES      0                                                     15
         LH,R2    JFDEC             LOAD,CHECK DECLARATIVE FLAG         16
         STH,R6   JFDEC                                                 17
         BEZ      AA02              = 0. 1ST DECLARATIVE                18
* RPF DECLARATIVES PROCESSED                                            19
         BAL,L1   AAC00             READ NEXT CLUSTER                   20
*                        L1 = CLNG,CNTL                                 21
         CI,L1    X'03F2'           CHECK CLNG,CNTL                     22
         BNE      AAC00+1           NOT = DECLARATIVE TRAILER, IGNORE   23
         CI,R2    HA(KCEOP)         CHECK FOR E-O-CRF
         BE       AAX08             YES. NO CRF.
* DECLARATIVE TRAILER                                                   25
AAX04    RES      0                                                     26
         STB,R6   JFDEC             SET/RESET DECLARATIVE FLAG          27
         B        AA02              RETURN                              29
* E-O-PROGRAM                                                           30
AAX08    RES      0                                                     31
         LW,R1    GTMP              SET TEMP STG DISPL - BASE 6
         AI,R1    DTBA              *  (+RESERVED AREA)
         STH,R1   PDBT
         WMCF     ,BA(KCEOP)+2,PH41E WRITE E-O-POF CLUSTER
* COMPILER ERROR                                                        AAZ
AAZ00    RES      0                                                     AAZ00
         B        AA02
* STATEMENT BRANCH TABLE                                                AA06
         ORGA     AA00
AA06     RES      0                                                     AA060
         B        AAZ00             *** ROOM FOR EXPANSION ***
         B        AAZ00             *** ROOM FOR EXPANSION ***
         B        AAZ00             *** ROOM FOR EXPANSION ***
         B        AAZ00             *** ROOM FOR EXPANSION ***
         B        AAZ00             *** ROOM FOR EXPANSION ***
         B        AAZ00             *** ROOM FOR EXPANSION ***
         LI,L1    AAP00             EXIT PROGRAM
         B        AAU00             PROCEDURE DIV - USING
         LI,L1    ABU00             CALL
         LI,L1    ACL00             INSPECT
         LI,L1    ACM00             STRING
         LI,L1    ACN00             UNSTRING
         LI,L1    ABL00             ACCEPT
         LI,L1    ABG00             ADD
         LI,L1    ABV00             ALTER
         LI,L1    ABQ00             CLOSE
         LI,L1    ABK00             COMPUTE
         LI,L1    ABM00             DISPLAY
         LI,L1    ABJ00             DIVIDE
         LI,L1    ABX00             ENTER
         B        AAZ00             ENTER COBOL
         LI,L1    ABD00             EXAMINE
         LI,L1    ACE00             GENERATE
         LI,L1    ABT00             GO TO
         LI,L1    ABY00             IF
         LI,L1    ACD00             INITIATE
         LI,L1    ABC00             MOVE
         LI,L1    ABI00             MULTIPLY
         LI,L1    ABO00             OPEN
         LI,L1    ABP00             PERFORM
         LI,L1    ABR00             READ
         LI,L1    ACA00             RELEASE
         LI,L1    ACC00             RETURN
         LI,L1    ABF00             SEARCH
         LI,L1    ABS00             SEEK
         LI,L1    ABE00             SET
         LI,L1    ACB00             SORT
         LI,L1    ABN00             STOP
         LI,L1    ABH00             SUBTRACT
         LI,L1    ACF00             TERMINATE
         B        ABB00             USE
         LI,L1    ABW00             WRITE
         LI,L1    ACI00             READY
         LI,L1    ACJ00             RESET
         LI,L1    ACK00             EXHIBIT
         LI,L1    ABY00             WHEN
         B        AAX00             END
         B        ABA00             PROCEDURE DEF
         LI,L1    AEG00             CORRESPONDING  ADD
         LI,L1    AEH00             CORRESPONDING  SUBTRACT
         LI,L1    AEC00             CORRESPONDING  MOVE
         B        AA02              SOURCE SELECTED
* ***    LI,L1    AED00             SOURCE SELECTED
         B        AA02              REPORT REFERENCES
         B        AFS00             DATA RECORDS
         B        AFR00             REPORT RECORDS
         B        AFT00             ACTUAL KEY
         B        AFV00             OCCURS DEPENDING ON
*
* PHASE 4.1 ENTRY POINT
* CLEAR FILE CNTL FIELD(W,E FLDS)                                       AA000
COB41    RES      0                 PHASE 4.1 ENTRY POINT
         LW,R2    PDBP              LOAD,CHECK RPF FLAG
         CI,R2    CRPF
         BAZ      AA000             DOWN. CRF ONLY
         LI,R2    RDRGF             SET READ RPF SWITCH
         STW,R2   JRD
AA000  RES     0
         WPOF     ,BA(KUNPKA)       WRITE ND 0 IN UNPACK AREA
         LW,R7    PDBZ+3            BA(DBINDX) TO WA
         SLS,R7   -2
         STW,R7   PDBZ+3
         LB,R2    PDBZ+4            LOAD NO. OF DB'S(NDB)               AA0001
         BEZ      AA006             = 0, NO DBS                          5
*  DDB
         LI,R5    4                 LOAD BLOCK CONTAINS INDEX
         LW,V1    K1FS              LOAD STS MASK                       AA0007
AA001    RES      0                                                     AA0010
         LH,R3    *PDBZ+4,R2        LOAD DDB OFFSET                     AA0011
         SLS,R3   -2
         AW,R3    PDBZ+3            SET WA(DB)                          AA0012
         LH,V2    *R3               LOAD,CHECK DB CNTL
         CI,V2    X'300'
         BGE      AA004             NOT DDB
* DDB                                                                   AA001
         LI,V0    0                 INITIALIZE FILE STATS
         CI,V2    CFOPT             CHECK OPTIONAL FLAG
         BAZ      %+2               DOWN. NOT OPTIONAL FILE
         AI,V0    X'80'             RAISE OPTIONAL FILE FLAG
         LH,R7    *R3,R5            LOAD,CHECK BLOCK CONTAINS VALUE
         BEZ      %+2               = 0, NOT FOREIGN FILE
         AI,V0    X'4000'           RAISE FOREIGN FILE FLAG
         CI,V2    CFLAB             CHECK LABEL FLAG
         BAZ      %+2               DOWN. NOT LABELLED
         AI,V0    X'8000'           RAISE LABELLED FLAG
         CI,V2    CFRAN             CHECK RANDOM ACCESS MODE FLAG
         BAZ      %+2               DOWN. CONSECUTIVE
         AI,V0    X'2000'           RAISE RANDOM ACCESS FLAG
         LW,R7    8,R3              LOAD CHECK RERUN CONTROL
         BEZ      %+2               = 0, NO RETURN
* RERUN
         AI,V0    X'40'             RAISE RERUN FLAG
* RERUN ON E-O-REEL/UNIT  -  NOT IMPLEMENTED
         STS,V0   1,R3              STORE ADCON NO.,CLEAR FILE CNTL     AA0015
AA004    RES      0
         BDR,R2   AA001             NDB = NDB-1                         AA0021
AA006    RES      0                                                      7
         LW,D3    PDBP+1            LOAD,CHECK ENTRY POINT               8
         AND,D3   K1FS
         BEZ      AA02              = 0, SUBPROGRAM                     10
* MAIN PROGRAM                                                          11
         MTW,1    PDBK              PDDO = PDNO+1
         LW,D2    PDBK              LOAD,NEW ENTRY POINT                13
         LI,V0    DAPD              LOAD PAR DEF CNTL                   14
         BAL,L1   AA19+1            WRITE ENTRY POINT DEF               15
*                        R2 = 0                                          1
         STH,R2   D2                CLEAR PNO                           16
         SW,D2    D3                REPLACE OLD ENTRY POINT             17
         AWM,D2   PDBP+1                                                18
         LBAL     PDX02,X'1400'     WRITE M:TRAP FPT WORD 0              1
         TEXT     ':TRP'                                                44
         MTW,0    PDBDBG            SEE IF DEBUG MODULE USED            COBOL41A
         BEZ      AA005             NO                                  COBOL41A
         LCI      8                                                     COBOL41A
         STM,V0   ADJSAV            SAVE REG                            COBOL41A
         LI,V0    DBMTW             OP CODE FOR RUN-TIME MTW,1 SWTCH    COBOL41A
         LW,D3    PDBDBG            BASE DISPL OF DEBUG-CONTENTS        COBOL41A
         AI,D3    -61               1 WORD IN FRONT OF DEBUG-ITEM       COB
         BAL,L1   PID11             GEN INST WITH WA RESOLUTION         COBOL41A
         LCI      8                                                     COBOL41A
         LM,V0    ADJSAV            RESTORE REGISTERS                   COBOL41A
AA005    RES      0                                                     COBOL41A
         LBAL     PRA01,DBCAL+X'70' WRITE CAL1,8 M:TRAP PLIST            3
         BAL,L1   PDB06             WRITE                                4
         DATA     X'60201'          ****  M:TRAP FPT WORD 1
         LW,D2    PDBW              LOAD,CHECK RERUN CNTL                6
* **                     = 0, NO RERUN                                   9
* **                     = DDB NO.(<128),0 RERUN EVERY E-O-REEL/UNIT    10
* **                     = DDB NO.(<128),R RERUN EVERY R RECORDS        11
* **                     = X'FF',U(=-1) RERUN EVERY CONDITION NAME      12
* **                     = X'FF',U RERUN EVERY U CLOCK-UNITS            13
         BEZ      AA008             = 0, NO RERUN                       12
         BG       AA008             > 0, CHECKPOINT FILE                13
* RERUN EVERY CONDITION NAME/CLOCK UNITS                                16
         AI,D1    4                 ADCON NO. = ADCON NO.+1             15
         BAL,L1   PRA01             WRITE CAL1,8 M:INT/M:STIMER PLIST   16
         CI,D2    -1                CHECK U
         BE       AA007             = 1, RERUN EVERY CONDITION NAME     18
* RERUN EVERY U CLOCK UNITS                                             23
         LBAL     PDX02,X'1102'     WRITE M:STIMER FPT WORD 0           20
         TEXT     ':TIM'                                                52
         LBAL     PDB02,0           WRITE M:STIMER FPT WORD 1 - U
         LW,D1    D2                LOAD U
         LBAL     PIA02,DBLI+DIRB   WRITE LI,RB U
         LI,R6    X'F'              LOAD C:MIN INDEX                    25
         LBAL,L0  OIX02,DBSTW+DIRB  WRITE STW,RB C:MIN
         B        AA008                                                 26
* RERUN EVERY CONDITION NAME                                            27
AA007    RES      0                                                     28
         LBAL     PDX02,X'0E00'     WRITE M:INT FPT WORD 0
         TEXT     ':INT'                                                48
*                        R2 = 0                                         31
*                        D3 = ENTRY POINT PNO,DISPL                     33
AA008    RES      0                                                     32
         LCI      8
         STM,V0   ADJSAV            SAVE R8-R15
         MTW,0    PDBDBG
         BEZ      AA009
*  WRITE CLUSTERS TO PRIME DEBUG-ITEM (SET TO BLANKS)
         LI,V0    DABC              MOVE (BUILD MASTER CLUSTER)
         LI,V1    -3
         STH,V0   V1
         STW,V1   MCBUF
         LI,V0    4
         SLS,V0   16
         STW,V0   MCBUF+1
         LI,R4    BA(MCBUF)
         BAL,L1   WRMCF             WRITE MOVE ALL LIT TO AN MASTER CLUS
         LI,V0    CJIFC
         AI,V0    2                 FORM ALL '1 CHAR' AN LITERAL
         SLS,V0   16
         STW,V0   MCBUF
         LI,V0    X'40'             BLANK CHARACTER
         SLS,V0   8                 POS FIELD
         STW,V0   MCBUF+1
         LI,R4    BA(MCBUF)
         BAL,L1   WRMCF             WRITE SFLD
         LI,V0    DAGP              FORM RFLD
         LI,V1    CFRAN+1
         STH,V0   V1
         STW,V1   MCBUF
         LI,V0    IBCD
         LW,V1    PDBDBG
         AI,V1    -53               CHG TO BASE/DISPL OF DEBUG-ITEM
         SLD,V0   16
         STW,V0   MCBUF+1           FORM SECOND WORD
         LW,D2    DBSIZE
         AI,D2    -132
         AI,D2    185
         OR,V1    D2                DISPL + CHAR SIZE
         STW,V1   MCBUF+2
         SLS,D2   16
         STW,D2   MCBUF+3           BYTE SIZE
         LI,V0    0
         STW,V0   MCBUF+4           CLEAR FLD I (EDITING INFO)
         LI,R4    BA(MCBUF)
         BAL,L1   WRMCF             WRITE RFLD (DEBUG-ITEM)
AA009    LI,D2    0
         LBAL     PDD04,DADB,D0     SAVE R11 ADCON
         STW,D1   LNKL1
         LBAL     PRA01,CSTW+CRL1   *** WRITE STW,L1 ADCON
         LI,D2    0
         LBAL     PDD04,DADB,D0     SAVE R7 ADCON
         STW,D1   LNKR7
         LBAL     PRA01,CSTW+CRR7   *** WRITE STW,R7 ADCON
         LCI      8
         LM,V0    ADJSAV
         MTW,0    ON:LINE                                               COBOL41A
         BEZ      AA008%                                                COBOL41A
         BAL,11   PIX06                                                 COBOL41A
         TEXT     ':DB1'                                                COBOL41A
         BAL,11   PIA06                                                 COBOL41A
         DATA     0                                                     COBOL41A
AA008%   RES      0                                                     COBOL41A
         STW,R2   JADXC+2           CLEAR CONSTANT PORTION              34
         LH,R7    D3                LOAD PNO,PDNO                       40
         LW,D2    D3                                                    41
         B        ABT36-1           WRITE B ENTRY POINT                 37
K1FS     DATA     X'FFFFFF'         STS MASK                            AA0007
KUNPKA GEN,16,8,8 DADA,6,0          TEMP STG DATA CLNG,CNTL
         GEN,16,16 0,X'01F0'        ND 0
* REPORT RECORDS                    TYPE = X'7A'                        AFR
AFR00    RES      0                                                     AFR00
         MTW,4    JDOID             SET FOR REPORT NAME
         BAL,L0   ADO10             CHECK REPORT RECORD (=FILE NAME)
         B        AA02              INVALID REPORT RECORD
         B        AA02              VALID REPORT RECORD
* DATA RECORDS                      TYPE = X'79'                        AFS
AFS00    RES      0                                                     AFS00
         LH,V1    1,R5              LOAD,CHECK DATA TYPE                AFS001
         CI,V1    X'5000'
         BL       AFS04             NOT NORMAL/LABEL RECORD             AFS003
AFS02    RES      0                                                     AFS020
         LI,L1    AFS03             SET LINK REGISTER
         LI,V2    IBCG              LOAD REF CNTL
         LI,D0    X'7F'             MASK,SAVE DDB NO.
         AND,D0   R6
         EOR,R6   D0
         STH,R6   0,R5
         SLS,D0   8                 POSITION DDB NO.
         B        ADI00             CHECK FLD
AFS03    RES      0
         B        AA01              INVALID RECORD
* VALID RECORD
*                        D0 =DDB NO.
         LW,R7    D0                LOAD DDB NO.
         BAL,L1   ADO30             CHECK DDB
*                        R1 = 2
         CB,R1    *R7               CHECK DDB I.D.
         BGE      AA02              VALID RECORD
* S*****INVALID RECORD NAME*********                                    AFS04
AFS04    RES      0                                                     AFS040
         DX       XFS+1,AA02        WRITE DMF CLUSTER                   AFS041
*                                                                       AFT0
* ACTUAL KEY                        TYPE = X'7B'                        AFT
AFT00    RES      0                                                     AFT00
         BAL,L1   AFS02+1           MASK,SAVE DDB NO.
         B        AA01              INVALID KEY
* VALID KEY
*                        D0 =DDB NO.
         LW,R7    D0                LOAD DDB NO.
         BAL,L1   ADO30             OBTAIN WA(DDB)
*                        R7 = WA(DDB)
         LW,D1    1,R7              LOAD FILE STATS
         CI,D1    X'C00'            CHECK KEY FLAGS
         BANZ     AFT18             UP. DUPLICATE KEY
* 1ST KEY
         LH,D0    2,R4              LOAD DISPL(BYTES 2,3)               AFT041
         LH,D2    2,R5              LOAD STORE BASE,DISPL(BYTE1)
         STH,D2   D0
         STW,D0   4,R7              STORE BASE,DISPL (IN DDB)           AFT045
         CI,D1    X'2000'           CHECK DIRECT ACCESS MODE FLAG
         BAZ      AFT10             DOWN. SEQUENTIAL
* ACTUAL KEY
         AI,D1    X'400'            RAISE ACTUAL KEY FLAG
         STW,D1   1,R7                                                  AFT1
*                        D3 = DCB BASE(=RECORD AREA BASE+100),0         20
         LW,D0    2,R7              LOAD WA ALIGN RECORD LNG(=KEY AREA)
         AI,D0    3
         LI,D1    X'FFFC'           SELECTIVE STORE KEY AREA DISPL
         STS,D0   D3
         AI,D3    1                 DISPL = DISPL+1
         SW,D3    K064              ADJUST BASE
         LH,V0    3,R4              LOAD,POSITION BSIZK(</= 255)
         SLS,V0   8
         CI,V0    X'F0000'         CHECK BSIZK
         BAZ      AFT04            </= MAX.(=255)
* S*****BSIZK > MAX.%%%%%%%%%%%%%%%
         DX       202              WRITE DMF CLUSTER
         LI,V0    X'FF00'          USE MAX.
AFT04    RES      0
         BAL,L1   PDD00             WRITE ADCON BSIZK,BA(KEY AREA)
*                        D1 = ADCON NO.(BA)                             30
         SLS,D1   -2                BA(ADCON) TO WA
         STH,V0   D1                STORE BSIZK
         STW,D1   3,R7              STORE BSIZK,ADCON NO. (IN DDB)
         B        AA01              RETURN
* CONSECUTIVE KEY
AFT10    RES      0                                                     AFT100
         CI,R6    CJIB              CHECK CLASS                         AFT102
         BE       AFT14             BINARY KEY                          AFT104
         LH,V1    3,R4              LOAD,CHECK BSIZK
         CI,V1    7
         BNE      AFT18             NOT = 7, INVALID KEY.               AFT123
         CI,R6    0                 CHECK CLASS IND.                    AFT124
         BL       AFT14             NOT NUMERIC                         AFT125
         CI,V0    0                 CHECK DECP                          AFT126
         BNEZ     AFT18             NOT INTEGER                         AFT127
* VALID  KEY                                                            AFT14
AFT14    RES      0                                                     AFT140
         STW,R6   3,R7              STORE DATA DESCRIPTION              AFT103
         AI,D1    X'800'            RAISE UPDATE KEY FLAG               AFT142
         STW,D1   1,R7                                                  AFT1
         B        AA01              RETURN
* INVALID KEY                                                           AFT18
AFT18    RES      0                                                     AFT180
         LI,R1    XFS+6             LOAD DIAG CODE                      AFT182
         B        AA09              RETURN                              AFT184
* OCCURS DEPENDING ON               TYPE = X'7C'                        AFV
AFV00    RES      0                                                     AFV00
         LBAL     AFS02+2,IBCI,V2   SAVE DDB NO.,CHECK FLD
         B        AA01              INVALID DEPENDING ON FLD            12
* VALID DEPENDING ON FLD                                                13
*                        D0 =DDB NO.
         LW,R7    D0                LOAD DDB NO.
         BAL,L1   ADO30             LOAD WA(TDB)                        22
*                        R7 = WA(TDB)                                   23
         LI,V1    CRI+X'C'          LOAD RI,INDEX LOAD CNTL
         AI,R6    -X'30'            FORM,STORE LOAD CLUSTER CNTL        25
         STH,R6   V1                                                    26
         STW,V1   2,R7              STORE LOAD CNTL                     27
         SLS,R7   2                 WA(TDB) TO BA(TDB)+14               28
         AI,R7    14
         LI,R6    10                LOAD,STORE BLNG                     29
         STB,R6   R7                                                    30
         LW,R6    R4                LOAD,FORM BA(CLOC)                  31
         AW,R6    R6                                                    32
         MBS,R6   6                 MOVE DEPENDING ON CLUSTER TO TDB    33
         B        AA01              RETURN
JRD      DATA     RDCRF             READ SWITCH
* CORRESPONDING BRANCH ADCONS
JRDF     DATA     AAC00             READ FILE                           ADI103
JMCRD    DATA     AA01              READ RETURN
JMCER    DATA     AA01              ERROR RETURN
JMCSI    DATA     ADJ22             SUBSCRIPT INVS SWITCH
JMCSX    DATA     ADJ06             SUBSCRIPT ERROR
JMCEX    DATA     ABM10             EXHIBIT SWITCH
         ORGA     AA00
JAKON    RES      0                 CONSTANTS
K064     GEN,8,24 100,0             FILE,RECORD BASE NO. ADJ.           ABR3225
K0FF     GEN,8,24 X'FF',0           1ST BYTE MASK                       ABX085
K20F     DATA     X'F00'            CLASS MASK                          ADI321
K2F00F   DATA     X'F00F'           TYPE,NDIM MASK
K2FF7F   DATA     X'FF7F'           CLNG,CNTL MASK                      AFT125
K303     DATA     3                 BA/HA DISPL BIT MASK                ADI434
K3FF     DATA     X'FF'             BYTE MASK
K0FFFF   GEN,16,16 X'FFFF'          HALF-WORD MASK
K4BAS    GEN,8,24 4,0
KCVTD    RES      0                                                     21280
         TEXT     ':ERR'            ERROR
         TEXT     ':ERA'
         TEXT     ':ABA'
         TEXT     ':MIN'                                                56
         TEXT     ':TRC'            TRACE
         TEXT     ':TRX'            TRACE EXIT
         ORG      JAKON+X'20'
KHASTK   DATA     HA(STBAS)         HA(STKBAS)
KTMPB    GEN,8,24 6,64              TEMP BUFFER BASE,DISP               ABM245
KMOC     GEN,8,24 4,C'M:O'          BYTE LNG, C'M:OC'                   ABM222
         GEN,8,24 C'C',0                                                ABM223
KAPP     RES      0  (DATA,2 DAPP)  PRIORITY SEGMENT DECLARATION        ABA017
KABCG    GEN,16,16 DAPP,DABC        MOVE GRP CLNG,CNTL                  ABW392
         GEN,16,16 -2,5             *        IDENTIFIERS                ABP093
KCEOP    GEN,16,16 X'03F2',DAPZ     E-O-CRF,MCF CLNG,CNTL
         ORGA     AA00
JADAT    RES      0                 DATA
JSTYP    DATA     0                 SEC PRTYP,PNO,XNO                   ABA081
JDISP    GEN,8,24 X'80',0           DISPLAY FLAG                        ABM202
JFDEC    GEN,8,24 0,1               DECLA. FLAG,INDEX
JTDB     DATA     0                 TDB NO.                             ADI212
*        BOUND    8
JDECP    RES      1                 DECP
JDSIZ    RES      1                 DSIZ
JSFLD    RES      1                 SFLD TYPE,CNTL
JDLST    EQU      %+1               DECP/SUBF LAST                      ADG121
JDMAX    EQU      %+3               DECP/SUBF MAX                       ADG122
JDMIN    EQU      %+5               DECP/SUBF MIN                       ADG123
JLNKT    EQU      %+7               DECP/SUBF LNKT                      ADG124
JSIZM    EQU      %+8               SIZE MAX                            ADG125
         RES      10
JLNKL    RES      7                 LAST LINK(HW ENTRIES)               ADG
JTYPB    RES      1                 TYPE BITS                           ADF054
JDREF    RES      1                 WA(NREF)                            ADF002
JDIGN    RES      1                 IGNORE OPTIONS                      ADF003
JLSTI    RES      1                 LAST REF(I)
JNREF    RES      0                 TOTAL NO. OF DATA REFS
JDEXU    RES      1                 TYP EXU LOC                         ADF009
JDANC    RES      1                 WA(ANCHOR)                          ADF0092
JDOID    DATA     1                 DDB I.D.
JECAB    RES      4                 A(I),B(I) FLAG
*                                   CSXR
*                                   ECF/CRF CLOC
*                                   MOVE OR ADD/SUBTRACT LINK
         RES      1
* JCB--  BOUND 8, RES  4  OVERLAP OF JEC-- *******
JBPXN    RES      2                 PERFORM XNAM INDEX
JBPID    RES      3
JBPFA    RES      3                 FROM ANCHOR
JBPBA    RES      3                 BY ANCHOR
         RES      1
JBPCV    RES      1                 CURRENT V
JSTDB    RES      0                 SEARCH WA(TDB)
JSTDL    DATA     0                 INTL NO.
JIGNL    DATA     0                 IGNORE LIT FLAG
         ORG      JADAT+X'40'
JNDIM    DATA     0                 NO. OF DIMENSIONS(NDIM)             ADI215
JTDBN    DATA     0                 INDEX TDB NO.(0,TDB(3),(2),(1))     ADJ111
JNSUBX   DATA,2   0,0               NDIM - NSUB                         ADJ077
JSUBF    DATA     0,0,0             SUBSCRIPT FACTORS(SUBF(3),(2),(1))  ADJ095
JCLNG    RES      1                 CLNG
         RES      2   **************
JINVS    DATA     0                 INVARIANT SUBSCRIPT VALUE           ADJ113
JTSH     DATA     0                 TYPE SHIFT                          ADJ117
JADDR    DATA     0                 ADDR RESOLUTION INDICATOR           ADJ
         ORGA     AA00
         DEF      JDCSAV
JASAV    RES      0                 SAVE AREA
JDFSAV   RES      2                 REF CONTROL,LINK REG                ADF001
JNTYP    EQU      JASAV+1           NO. OF TYPES
JDGSAV   RES      7                 SAVE REGISTERS,RETURN               ADG002
ADHSAV   RES      1                 SAVE LINK REGISTER                  ADH091
ADISAV   RES      6                 SAVE REGISTERS,RETURN               ADI02
ADJSAV   RES      8                 SAVE REGISTERS,RETURN               ADJ072
ABMSAV   RES      1                 LINK REGISTER                       ABM0014
JBPSAV   RES      1                 THRU XNAM STACK INDEX
AARSAV   RES      1                 LINK REGISTER                       AAC002
JDCSAV   RES      20
MADC     EQU      GADNO-1           -,CLNG,CNTL
*  GADNO DATA     -CMI              ADCON NO.
MDVAL    EQU      GADNO+1           VALUE
         ORGA     AA00
JAMOD    RES      0                 MODEL CLUSTERS,BUFFER
MERC     DATA,2   DARE,DBSTW+DIRL   EXIT REF CLNG,CNTL AND STW,L1       ABV07
MENO     RES      0                 EXIT TABLE NO.                      ABV182
MPXC     DATA     DABT              PERFORM EXIT                        ABA231
JPTYP    DATA,2   0,0               PAR PRTYP,PNO,XNO                   ABA101
JPNO     RES      0                 SECTION PRIORITY NO.(CPNO)
MPRC     DATA     DAIP              PROCEDURE REF(COMPLETE) CLNG,CNTL   ABV070
MPROP    RES      1                 OP CODE,R PDNO                      ABV071
MAIPO    GEN,16,16 DAIP+1,DBLI+X'10' PREF OFFSET CLNG,CNTL LI,R1
MADRC    DATA     DARA              ADCON REF CLNG,CNTL                 AA612
MADROP   RES      1                           OP CODE, ADCON NO.        AA613
MABCG    GEN,16,16 DABC+X'201',0    SPECIAL MOVE CLNG,CNTL,OPTION
*        RES      2                 BASE NO.,DISPL,BLNG                 ABR1414
MEXER    RES      2                 ERROR ADCON CLNG,CNTL               ABA142
*                                   *           0,CLNG,CNTL,OP CODE OR  ABA143
*                                   *           BASE,DISPL,VALUE        ABA144
         DATA     X'05C3'           ERROR BLNG,NAME                     ABA145
         DATA     C':ERR'                                               ABA146
JINTL    GEN,16,16 DAPI,0           INTL DEF CLNG,CNTL,RANGE            ABT107
JINTE    DATA     0                 BWZ/*WZ INTL NO. RESERVE
MLINE    DATA     DAPX              LINE NO.
         DATA     0
         RES      1  ***************
MAILL    GEN,16,16 DAIL,DBLI+DIRL   LOC CNTR REF CLNG,CNTL AND LI,L1    ABW282
*        DATA,2   OFFSET
         RES      1                 OFFSET
MAIAL    GEN,16,16 DAIA,DBLI+DIRB   ABSOLUTE CLNG,CNTL - LI,BIN REG     ABW564
*        DATA,2                     BIN VALUE                           ABW565
MAEC     DATA     DAEC              CORRESPONDING CLNG, CNTL
         DATA     0                 OPTION,N.S.INTL NO.
JAIXC    GEN,16,16 DAIX+X'600',DBAL BAL,L1 XREF CLUSTER
         GEN,16,8,8 0,5,C'C'                                            21292
         RES      1                                                     21293
JADXC    GEN,16,16 DADX+X'600',0    C:--- ADCON CLUSTER
         DATA     0
         GEN,16,8,8 0,5,C'C'
         TEXT     ':ABA'
JADDC    GEN,16,16  0,0             -,CNTL
         GEN,16,16  0,0             OPTION,SUBSCRIPT INFO.
         RES      3                 BASE,DISPL
LNKC     DATA     DBAL              LINKAGE BALL1 XREF CLUSTER
         GEN,24,8 0,'L'
         DATA     ':   '
         RES      2
LNKL1    RES      1                 RETURN ADDR FOR LINKAGE
ADCR7    DATA     0                 ADCON ADDR FOR CALL PARAM
K27F     DATA     X'7F00'           LENGTH MASK
K4FF     DATA     X'FFFF'
*                                   DSIZ,BSIZ
*                                   DECP
         ORG      JAMOD+X'40'
MAIOC    DATA     DABO              I/O CLNG,CNTL
*        RES      2                     OPT,DDB,N.S.,INTL,XNO,PDNO
*        RES      2                     DDB BASE/BSIZ,PNO
         BOUND    8
MCBUF    RES      0                 MCF CLUSTER BUFFER
         RES      20  ***************
         DEF      MDBUF             MCF CONDITIONAL
MDBUF    RES      0                 MCF CONDITIONAL
         RES      20  ***************
SSTBS    RES      32                SEARCH BUFFER
         ORGA     AA00
STBAS    RES      200               STACK BASE
         RES      200
         END
