         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.2 - PROGRAM FLOW'
* READ PROC                                                             APR
* LF     R---     R-,+/-HW OFFSET,INDIRECT ADDR.                        APR  1
RMCF     CNAME    1                                                     APR01
         PROC                                                           APR04
LF       BAL,L1   RDMCF             READ MCF CLUSTER
         SLS,R2   -1                BA(CLOC) TO HA
         DO       NUM(AF(1))                                            APR30
         LW,AF(1) R2                LOAD HA(CLOC)+/- HW OFFSET          APR31
         DO       NUM(AF(2))                                            APR40
         AI,AF(1) AF(2)                                                 APR41
         ELSE                                                           APR42
         AI,AF(1) -1                SET HA(CLOC)-1
         FIN                                                            APR44
         FIN                                                            APR44
         PEND                                                           APR50
* WRITE PROC                                                            APW
* LF     W---     R-,BA(CLOC)+/-BA OFFSET,RETURN                        APW 1
WPOF     CNAME    0                                                     APW00
         PROC                                                           APW03
         DO       NUM(AF(2))                                            APW11
LF       LI,R4    AF(2)             LOAD BA(CLOC)                       APW12
         ELSE                                                           APW13
         DO       NUM(AF(1))                                            APW132
LF       LW,R4    AF(1)             LOAD,SET HA(CLOC) TO BA             APW14
         AW,R4    R4                                                    APW15
         FIN                                                            APW16
         FIN                                                            APW17
         DO       NUM(AF(4))
         B        WRPOF             WRITE POF CLUSTER
         ELSE
         DO       NUM(AF(3))
         LI,L1     AF(3)
         B        WRPOF             WRITE POF CLUSTER                   APW841
         ELSE                                                           APW842
         BAL,L1   WRPOF             WRITE POF CLUSTER                   APW843
         FIN                                                            APW844
         FIN                                                            APW848
         PEND                                                           APW90
* DIAG PROC                                                             APD
DX       CNAME                                                          APD00
         PROC                                                           APD01
* AF     DX       DIAG CODE,LINK                                        APD02
LF       LI,R1    AF(1)             LOAD DIAG CODE                      APD10
         DO       NUM(AF(3))
         B        DIAG
         ELSE
         DO       NUM(AF(2))
         LI,L1    AF(2)             LOAD LINK REGISTER
         B        DIAG              WRITE DMF CLUSTER                   APD242
         ELSE                                                           APD243
         BAL,L1   DIAG              WRITE DMF CLUSTER                   APD244
         FIN                                                            APD248
         FIN                                                            APD29
         PEND                                                           APD40
* LINK(OR LOAD) AND BRANCH PROC                                         APL
* LF     LAB,L/R  BRANCH ADDRESS,LINK ADDRESS(OR LOAD VALUE)            APL  1
LAB      CNAME                                                          APL01
         PROC                                                           APL04
LF       LI,CF(2) AF(2)             SET LINK REGISTER                   APL12
         B        AF(1)             BRANCH                              APL14
         PEND                                                           APL90
* LOAD,BRANCH AND LINK                                                  PRL
LBAL     CNAME    0                                                     PRL01
         PROC                                                           PRL02
* LF     LBAL,L-  BRANCH,LOAD VALUE,V-                                  PRL09
         DO       NUM(AF(3))                                            PRL20
         LI,AF(3) AF(2)             LOAD VALUE                          PRL22
         ELSE                                                           PRL23
         LI,V0    AF(2)             LOAD VALUE                          PRL24
         FIN                                                            PRL28
         DO       NUM(CF(2))                                            PRL40
         BAL,CF(2) AF(1)            BRANCH                              PRL42
         ELSE                                                           PRL43
         BAL,L1   AF(1)             BRANCH                              PRL44
         FIN                                                            PRL48
         PEND                                                           PRL99
* EXTERNAL REFERENCES
         REF      BAA02             RETURN
         REF      PIA02
         REF      PIA06
         REF      PIA26
         REF      PII02
         REF      PID16
         REF      PRA21
         REF      PIL02
         REF      PIL06
         REF      PIX02,PIX06,OIX02
         REF      PRA01,PRA02
         REF      PRB06
         REF      PRE01
         REF      PDX02,PDX06
         REF      SSS00,SSB00
         REF      WRPOF
         REF      RDMCF
         REF      PDBS              NO. OF BYTES FOR BASE 4(HALF-WORD)
         REF      PDBX              LINE NO.                            AAC063
         REF      PDBZ              DDB ADCONS
