*DECK     BATCH 
          IDENT  BATCH
 BATCH    SECT   (MAIN BATCH CONTROL.),1
  
          SST    A,C
          NOREF  A,C
  
 B=BATCH  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  RUN5,RUN.X 
  
*         IN FTN
          EXT     CP.CARD,CP.LSTF,CP.PAGE,CP.PD,LCP.PS,FV.LGO,F.LF
          EXT     F.LGO,PDFLAG
          EXT    F.OUT,F.RMAP,F.SB,F.TABS,O.STITL,TIME1,W.TABS
          EXT    RS.PD
  
*         IN TABLES 
          EXT    BASES,BINOUT,CARDS,DOORD,DRITE,ETF,ERRORS
          EXT    FLOW,FAILSFT,HANGER,IDENT,ICV,IGS,LCNT,LOSTREF 
          EXT    L=TABLE,MAXCORE,MOD,MSF,NARGS,NOPATH,NSK 
          EXT    NTRCNT,N.TABLE,PARCEL,RATES,REFIO,TEM.MAX
          EXT    RJTDUM,RTNCNT,SIZES,STAGE,SYSERR,TG.BASE 
          EXT    TG.END,TP.DIM,TS.BLK,TS.STN,TS.SYM,T.END,WNZ 
  
*         IN ERRORS 
          EXT    ERR=F
  
*         IN ALLOC
          EXT    PRS
  
*         IN MAIN 
          EXT    CPM,CPM=1ST
  
*         IN LEX
          EXT    NAT.TYP
  
*         IN REG
          EXT    CAR
  
*         IN PAR
          EXT    CURST
  
*         IN INIT 
          EXT    EQUA,FCA,FTO,OSTACK,ESTACK 
  
  
**        FTN10 - (1,0) OVERLAY ENTRY 
* 
*         BASED UPON WHAT HAS  GONE BEFORE
* 
*         EXITS TO *FCA* - IF RETURN FROM COMPASS ASSEMBLY
*               TO *RUN.X* - IF INITIAL (OR SUBSEQUENT) FORTRAN 
*               TO *ENDRUN* - IF NO MORE SOURCE INPUT 
*               TO *ABORT* - IF SOURCE INPUT NULL 
* 
*         ENTRY (B2) = 0 - UPON RETURN FROM COMPASS 
*                      1 - OTHERWISE
  
  
*         IF (BREAK=10) WAS SELECTED, ENTRY TO OVERLAY(1,0) WILL BE TO
*         *FTN10-1* TO CALL THE COMPILE-TIME INTERACTIVE DEBUG PACKAGE. 
  
 FTN10    BREAK 
  
          ENTRY  FTN10
 FTN10    BSS    0           ** LOADER ENTRY POINT ** 
          SA1    CP.CARD
          SA2    =XCOMRET 
          PL     X2,FTN10A   IF FIRST TIME THROUGH
          NZ     X1,FCA      IF FTN AFTER COMPASS IDENT 
          EQ     RUN.X       TERMINATE IF COMPASS DETECTED EOR
  
 FTN10A   RJ     FTO         (1,0) INITIALIZATION 
  
          RJ     =XTIMER
          SA6    =XTIME1
          RJ     =XRNC       READ FIRST CARD
          ZR     X1,RUN.X    IF NO END-OF-SECTION 
  
          SA1    =XCER.FL 
          SX6    1
          SA6    A1 
          MESAGE (=C= EMPTY INPUT FILE.  NO COMPILATION.=),,RCL 
          EQ     RUN7        CLOSE FILES
 RUN1     SPACE  4,15 
