         SYSTEM   SIG7FDP
         TITLE    'SIGMA 7 COBOL PHASE 1.0'
         PAGE
*
* PHASE 1.0 REFERENCES
*
         REF      COBIODB
         REF      COBIOOOF,COBIOOIF
         REF      COBIOCOF,COBIOCIF
         REF      PDB,PDBCC,PDBA,PDBB,PDBC,PDBF,PDBP
         REF      PH1E,PH5E
         REF      READCARD,NDCARD
         REF      SADNO
         REF      COB11
         REF      COB12
         REF      COB13
         REF      COB14
         REF      COB15
         REF      COLAFLG
         REF      TYPE
         REF      DIVON             COBOL DIVISION INDICATOR
         REF      CPBUF,PDBZ
*
* PHASE 1.0 DEFINITIONS
*
         DEF      PH12EA            RETURN IF ABORT IN SCAN 1.1.        COBOL10
         DEF      COB10,PH15E
         DEF      PHASE1,PHASEF
         DEF      RDIVON            ROUTINE TO SET COBOL DIVISION INDICA 3`
         DEF      MNTBL
         DEF      PH4FL,CBBA
         PAGE
*
* REGISTER 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
*
* COB10
*    DRIVES PHASES 1.1,1.2,1.3,1.4,1.5
*    RETURNS TO PH1E,PH5E
*
COB10    RES      0
         LI,14    X'01'             DENOTE CURRENT PHASE
         STB,14   PDBCC               IN PDB - 1.0
         LI,R4    MESS1
         BAL,R11  TYPE
         CAL1,8   PLIST2            M:SEGLD PHASE 1.1
         LI,R2    BA(EDFBUF)
         LI,R5    1
         BAL,R11  COBIOOOF          OPEN EDF TO OUTPUT (CLUSTERED)
         LI,R2    2
         LI,R3    1
         LW,R4    L(C'EDF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    BA(EPFBUF)
         LCW,R2   R2
         LI,R5    0
         BAL,R11  COBIOOOF          OPEN EPF TO OUTPUT(CLUSTRED,NON-SEQ)
         LI,R2    1
         LI,R3    0
         LW,R4    L(C'EPF ')
         BAL,R11  COBIODB           PRINT CONTROL
         BAL,10   READCARD          INITIALIZE
         BAL,10   NDCARD              SCAN
         LI,R15   0
         STW,R15  COLAFLG
         LW,15    ECB
         BLZ      %-1
         LI,14    X'02'             DENOTE CURRENT PHASE
         STB,14   PDBCC               IN PDB - 1.1
         LI,R4    MESS2
         BAL,R11  TYPE
         B        COB11
         PAGE
*
* RETURN FROM PHASE 1.1
*
PH11E    RES      0
         LW,15    PHASEF            PASS INDICATOR - IF NEGATIVE EOF HAS
         BLZ      PH12EA              OCCURRED - ABORT COMPILATION
         CI,15    3
         BE       PH11EA            'PROCEDURE'
         CAL1,8   PLIST3            M:SEGLD PHASE 1.2
         LI,R2    BA(IVFBUF)
         LI,R5    2
         BAL,R11  COBIOOOF          OPEN IVF TO OUTPUT(CLUSTERED)
         LI,R2    7
         LI,R3    2
         LW,R4    L('IVF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R2    0
         LI,R5    5
         BAL,R11  COBIOOOF          OPEN RFF TO OUTPUT(NONCLUSTERED)
         LI,R2    13
         LI,R3    5
         LW,R4    L('RFF ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R11   X'2000'
         STH,R11  DIVON                                                 COBOL10
         LW,15    ECB
         BLZ      %-1
         LI,14    X'03'             DENOTE CURRENT PHASE
         STB,14   PDBCC               IN PDB - 1.2
         LI,R4    MESS3
         BAL,R11  TYPE
         B        COB12
         PAGE
*
* RETURN FROM PHASE 1.2
*
PH12E    RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE RFF
         LW,15    PHASEF
         BLZ      PH13EA
         CI,15    3
         BE       PH13EB            1.2 TERMINATED ON 'PROCEDURE'
         CAL1,8   PLIST4            M:SEGLD PHASE 1.3
         LW,15    ECB
         BLZ      %-1
         LI,14    X'04'             DENOTE CURRENT PHASE
         STB,14   PDBCC               IN PDB - 1.3
         LI,R4    MESS4
         BAL,R11  TYPE
         B        COB13
         PAGE
*
* RETURN FROM PHASE 1.3
*
PH13E    RES      0
         LW,15    PHASEF
         BLZ      PH13EA            NO PROCEDURE DIVISION
         B        PH13EB
         PAGE
*
* RETURN FROM PHASE 1.4
*
PH14E    RES      0
         LI,R2    1                 SET TO SAVE
         LI,R5    7
         BAL,R11  COBIOCOF          CLOSE SPF
         LW,15    PHASEF            ABORT FLAG                          COBOL10
         BLZ      PH15E0            YES
         LI,R2    1                 SET TO SAVE
         LI,R5    0
         BAL,R11  COBIOCOF          CLOSE EPF
         LW,R2    CPBUF
         STW,R2   PDBZ+5            RESET PDBZ+5
         LI,R1    1
         LI,R2    0
         STB,R2   PDBCC,R1          INIT PASS COUNTER
         LI,R2    X'C00'
         AND,R2   PDBP
         STW,R2   PDBPTMP           SAVE EDF/EPF INDICATOR
         BEZ      PH15E1            SKIP PHASE 1.5
         CAL1,8   PLIST6            M:SEGLD PHASE 1.5
PH14E1   LI,R2    X'C00'
         AND,R2   PDBP              THRU PROSESSING EDF,EPF
         BEZ      PH15E1            YES GOTO END 1.5
         LH,R2    PDBCC
         AI,R2    1                 INCREMENT PASS COUNTER
         STH,R2   PDBCC
         LI,R2    X'800'
         AND,R2   PDBP              EDF RESOLVED
         BEZ      PH14E2            YES-GO CHECK-EPF
         LI,R2    BA(EDFBUF)
         LI,R4    1
         LI,R5    1
         BAL,R11  COBIOOIF          OPEN EDF TO INPUT (CLUSTERED)
         LI,R2    BA(EDFSBUF)
         LI,R5    4
         BAL,R11  COBIOOOF          OPEN EDFS TO OUTPUT (CLUSTERED)
         LI,R2    2
         LI,R3    4
         LW,R4    L(C'EDFS')
         BAL,R11  COBIODB           PRINT CONTROL
PH14E2   LI,R2    X'400'
         AND,R2   PDBP              EPF RESOLVED
         BEZ      PH14E3            YES-GOTO PHASE 1.5
         LI,R2    BA(EPFBUF)
         LI,R4    1
         LI,R5    0
         BAL,R11  COBIOOIF          OPEN EPF TO INPUT (CLUSTERED)
         LI,R2    BA(EPFSBUF)
         LCW,R2   R2
         LI,R5    3
         BAL,R11  COBIOOOF          OPEN EPFS TO OUTPUT (CLUSTERED,NS)
         LI,R2    1
         LI,R3    3
         LW,R4    L('EPFS')
         BAL,R11  COBIODB           PRINT CONTROL
PH14E3   RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE SPD
         LI,R2    BA(SPDBUF)
         LI,R3    5
         BAL,R11  COBIOOOF          OPEN SPD TO OUTPUT (NONCLUSTERED)
         LI,R2    14
         LI,R3    5
         LW,R4    L('SPD ')
         BAL,R11  COBIODB           PRINT CONTROL
         LI,R14   X'06'
         STB,14   PDBCC               IN PDB - 1.5
         LW,15    ECB
         BLZ      %-1
         LI,R4    MESS6
         BAL,R11  TYPE
         B        COB15
         PAGE
*
* RETURN FROM PHASE 1.5
*
PH15E    RES      0
         LI,R2    X'800'
         AND,R2   PDBPTMP           WAS EDF BEING PROCESSED
         BEZ      PH14E5            NO-GO CHECK EPF
         LI,R2    1                 SET TO SAVE
         LI,R5    4
         BAL,R11  COBIOCOF          CLOSE EDFS
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE EDF
         LW,R2    PDBA+1
         XW,R2    PDBA+4            SWAP EDF/EDFS DCB'S
         STW,R2   PDBA+1
         LI,R2    X'800'
         AND,R2   PDBP              EDF RESOLVED THIS PASS
         BNEZ     PH14E5            NO-GO CHECK EPF
         LI,R2    X'400'
         AND,R2   PDBPTMP
         STW,R2   PDBPTMP           RESET EDF
PH14E5   LI,R2    X'400'
         AND,R2   PDBPTMP           WAS EPF BEING PROCESSED
         BEZ      PH14E1            NO-GO CHECK FOR COMPLETITION
         LI,R2    1                 SET TO SAVE
         LI,R5    3
         BAL,R11  COBIOCOF          CLOSE EPFS
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE EPF
         LW,R2    PDBA+0
         XW,R2    PDBA+3            SWAP EPF/EPFS DCB'S
         STW,R2   PDBA+0
         LI,R2    X'400'
         AND,R2   PDBP              EPF RESOLVED THIS PASS
         BNEZ     PH14E1            NO-GO CHECK FOR COMPLETION
         LI,R2    X'800'
         AND,R2   PDBPTMP
         STW,R2   PDBPTMP           RESET EPF
         B        PH14E1            GO CHECK FOR COMPLETITION
PH15E1   RES      0
         LW,R5    PDBP
         CI,R5    X'4000'
         BAZ      PH15E2            ABORT FLAG
PH15E0   RES      0                                                     COBOL10
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCIF          CLOSE EPF
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCIF          CLOSE EDF
         LI,R2    -1                SET TO RELEASE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE SPD
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE IVF
         B        PH5E
PH15E2   LI,R2    1                 SET TO SAVE
         LI,R5    5
         BAL,R11  COBIOCOF          CLOSE SPD
         B        PH1E              CONTINUE WITH COMPILATION
         PAGE
*
* RETURN FROM SYNTAX TABLE DRIVER
*
PHASE1   RES      0                 RETURN POINT FROM SYNTAX TABLE DRIVE
         LB,15    PDBCC
         CI,15    X'03'
         BL       PH11E             END OF 1.1
         BE       PH12E             END OF 1.2
         CI,15    X'05'
         BL       PH13E             END OF 1.3
         BE       PH14E             END OF 1.4
         PAGE
*
* LOAD PHASE 1.4
*
PH11EA   RES      0
         LI,R2    X'4000'
         OR,R2    PDBP
         STW,R2   PDBP
PH13EC   RES      0
         CAL1,8   PLIST5            M:SEGLD PHASE 1.4
         LI,R2    0                 SET TO SAVE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE EDF
         LI,R2    BA(SPDBUF)
         LI,R5    5
         BAL,R11  COBIOOOF          OPEN SPD TO OUTPUT(CLUSTERED)
         LI,R2    14
         LI,R3    5
         LW,R4    L('SPD ')
         BAL,R11  COBIODB           PRINT CONTROL
         BAL,R11  SDIVON
         LW,15    ECB
         BLZ      %-1
         LI,14    X'05'             DENOTE CURRENT PHASE
         STB,14   PDBCC               IN PDB - 1.4
         STW,14   PH4FL
         LI,R4    MESS5
         BAL,R11  TYPE
         B        COB14
PH13EB   RES      0
         LI,R2    1                 SET TO SAVE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE IVF
         B        PH13EC
         PAGE
*
* PHASE 1.2 ABORT
*
PH12EA   RES      0
         LI,R2    1                 SET
         LI,R5    7
         BAL,R11  COBIOCOF          CLOSE SPF
         LI,R2    -1                SET TO RELEASE
         LI,R5    1
         BAL,R11  COBIOCOF          CLOSE EDF
         LI,R2    -1                SET TO RELEASE
         LI,R5    0
         BAL,R11  COBIOCOF          CLOSE EPF
         LI,R2    X'4000'
         OR,R2    PDBP              SET ABORT FLAG
         STW,R2   PDBP
         B        PH5E              RETUTN TO PHASE 0
*
* PHASE 1.3 ABORT
*
PH13EA   RES      0
         LI,R2    -1                SET TO RELEASE
         LI,R5    2
         BAL,R11  COBIOCOF          CLOSE IVF
         B        PH12EA
RDIVON   RES      0                 ROUTINE TO SET COBOL DIVISION INDICA
         LI,11    SADNO
SDIVON   RES      0
         LW,15    DIVON
         SLS,15   -1
         STW,15   DIVON
         B        *11               RETURN
         PAGE
*
* COB10 PLISTS
*
         REF      M:OC
PLIST2   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH11
PLIST3   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH12
PLIST4   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH13
PLIST5   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH14
PLIST6   DATA,1   X'01'
         DATA,3   ECB
         DATA     PH15
PH11     TEXTC    'COBOL11'
PH12     TEXTC    'COBOL12'
PH13     TEXTC    'COBOL13'
PH14     TEXTC    'COBOL14'
PH15     TEXTC    'COBOL15'
MESS1    TEXTC    'COBOL10
'
MESS2    TEXTC    'COBOL11
'
MESS3    TEXTC    'COBOL12
'
MESS4    TEXTC    'COBOL13
'
MESS5    TEXTC    'COBOL14
'
MESS6    TEXTC    'COBOL15
'
         PAGE
*
* COB10 INDICATORS
*
ECB      DATA     0
PHASEF   DATA     0                 PHASE 1 PASS INDICATOR
PDBPTMP  DATA     0                 EDFS/EPFS INDICATOR
PH4FL    DATA     0                 PHASE14 FLAG
CBBA     DATA     0                 COPY REPLACING BUFFER ADDR
MNTBL    DATA     0                 MNEMONIC NAME TABLE
         RES      20
*
* COB10 I/O BUFFERS
*
EPFBUF   RES      105
EDFBUF   RES      75
         REF      EPFSBUF
         REF      EDFSBUF
IVFBUF   RES      75
SPDBUF   RES      75
         END