*                                             +3 = WA(DBB BASE)
*                                             +4 = NO. OF DDB'S,
*                                                  WA(DBINDX)
         REF      GTMP              TEMP STG
         REF      GADNO             ADCON NO.
         REF      ALTGB,ALTGC,ALTGP
* REGISTER EQUIVALENCES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6                                                     117
R7       EQU      7                                                     116
V0       EQU      8
V1       EQU      9
V2       EQU      10
L0       EQU      V2                                                    1212
L1       EQU      11                LINK REGISTER
D0       EQU      12                DECA
D1       EQU      13
D2       EQU      14
D3       EQU      15
RB       EQU      R6                BIN
RF       EQU      V2                FILE CNTL
RE       EQU      4                 EVEN
RO       EQU      5                 ODD
SR1      EQU      8                 SR1
SR3      EQU      X'A'              SR3
* BA(D-)                                                                CBD
CBD0     EQU      X'30'                                                 CBD0
CBD1     EQU      X'34'                                                 CBD1
CBD2     EQU      X'38'                                                 CBD2
CBD3     EQU      X'36'                                                 CBD3
* INDEX REGISTERS                                                       CIR
CIR1     EQU      2                                                     CIR1
CIR2     EQU      4                                                     CIR2
CIR3     EQU      6                                                     CIR3
CIR4     EQU      8                                                     CIR4
CIR5     EQU      X'A'                                                  CIR5
CIR6     EQU      X'C'                                                  CIR6
CIR7     EQU      X'E'
* R REGISTERS
CRR1     EQU      X'10'                                                 CR01
CRR2     EQU      X'20'                                                 CR02
CRR3     EQU      X'30'                                                 CR03
CRR4     EQU      X'40'                                                 CR04
CRR5     EQU      X'50'                                                 CR05
CRR6     EQU      X'60'                                                 CR06
CRR7     EQU      X'70'                                                 CR07
CRV0     EQU      X'80'                                                 CR08
CRV1     EQU      X'90'                                                 CR09
CRV2     EQU      X'A0'                                                 CR10
CRL1     EQU      X'B0'                                                 CR11
CRD0     EQU      X'C0'                                                 CR12
CRD1     EQU      X'D0'                                                 CR13
CRD2     EQU      X'E0'                                                 CR14
CRD3     EQU      X'F0'                                                 CR15
CRE      EQU      X'40'             EVEN
CRO      EQU      X'50'             ODD
CRB      EQU      CRR6              BIN
CRF      EQU      CRV2              FILE CNTL
CSR1     EQU      X'80'             SR1                                 CR3
CSR3     EQU      X'A0'             SR3                                 CR3
* OP CODES
CCAL1    EQU      X'0400'           CAL1                                C04
CLI      EQU      X'2200'           LI                                  C22
CSTW     EQU      X'3500'           STW                                 C35
CSTS     EQU      X'4700'           STS                                 C47
CLW      EQU      X'3200'                                               C32
CEOR     EQU      X'4800'           EOR                                 C48
COR      EQU      X'4900'           OR                                  C49
CMBS     EQU      X'6100'           MBS                                 C61
CBDR     EQU      X'6400'                                               C64
CEXU     EQU      X'6700'                                               C67
CBR      EQU      X'6800'           B                                   C68
CBLE     EQU      X'6820'           BLE,BLEZ                            C682
CBEZ     EQU      X'6830'           BEZ                                 C683
CBAZ     EQU      X'6840'           BAZ                                 C684
CIND     EQU      X'8000'           INDIRECT BIT                        C900
CBAL     EQU      X'6AB0'                                               C691
* POF CLUSTER CLNG,CNTL
* INSTRUCTION TYPE
DAIA     EQU      X'0401'           CONSTANT
DAID     EQU      X'0609'           DATA
DAII     EQU      X'0402'           INTERNAL LABEL
DAIL     EQU      X'0406'           LOC. CNTR
DAIP     EQU      X'0404'           PAR/SEC NAME
DAIX     EQU      X'0108'           XREF
* DATA REFERENCE
DARA     EQU      X'0410'           ADCONS
DARB     EQU      X'0417'           BRANCH TABLE
DARE     EQU      X'0415'           EXIT TABLE
* DATA DEF
DARF     EQU      X'41A'            FILE LABEL
DADB     EQU      X'0621'           BINARY
DADD     EQU      X'0829'           DATA REF
DADL     EQU      X'0626'           LOC. CNTR
* DEFINITIONS/DECLARATIONS
DAPI     EQU      X'0341'           INTERNAL LABEL
* SUBROUTINE NAME
XTRC     EQU      X'18'             TRACE
*
* ENTRY POINTS
         DEF      BBP00
         DEF      BBT00
         DEF      BCT00             TRACE
         DEF      BCF00             CORRESPONDING
         DEF      LCORF