**        RUN1A - MAIN BATCH CONTROL. 
* 
*         DECIDES WHETHER TO TERMINATE COMPILATION, PASS CONTROL TO 
*         *COMPASS*, OR BEGIN ANOTHER PROGRAM-UNIT. 
* 
*         EXITS  TO *EOC* - IF END OF BATCH.
*                TO *BCA* - IF INTERMIXED ASSEMBLY. 
*                TO *CPM* - IF MORE FORTRAN TO COMPILE. 
* 
*         CALLS  IST, RECALL
  
  
 RUN1A    SA2    FV.LGO 
          ZR     X2,RUN1B          IF BINARY SUPPRESSED 
  
 #RM      IFEQ   CP#RM,0
          RECALL F.LGO
 #RM      ENDIF 
  
          SA1    =XBINIO
          BX6    0
          PL     X1,RUN1B    IF LF NOT SPILLED TO DISK
          SA6    A1 
          REWIND F.LF 
          CLOSE  F.LF,UNLOAD
 RUN1B    SA1    =XLOP=R
          PL     X1,RUN1C    IF REF NOT SELECTED
          SA2    REFIO
          PL     X2,RUN1C    IF REF NOT SPILLED TO DISK 
          MX6    0
          SA6    A2 
          CLOSE  F.RMAP,UNLOAD
 RUN1C    RJ     IST         INITIALIZE SUBPROGRAM TABLES 
          SA1    =XT.SB 
          SA0    X1 
 RUN1D    SA2    =XL.CARD     NUMBER OF WORDS IN LINE IMAGE 
          SA5    =XCP.CARD
          MX6    0
          SX7    "SB.FWA"-1 
          SA6    =XCCNT      CLEAR CONTINUATION COUNT 
          BX2    -X2
          SA7    =XLASTCOL   PRESTORE IN CASE OF C/-LIST
          =B6    X2+1        - NUMBER OF USABLE WORDS LESS TERMINATOR 
          RJ     =XRNS       READ NEXT STATEMENT
          ZR     X5,=XAFS.ME IF END OF SECTION
          RJ     =XPLO       PROCESS C/-LIST OPTIONS
          ZR     X5,=XAFS.ME IF END OF SECTION
          SA5    =1H
          SA2    CP.CARD
          MX0    6*CHAR 
          SA3    A2+B1
          SA4    =6LIDENT 
          IX1    X2-X5
          NZ     X1,CPM      IF COLS 1-10 .NE. BLANKS, ENTER MASTER LOOP
          BX6    X0*X3
          IX4    X4-X6
          ZR     X4,RUN1F    IF COLS. 11-16 .EQ. IDENT, LOAD COMPASS
          SB3    6
 RUN1E    SA2    A2+1        CHECK NEXT 10 COLUMNS
          IX1    X2-X5
          NZ     X1,CPM      IF NOT BLANK LINE, ENTER MASTER LOOP 
          SB3    B3-B1
          GT     B3,RUN1E 
          SA2    A2+1 
          MX0    2*CHAR 
          SA4    =2L
          BX6    X0*X2
          IX4    X4-X6       CHECK COLS. 71 AND 72
          NZ     X4,CPM      IF NOT BLANK LINE, ENTER MASTER LOOP 
          RJ     =XPLR       PROCESS LISTING REQUEST
          RJ     =XRNC       READ NEXT CARD 
          EQ     RUN1D
 RUN1F    RJ     =XLDB       LIST DEFERRED BUFFER(IF ANY) 
          WRITER =XF.OUT,RCL
          EQ     =XLDCOM     LOAD COMPASS (1,0) 
  
  
**        RUN.X -  EXIT FROM PROGRAM-UNIT COMPILATION.
* 
*         ENTRY  PREVIOUS COMPILATION COMPLETE OR ABANDONED.
  
 RUN.X    SA4    LCP.PS 
          SA1    =1H- 
          SA2    =XCP.LSTF
          SA3    =XCP.PAGE
          SA5    =XCP.PAGE
          SX7    X4+B1
          BX6    X1 
          SA7    LCNT        SET EMPTY PAGE 
          NZ     X2,RUN3     IF NOT *L=0* 
          SA6    =XTL.JECT   SET TITLE TO TRIPLE SPACE, NOT EJECT 
 RUN3     SA1    =XCP.BLF 
          BX2    X2*X3       EXTRACT EVEN/ODD PAGE COUNT IF LISTING ON
          BX1    X1*X2
          IX6    X3+X1
          PL     X3,RUN4     IF PROPAGATING PAGE COUNT
          MX6    1
          MX6    2
 RUN3A    BX6    X3*X6
 RUN4     SA6    A3          UPDATE/RESET PAGE COUNT
          ZR     X1,RUN5     IF (EVEN PAGE COUNT) OR (SHORT/NO LIST)
          WRITEC =XF.OUT,(=2L1 ),1       MAINTAIN PAGE PARITY 
 RUN5     SA2    CP.CARD
          NZ     X2,RUN1A    IF NO END-OF-SECTION ON INPUT
  
**        TERMINATE AND CLOSE FILES 
* 
          SA2    =XCP.LSTF
          ZR     X2,RUN5A    IF L = 0, DONOT OUTPUT PD
          SA2    CP.PD
          ZR     X2,RUN5A    IF TTY FILE
          SA3    RS.PD
          BX6    X2-X3
          ZR     X6,RUN5A    IF USING JOB DEFAULT 
          BX6    X3 
          SA6    =XGT1
          WRITEC F.OUT,GT1,1 RESET DENSITY
 RUN5A    BSS    0
