         SYSTEM   SIG7FDP
         TITLE    'PHASE 4.0'
*
* PHASE 4.0 DEFINITIONS
*
         DEF      COB40,PH41E,PH42E
         DEF      GADNO             ADCON NO.
         DEF      GTMP              TEMP STG
         DEF      GMSG              MAX. ACCEPT/STOP LITERAL MSG LNG
         DEF      ALTGB,ALTGC,ALTGP
* PHASE 4.0 REFERENCES
*
         REF      COBIOOOF,COBIOOIF
         REF      COBIOCOF,COBIOCIF
         REF      COBIODB
         REF      COB41
         REF      COB42
         REF      PH4E
         REF      PH5E
         REF      M:OC
         REF      PDBCC
         REF      PDBP
         REF      TYPE
         DEF      LNKR7
         DEF      LNKTB,LNKSZ,LNKCT
         REF      PDBDBG                                                COBOL40
         REF      DBSIZE                                                COBOL40
         REF      PDBU                                                  COBOL40
         PAGE
*
* PHASE 4.0 EQUATES
*
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
* PHASE 4.0 ENTRY
*
COB40    RES      0
         LI,R4    MESS40
         BAL,R11  TYPE
         CAL1,8   PLIST2            M:SEGLD PHASE 4.1
         REF      DIAG
         DEF      TBL%INDX,DECL%TBL                                     COBOL40
         LW,R2    PDBZ              SET DECLARATIVE TABLE ADDRESS       COBOL40
         STW,R2   DECL%TBL           TO FIRST WORD OF DYNAMIC MEMORY    COBOL40
         AI,R2    256               IF TABLE OVERLAPS                   COBOL40
         CW,R2    PDBZ+3             OTHER TABLES                       COBOL40
         BL       C40                                                   COBOL40
         LI,R1    520               COMPILER ERROR  X'14'               COBOL40
         BAL,R11  DIAG               ISSUED                             COBOL40
C40      RES      0                                                     COBOL40
         LI,R2    BA(ECFBUF)
         LI,R4    1
         LI,R5    1
         BAL,R11  COBIOOIF          OPEN ECF TO INPUT (CLUSTERED)
         LI,R2    BA(CRFBUF)
         LI,R4    -1
         LW,R5    PDBDBG            SEE IF  DEBUGGING                   COBOL40
         BEZ      C41               NOT DEBUGGING                       COBOL40
         AI,R5    53                CHANGE PDBDBG TO POINT  AT          COBOL40
         STW,R5   PDBDBG              DEBUG-CONTENTS, FOR 41P           COBOL40
         LI,R4    1                 OPEN CRF  FORWARD                   COBOL40
         LW,R5    DBSIZE            ACTUAL SIZE OF DEBUG-CONTENTS       COBOL40
         AI,R5    -132              ADJUST SIZE                         COBOL40
         LW,R6    PDBU                                                  COBOL40
         AND,R6   =X'FFFF'                                              COBOL40
         AW,R6    R5                NEW DBSIZE + COMMON-ST SIZE         COBOL40
         STH,R6   PDBU,R4           UPDATE BASE 9 SIZE FOR COBOL51      36KO3U
C41      RES      0                                                     COBOL40
         LI,R5    2
         BAL,R11  COBIOOIF          OPEN CRF TO INPUT (CLUSTERED,REV)
         LI,R2    BA(RGFBUF)
         LI,R4    1
         LI,R5    0
         BAL,R11  COBIOOIF          OPEN RGF TO INPUT (CLUSTERED)
         LI,R2    BA(MCFBUF)
         LI,R5    3
         BAL,R11  COBIOOOF          OPEN MCF TO OUTPUT (CLUSTERED)
         LI,R2    9
         LI,R3    3
         LW,R4    L(C'MCF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    X'10'
         STB,R2   PDBCC
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS41
         BAL,R11  TYPE
         B        COB41
         PAGE
*
* RETURN FROM PHASE 4.1
*
PH41E    RES      0
         CAL1,8   PLIST3            M:SEGLD PHASE 4.2
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE ECF
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE CRF
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE RGF
         LW,R5    PDBP
         CI,R5    X'4000'           ABORT FLAG
         BANZ     PH42E
         LI,R2    1                 SET TO SAVE
         LI,R5    3
         BAL,R11  COBIOCOF          CLOSE MCF
         LI,R2    BA(MCFBUF)
         LI,R4    1
         LI,R5    3
         BAL,R11  COBIOOIF          OPEN MCF TO INPUT (CLUSTERED)
         LI,R2    X'11'
         STB,R2   PDBCC
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS42
         BAL,R11  TYPE
         REF      KABA                                                  COBOL40A
         LI,R2    2                                                     COBOL40A
         AND,R2   PDBCC                                                 COBOL40A
         BAZ      COB42                                                 COBOL40A
         LB,R5    X'7F'                                                 COBOL40A
         STB,R5   KABA-1,R2                                             COBOL40A
         B        COB42                                                 COBOL40A
TBL%INDX DATA     27
DECL%TBL DATA      0
         REF       PDBZ
         B        COB42
         PAGE
*
* RETURN FROM PHASE 4.2
*
PH42E    RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    3
         BAL,R11  COBIOCIF          CLOSE MCF
         LW,R5    PDBP
         CI,R5    X'4000'           ABORT FLAG
         BANZ     PH5E
         B        PH4E              RETURN TO PHASE 0
         PAGE
*
* PHASE 4.0 PLISTS
*
*
MESS40   TEXTC    'COBOL40  
'
MESS41   TEXTC    'COBOL41  
'
MESS42   TEXTC    'COBOL42  
'
PLIST2   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH41
PLIST3   GEN,8,24 X'01',ECB         M:SEGLD
         DATA     PH42
PH41     TEXTC    'COBOL41A'
PH42     TEXTC    'COBOL42A'
         BOUND    8                                                     ABC100
GTMP     DATA     0                 NO. OF TEMP STORAGE BYTES
         DATA     X'0621'           ADCON CLNG,CNTL - SET FOR FILE CNTL
GADNO    DATA     -4                ADCON NO. - 1ST USE= 0              AA501
         DATA     X'200',0,0        ADCON VALUE - SET FOR FILE CNTL
GMSG     DATA     0                 MAX. ACCEPT/STOP LITERAL MSG LNG
ECB      DATA     0
ALTGC    DATA     0                 ALTERED BUFFER TABLE
ALTGP    RES      25
ALTGB    RES      50
LNKCT    DATA     0                 LNKTB COUNT
LNKTB    RES      100               LINKAGE DISP TABLE
LNKSZ    RES      50                SIZE OF ENTRY
LNKR7    RES      1                 LINKAGE PARAM ADDR
* PHASE 4 I/O BUFFERS
*
ECFBUF   RES      75
CRFBUF   RES      75
MCFBUF   RES      75
RGFBUF   EQU      CRFBUF
         END