*
*        ALTER CONTROL CLUSTER
BBP00    RES      0
         LW,R5    ALTGC
BBP01    AI,R5    -1
         BLZ      BAA02
         CH,D1    ALTGP,R5
         BNE      BBP01
         LW,D1    ALTGB,R5
         LBAL     PRA01,CSTW+CRL1   **** WRITE STW,L1 BUFFER ADDR
         LBAL     PRA02,CLI+CRR7    **** WRITE LI,R7  BUFFER ADDR
         BAL,L1   PIX06
         TEXT     ':ALT'            **** ADCON C:ALT
         B        BAA02
* GO TO,EXIT,TEST AND BRANCH                                            BBT
BBT00    RES      0                                                     BBT000
         CI,R6    X'FC00'           CHECK OPTION                        BBT002
         BANZ     BBT20             PERFORM EXIT/ALTERED GO TO          BBT003
* GO TO DEPENDING ON/ZERO TEST                                          BBT02
*                        D1 = INTL NO.                                  BBT0209
*                        D1 = INTERNAL LABEL NO.                        MTL20 7
         BAL,L1   PIA26             WRITE                               MTL222
         CI,RB    0                 ****     CHECK FOR ZERO             MTL223
*                        D3 = INSTRUCTION                               MTL2409
         LI,V0    CBLE              LOAD OP CODE - BLE                  MTL242
         BAL,L1   PII02             WRITE BLE INTL CLUSTER
         LI,R1    3                 SET INDEX REGISTER                  MTL262
         STB,R6   D3,R1             LOAD,STORE LIMIT                    MTL263
         WPOF     ,CBD2+2           WRITE CI,R6 LIMIT CLUSTER           MTL264
         MTB,1    D1                BLE(X'682') TO BG(X'692')           MTL282
         WPOF     ,CBD0+2           WRITE BG INTL CLUSTER               MTL284
* GO TO DEPENDING ON                                                    BBT04
         CI,R6    X'100'            CHECK DEPENDING ON OPTION           BBT044
         BANZ     BBT08             DIRECT BRANCH                       BBT045
* NOT DIRECT BRANCH                                                     BBT06
         BAL,L1   PIL06             WRITE                               BBT062
         LW,R1 2,RB                 ****  LW,R1  %+2,RB
         B        BBT22             WRITE LB,R2 R1                      BBT064
*                                   *     EXU   BTBL,R2                 BBT065
* DIRECT BRANCH                                                         BBT08
BBT08    RES      0                                                     BBT080
         BAL,L1   PIL06             WRITE                               BBT082
         EXU      0,RB              ****  EXU  %,RB                     BBT083
         B        BAA02             RETURN
* PERFORM EXIT/ALTERED BRANCH                                           BBT20
*                        D1 = XNO                                       BBT2009
BBT20    RES      0                                                     BBT200
         CI,R6    X'2FF'            CHECK PREF TYPE,PNO
         BAZ      BBT24             DIRECT BRANCH                       BBT205
* NOT DIRECT BRANCH                                                     BBT21
         LI,V0    CLW+CRR1          LOAD OP CODE - LW,R1                BBT214
         BAL,L1   PRE01             WRITE LW,R1 XNO
BBT22    RES      0                                                     BBT220
         BAL,L1   PIA06             WRITE                               BBT222
         LB,R2    R1                ****  LB,R2 R1                      BBT223
         BAL,L1   PRB06             WRITE                               BBT224
         EXU      0,R2              ****  EXU BTBL,R2                   BBT225
         B        BAA02             RETURN                              BBT228
* DIRECT BRANCH                                                         BBT24
BBT24    RES      0                                                     BBT240
         LI,V0    CBAL+CIND         LOAD OP CODE - BAL,L1 *             BBT242
         LAB,L1   PRE01,BAA02       WRITE BAL,L1 *XNO                   BBT242
*                                                                       BBT26
         TITLE    'PHASE 4.2 - TRACE'