#RM       IFEQ   CP#RM,0
          SA1    F.OUT
          SB2    X1 
          EQ     B1,B2,RUN5B IF FILE NOT ACTED UPON 
          SB3    34 
          LE     B2,B3,RUN5C IF NOT AN OPEN OR CLOSE
 RUN5B    SA1    A1+2        GET IN POINTER 
          SA2    A1+B1       GET OUT POINTER
          SB2    X1 
          SB3    X2 
          EQ     B2,B3,RUN5D IF BUFFER EMPTY
#RM       ELSE
          FETCH  F.OUT,LOP,X5 
          SB3    X5 
          LE     B3,B1,RUN5D IF FILE NOT WRITTEN ON 
#RM       ENDIF 
 RUN5C    WRITER F.OUT
 RUN5D    SA2    =XFV.LGO 
          ZR     X2,RUN6     IF BINARY OUTPUT SUPPRESSED (B=0)
          WRITEF F.LGO
          BKSP   F.LGO
  
*         EVICT SCRATCH FILES 
  
 .T       IFEQ   TEST,0 
          SA1    =XBINIO
          PL     X1,RUN6     IF BINARY OUTPUT FILE NOT USED 
          CLOSE  F.LF,UNLOAD
 .T       ENDIF 
  
 RUN6     BSS    0
  
 .T       IFEQ   TEST,0 
          SA2    =XREFIO
          PL     X2,RUN7     IF REF FILE NOT USED 
          CLOSE  F.RMAP,UNLOAD
 .T       ENDIF 
  
*         CLOSE ALL FILES.
  
 RUN7     BSS    0
 #RM      IFGE   CP#RM,6
          SX6    =XFVLEN-1   (X6) = FILE VECTOR TABLE OFFSET
 RUN7A    SA2    RA.ARG+X6   (X2) = FIT ADDRESS FROM FILE VECTOR TABLE
          SA6    =XGT1       TEMP STORE OFFSET
          ZR     X2,RUN7B    IF FILE DESELECTED 
          RJ     FA=CLO 
 RUN7B    SA1    =XGT1
          SX6    X1-1        (X6) = OFFSET FOR NEXT FILE
          PL     X6,RUN7A    IF MORE FILES TO CLOSE 
 #RM      ENDIF 
  
**        SEND FL USED TO DAYFILE.
* 
          PIA    =XCP.MXFL,=XLFS.MAX
          SX6    0
          SA6    =XLFS.MAX+3
          MESSAGE  =XLFS.MAX,,RECALL
  
**        TURN OFF -SPY-
* 
 .T       IFNE   TEST,0 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          RJ     =XOFFSPY 
 #OS      ENDIF 
 .T       ENDIF 
  
**        WAIT FOR FILE ACTION TO COMPLETE. 
* 
 #RM      IFEQ   CP#RM,0
          SB2    RA.ARG 
          SB3    RA.ARG+=XFVLEN 
 RUN8     SA5    B2          (X5)=FILE VECTOR ENTRY 
          SB2    B2+B1
          ZR     X5,RUN9     IF FILE DESELECTED 
          SX2    X5          (X2)=ADDRESS OF FET
          RECALL X2 
 RUN9     LT     B2,B3,RUN8  IF MORE FILES TO CHECK 
 #RM      ENDIF 
  
          EQ     =XENDFTN    TERMINATE *FTN*
 IST      SPACE  4,8
**        IST -  INITIALIZE SUBPROGRAM TABLES.
* 
*         PERFORMS INITIALIZATION FOR EACH PROGRAM-UNIT OF THE BATCH. 
* 
*         EXIT   ALL APPROPRIATE CELLS, COUNTERS AND TABLES HAVE BEEN 
*                SET TO THEIR INITIAL VALUES. 
  
  
 IST      SUBR   0
  
**        COLLAPSE TABLES TO INITIAL LENGTHS
  
          SA4    F.TABS 
          SA2    W.TABS 
          SB2    N.TABLE*FUDGE
          SB2    B2+L=TABLE 
          SB2    -B2
          SX5    X2+B2
          LX7    X2 
          SB2    N.TABLE-1
  
**        INITIALLY, AMOUNT OF AVAILABLE SPACE IS --
*         A = (SIZCORE) - N*FUDGE - L=TABLES
  
          PX2    X5          (X2) = AVAILABLE 
          IX7    X7+X4       (X7) = LWA TABLES
          NX1    X2 
          SA7    T.END
  
 IST2     SA3    B2+RATES 
          FX2    X3*X1
          SX6    X3 
          UX0,B7 X2 
          =B2    B2-1 
          =X3    X3+FUDGE    = INIT(I) + FUDGE
          LX2    X0,B7
          IX5    X2+X3
          IX7    X7-X5
          SA6    B2+SIZES+1        SET INITIAL SIZE 
          SA7    B2+BASES+1        SET INITIAL ORIGIN 
          PL     B2,IST2     LOOP THRU TABLES 
          BX7    X4 
          SA7    A7          RESET ORIGIN OF LOWEST TABLE (LONG FILE) 
  
  
**        RESET TAG BASES TO INITIAL VALUES 
  
          SX6    C.BASE 
          SB2    TG.END 
          SB2    -B2
          SB2    B2+TG.BASE 
          SX2    C.DIF
 IST4     SA6    B2+TG.END
          SB2    B2+B1
          IX6    X6+X2       INCREMENT TAG VALUE
          LE     B2,B0,IST4  IF MORE TAGS LEFT TO DO
          SX7    C.TEM
          SA7    TEM.MAX
  
**        CLEAR OUT BASIC SYMBOL, LABEL AND ADDRESS TABLES. 
  
          SA2    TS.SYM 
          BX1    0
          SX3    X2+LSYM
          RJ     PRS         CLEAR OUT BASE SYMBOL TABLE
  
          SA2    TS.STN 
          BX1    0
          SX3    X2+LSTN
          RJ     PRS         CLEAR OUT BASE LABEL TABLE 
  
          SA2    =XTA.NAM 
          BX1    0
          SX3    X2+LSYM/2
          RJ     PRS
  
**        PRESET DIM TABLE WITH A FAKE ENTRY WHICH SAYS --
*                (NUMBER OF DIMS ) = 1
*                (LENGTH OF ARRAY) = 1
  
          SA1    TP.DIM 
          =X6    1
          IFNE   P.NDIM+L.NDIM,60,1 
          ERR    *IST* -- CHANGE TP.DIM INITIALIZATION
 A        DECMIC L.NDIM 
          =X7    1+1S"A"
          LX6    P.DIM
          LX7    -L.NDIM
          SA6    X1+B1       FAKE UP  DIMENSIONALITY OF 1 
          IFNE   P.DIM,P.DIMLG,1
          LX6    -P.DIM+P.DIMLG 
          BX7    X6+X7
          SA7    X1          FAKE ENTRY, NR DIMS = 1
  
**        PRE-ENTER COMMON BLOCK TABLE WITH --
*                0.  PROGRAM RELOCATION BLOCK 
  
          SA1    TS.BLK 
          BX6    0
          SA6    X1          FAKE ENTRY IS PROGRAM REL. BLOCK 
          SA6    A6+B1
  
**        CLEAR OSTACK , ESTACK 
* 
          MX7    0
          SX6    B0 
          SA7    OSTACK 
          SA6    ESTACK 
          SB4    N.ELSTK-1
          ERRNZ  N.OPSTK-N.ELSTK
  
 IST5     SA6    A6+B1
          SA7    A7+B1
          SB4    B4-B1
          NZ     B4,IST5     IF NOT FINISHED CLEARING ESTACK,OSTACK 
  
  