BCT00    RES      0
         CI,R6    X'1E'             CHECK OPTION
         BL       BCT10             TRACE
* READY/RESET
         AI,R6    XTRC-X'1D'        SET C:TRC/C:TRX INDEX
         LBAL,L0  OIX02,CLI+CRL1    WRITE LI,L1 C:TRC/C:TRX
         LAB,V0   BCT14,CSTW+CRL1   LOAD STW,L1
*
* TRACE
*                        D1 = TRACE NAME NO.
BCT10    RES      0
         LW,D3    D1                LOAD,SET TRACE NAME BASE,DISPC
         AW,D3    K4BAS
         BAL,L1   PID16             WRITE
         LI,R6    2                 ****  LI,R6 WA(TRACE NAME NO.)
         LI,V0    CBAL+CIND         LOAD BAL,L1  *-
*                        V0 = OP CODE
BCT14    RES      0
         LW,D1    JTRC              LOAD,CHECK TRACE FLAG                2
         BGEZ     BCT20             UP. TRACE EXTAB GENERATED.           3
* GENERATE TRACE EXTAB ENTRY                                             4
         BAL,L1   PDX06             WRITE                                5
         TEXT     ':TRX'            ****  ADCON C:TRX                    6
         STW,D1   JTRC              RAISE TRACE FLAG                     7
*                        V0 = OP CODE                                    8
*                        D1 = TRACE EXTAB                                9
BCT20    RES      0                                                     10
         LAB,L1   PRA01,BAA02       WRITE B *XTRC/STW,L1 XTRC           11
         TITLE    'PHASE 4.2 - CORRESPONDING'
BCF00    RES      0
         CI,R6    X'4000'           CHECK OPTION
         BANZ     BCF30             TRAILER FLAG UP                      2
         CI,R6    X'2000'           CHECK GRP B FLAG                     3
         BANZ     BCF10             UP. GRP B                            4
* GRP A                                                                 10
         MTW,1    LCORF+1
         CI,R6    X'100'            CHECK GRP A SUBSCRIPT FLAG          20
         BAZ      BCF04             DOWN, GRP A NOT SUBSCRIPTED         21
* GRP A SUBSCRIPTED                                                     30
         RMCF     R5                READ GRP A CLUSTER                  31
         BAL,L1   SSS00             PROCESS SUBSCRIPTS
BCF04    RES      0                                                     40
         MTW,-1   JSSCX             SET CORRESPONDING SUBSCRIPT SWITCH  41
         LI,R1    0                 CLEAR CSXR SAVED FLAG               43
         STW,R1   JCSXR                                                 44
         B        BAA02             RETURN                              45
* GRP B                                                                 59
BCF10    RES      0                                                     60
         MTW,1    LCORF+1
         CI,R6    X'200'            CHECK GRP B SUBSCRIPT FLAG          61
         BAZ      BCF12
* GRP B SUBSCRIPTED                                                     69
         RMCF     R5                READ GRP B CLUSTER                  71
         MTW,1    JSSCX             RESET CORRESPONDING SUBSCRIPT SWITCH70
         MTW,1    JSXR              SXR = SXR+1(=R3)
         BAL,L1   SSS00             PROCESS SUBSCRIPTS
         MTW,-1   JSSCX             SET CORRESPONDING SUBSCRIPT SWITCH  73
         LI,R1    X'FF00'           LOWER GRP B SXR SAVED FLAG
         AND,R1   JCSXR
         STW,R1   JCSXR
BCF12    MTW,-3   LCORF+1
         B        BAA02             RETURN                              74
* TRAILER - E-O-CORRESPONDING                                           90
BCF30    RES      0                                                     91
         MTW,1    JSSCX             RESET CORRESPONDING SUBSCRIPT SWITCH98
         LW,R1    ZCORF
         MBS,0    BA(LCORF)
         LI,R1     0                                                    COBOL42B
         STW,R1    JCSXR           RESET CSXR FLAG                      COBOL42B
         B        BAA02             RETURN                              99
LCORF    DATA     0                 LINKAGE SECTION FLAG
         DATA     0
         DATA     0
         DATA     0
ZCORF    GEN,8,24 11,BA(LCORF)+1
*
         REF      KBKON,K4BAS,K6BAS
         REF      JSXR,JSSCX,JSXSX,JCSXR,JDECP
JTRC     EQU      JDECP+15          TRACE FLAG
         END