**        CLEAR SUBPROGRAM CELLS. 
  
          BX6    0
          SX7    B0 
  
 A        SET    7
 C        SET    0
          SA6    =XTYPD      LETTERS SELECTED ON IMPLICIT STATEMENT 
  
          CLEAR  CURST       CURRENT START FOR SQUEEZE OF PARSED FILE 
          CLEAR  DRITE       DELAYED WRITE FLAG 
          CLEAR  EQUA        LOCAL EQUIVALENCE-LENGTH 
          CLEAR  ETF         EXPLICT TYPING OF FUNCTION HEADER
          CLEAR  FAILSFT     CATASTROPHE IN  TABLES 
          CLEAR  FLOW        DEAD CODE FLAG 
          CLEAR  HANGER      HANGING COMPILATION INDICATOR
          CLEAR  ICV         PRECEEDING *DO* INDICATOR
          CLEAR  IGS
          CLEAR  LOSTREF     REF COUNT
          CLEAR  MOD         SUBPROGRAM MODE
          IFNE   TEST,,1
          CLEAR  =XMOVES     NUMBER OF STORAGE MOVES
          CLEAR  MSF         MULTIPLE STATEMENT FLAG
          CLEAR  =XNADD      NEW CODE ADDRESS 
          CLEAR  NARGS       NR. OF ARGUMENTS 
          CLEAR  NOPATH      STATEMENT LABEL REQUIRED FLAG
          CLEAR  NSK         NULL STATEMENT COUNT 
          CLEAR  NTRCNT      COUNT OF *ENTRY* STATEMENTS
          IFNE   .FID,0,1 
          CLEAR  =XO=OTRA    LINE NUMBER OF PREVIOUS OTR
          CLEAR  =XPASS 
          IFNE   .FID,0,2 
          CLEAR  =XPIGLAB    STATEMENT LABEL CORRESPONDING TO PIGLINE 
          CLEAR  =XPIGLINE   LINE NUMBER FOR LINE NUMBER TABLE
          CLEAR  RJTDUM      DUMMY *RJT* REQUIRED FLAG
          CLEAR  RTNCNT      COUNT OF *RETURN* STATEMENTS 
          CLEAR  SYSERR      COMPILER GOOF FLAG 
          CLEAR  WNZ         LAST WRITE INSTRUCTION 
          CLEAR  DOORD       ORDINAL OF DO STATEMENT NUMBER 
          CLEAR  =XTYPF      = 0 , NO IMPLICIT STM PROCESSED
*                            = 1 , ONE IMPLICIT STM PROCESSED 
          CLEAR  =XBLNKCOM   BLOCK NUMBER OF BLANK COMMON 
          CLEAR  =XSTATIC    STATIC LOADED I/O ROUTINES 
          IFEQ   OT#RM,6,1
          CLEAR  =XDFTA      STATIC WEAK EXTERNAL TEMP. 
  
**        SET UP MISCELLEANEOUS CELLS.
  
          MX7    1
          SA7    =XNOLIST    SET TO *LIST,ALL* DEFAULT
          =X7    CPM=1ST
          SA7    STAGE       SIGNAL THAT A *FIRST CARD* IS NEEDED.
          SX7    3
          SA7    PARCEL 
          SA2    =1H
          LX7    X2 
          SX5    B1 
          SX6    =XHDRBL
          LX5    30 
          BX6    X6+X5
          SA6    =XO.STITL
          SA7    =XTL.PTYP   BLANK OUT PROGRAM TYPE 
          SA2    =XCO.MODE
          SA7    A7+B1
          NZ     X2,IST60    IF SEQ MODE
          SA1    =XLDRFLG 
          MX6    0
          SA6    A1 
          NZ     X1,IST60    IF LAST STMT WAS A LOADER DIRECTIVE
          SX6    B1 
          SA6    CARDS       SET TO *1ST LINE IS IN (CP.BUF)* 
          SA2    =10H        1
          BX6    X2 
          SA6    =XCP.FLIN   NUMBER FIRST LINE OF SOURCE
  
 IST60    BX6    -0 
          SA2    FV.LGO 
          SA6    ERR=F
          SA6    ERRORS 
          NZ     X2,IST65    IF BINARY NOT SUPPRESSED 
          SA2    =XLOP=O
          BX6    X2 
 IST65    SA6    BINOUT 
          SA2    =XWININIT
          BX6    X2 
          SA6    =XWIN       BLOCK OFF WIN IF -B=0- AND NO -OL- 
  
          RJ     CAR         CLEAR ALL REGISTERS
  
**        RE-SET NATURAL TYPE TABLE TO -- 
*                IMPLICIT REAL (A-H), INTEGER (I-N), REAL (O-Z) 
  
          SA1    IST.NTYP 
          SA2    A1+B1
          =X6    M.LOG
          BX7    X1 
          SA6    NAT.TYP     LOGICAL
          LX6    X2 
          SA7    A6+B1       INTEGER
          SA6    A7+B1       REAL 
          SX7    X2+B1
          SA7    A6+B1       DOUBLE 
          SX6    X7+B1
          SA6    A7+B1       COMPLEX
  
*         COPY MASTER LIST CONTROL FLAGS TO WORKING LIST CONTROL FLAGS. 
  
          MVE    =XL.MSTR,=XLSTMSTR,=XLSTWRKG 
          SA1    =XSLIST
          BX6    X1 
          SA6    =XHDELAY    SET TO *HEADER DELAY* IF IN *LIST* MODE
          EQ     ISTX        EXIT.. 
  
 IST.NTYP CON    "INT"+M.INT
          CON    "REAL"+M.REAL
          LIST   D
          END 
