*DECK FTN 
          IDENT  FTN
 FTN      TITLE  F T N  -  INITIALIZE, LOAD OVERLAYS, END COMPILATION 
*CALL SSTCALL 
*CALL FTNRES
 FTN      TITLE  INITIALIZATION MAIN LOOP 
***       COMPILER INITIALIZATION.
* 
  
          USE    FTNINIT
  
 O.INIT   BSS    0           BASE ADDRESS OF INITIALIZATION BLOCK 
 FTN      SPACE  4,8
****
**        FTN - INITIALIZATION MAIN LOOP. 
* 
*         THE OPERATING SYSTEM RESPONDS TO AN -FTN- CONTROL CARD BY 
*         LOADING THE (0,0) OVERLAY AND TRANSFERRING CONTROL HERE.
* 
*         THIS CONTROLLER CALLS A SERIES OF INITIALIZATION SUBROUTINES
*         AND TRANSFERS CONTROL TO THE PRIMARY OVERLAY. 
* 
*         ENTRY  (A0) =  CM/SCM FIELD LENGTH
*                (X0) = ECS/LCM FIELD LENGTH
* 
*         EXIT   TO PRIMARY OVERLAY LOADER. 
*                (B1) = 1 
* 
*         USES   B1, B5 
* 
*         CALLS  SEE CODE 
  
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
*                            VALID ONLY FOR NOS,NOS-BE
          ENTRY  FTN4 
 FTN4     BSS    0           ** ALTERNATE SYSTEM LOADER ENTRY POINT **
 #OS      ENDIF 
          ENTRY  FTN
  
 FTN      BSS    0           ** SYSTEM LOADER ENTRY POINT **
  
          SB1    1
          CALL   MIA         MISC INITIALIZATION, PART A
  
          CALL   ARG         PROCESS CONTROL CARD ARGUMENTS 
  
          CALL   MIB         MISC INITIALIZATION, PART B
  
          CALL   CFL         CHECK FIELD LENGTH 
  
          CALL   IBA         INITIALIZE I/O BUFFER SPACE ALLOCATIONS
  
          EQ     LDPRI       EXIT TO LOAD AND EXECUTE PRIMARY OVERLAY 
****
 KEYS     TITLE  COMPILER INITIALIZATION SUBROUTINES
**        KEYS - CONTROL CARD PARAMETER KEYWORD DEFINITIONS.
* 
*         PARAMETER KEYWORDS ARE DEFINED BY MACRO CALLS, AS FOLLOWS --
* 
* KEY     PARAM  CELL,ASSUMED 
* 
*         *KEY* IS THE PARAMETER KEY-WORD TO APPEAR ON CONTROL CARD.
*                ONE TO SEVEN CHARACTERS. 
*         *CELL* IS THE ADDRESS TO RECEIVE THE PARAMETER VALUE. 
*                IF NEGATIVE, IT IS JUMP ADDRESS OF A NON-STANDARD
*                PROCESSOR FOR THIS CONTROL CARD OPTION.
*         *ASSUMED* = THE VALUE TO BE ASSUMED FOR THIS ARGUMENT WHEN
*                THE KEY APPEARS WITHOUT AN EQUIVALENCED VALUE. 
*                IF IT IS OMITTED, THE VALUE WILL BE BINARY ZERO. 
*                IF IT IS *ON* THE VALUE IS 1S59.  IF IT IS *OFF* 
*                THE VALUE IS BINARY ZERO.
* NOTE    IF THE ASSUMED VALUE IS EITHER BINARY ZERO OR 1S59 AND AN 
*         EQUIVALENCED VALUE OTHER THAN ZERO IS TO BE ALLOWED 
*         NON-STANDARD PROCESSING MUST BE EMPLOYED. STANDARD PROCESSING 
*         ASSUMES THAT IF THIS CELL IS ZERO OR 1S59 IT MAY ONLY BE
*         TOGGLED AND WILL PRODUCE AN ERROR FOR ANY OTHER CASE. 
  
  
          MACRO  PARAM,KEY,CELL,ASSUMED 
          VFD    42/0L_KEY,18/CELL
          IFC    NE,$ASSUMED$ON$,2
          CON    ASSUMED
          SKIP   1
          VFD    1/ON,59/0
 PARAM    ENDM
  
 KEYS     BSS    0           START OF PARAMETER KEY TABLE 
****
 A        PARAM  -ARG=A,ON
 B        PARAM  -ARG=B,0L"CCA.B" 
 BL       PARAM  CP.BLF,ON
 .T       IFNE   TEST,0 
          IFNE   .OS,2,1     IF NOT SCOPE 2 
 BREAK    PARAM  CO.BRK,0L10
 .T       ENDIF 
 C        PARAM  CAFLAG,ON
 CC       PARAM  CCFLAG,ON
 D        PARAM  DFLAG,0L"CCA.D"
  
 #MD      IFGE   .MODES,1 
          IFEQ   .FID,ON,1
 DB       PARAM  -ARG=DB,0LID 
  
 #MD      ENDIF 
 E        PARAM  -ARG=E,0L"CCA.E" 
 EL       PARAM  -ARG=EL
 ER       PARAM  ERFLAG,ON
 G        PARAM  -ARG=G,0L"CCA.G" 
 GO       PARAM  GOFLAG,ON
 I        PARAM  -ARG=I,0L"CCA.I" 
 L        PARAM  -ARG=L,0L"CCA.L" 
 LCM      PARAM  -ARG=LCM,0LD 
 LTP      PARAM  PMDFLAG,ON 
 PMD      PARAM  PMDFLAG,ON 
  
 .T       IFNE   TEST,0 
 #RM      IFEQ   OT#RM,7
 M        PARAM  -ARG=M 
 #RM      ENDIF 
 .T       ENDIF 
  
 ML       PARAM  -ARG=ML
 OL       PARAM  /MASTER/OLIST,ON 
  
 #MD      IFLE   .MODES,1 
 OPT      PARAM  -ARG=OPT,0L2 
 #MD      ENDIF 
  
 P        PARAM  -ARG=P 
 PD       PARAM  -ARG=PD,1L8
 PL       PARAM  -ARG=PL,"CC.PL"
 PS       PARAM  -ARG=PS
 #MD      IFGE   .MODES,1 
 PW       PARAM  PWFLAG,0L72
 #MD      ENDIF 
 Q        PARAM  QFLAG,ON 
 R        PARAM  -ARG=R,0L2 
 REW      PARAM  CO.REW,ON
 ROUND    PARAM  -ARG=RND,37BS19
 S        PARAM  -ARG=S,0L"CCA.S" 
  
 #MD      IFGE   .MODES,1 
 SEQ      PARAM  CO.MODE,ON 
 #MD      ENDIF 
  
 SL       PARAM  SLIST,ON 
  
 .T       IFNE   TEST,0 
 SNAP     PARAM  -ARG=SNP,1 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 SPY      PARAM  SPYW,3L20B 
 #OS      ENDIF 
  
 .T       ENDIF 
  
 SPP      PARAM  SPPFLAG,ON 
 STATIC   PARAM  CO.STA,ON
 SYSEDIT  PARAM  -ARG=EDT 
 T        PARAM  CBNFLG,ON
  
 #MD      IFGE   .MODES,1 
 TS       PARAM  TSFLAG,ON
 #MD      ENDIF 
  
 UO       PARAM  UOFLAG,ON
 X        PARAM  CP.XNAME,0L"CCA.X" 
 Z        PARAM  ZFLAG,ON 
****
 L.KEYS   EQU    *-KEYS      LENGTH OF KEYWORD LIST 
          PURGMAC PARAM 
 ARG      EJECT  4,15        CONTROL STATEMENT ARGUMENT TRANSLATION.
**        ARG -  PROCESS ARGUMENTS FROM CONTROL STATEMENT.
* 
*         R. H. GOODELL      71/07/01       COMPASS 3.0 
*         ADAPTED            74/01/13       FTN 4.3 
* 
*         ENTRY  FIRST CARD OF CONTROL STATEMENT IS IN RA.CCD ET SEQ. 
*                B1=1 
*         EXIT   ARGUMENTS PROCESSED. 
*         USES   ALL. 
*         CALLS  GAC, GAV.
  
  
 ARG      ENTRY. *
          SA0    60/CHAR
          SB2    CHAR 
          MX0    -CHAR
          SB5    B0 
  
 ARG20    SB3    B0          SKIP LEADING BLANKS
          RJ     GAC
          SB7    X4-1R
          ZR     B7,ARG20 
  
          MX6    0
 ARG25    SB3    B0          SKIP VERB
          LX6    CHAR 
          BX6    X6+X4
          RJ     GAC
          SB7    X4-1R9-1 
          MI     B7,ARG25 
  
          SB7    X4-1R.      RETURN IF TERMINATOR 
          SB6    X4-1R) 
          ZR     B7,ARG 
          ZR     B6,ARG 
  
          SA2    EXECUTE
          IX6    X2-X6
          ZR     X6,ARG20    IF EXECUTE IS THE VERB 
          SB3    -B1
          NE     B6,B1,ARG30 IF NOT $ 
          SB3    B0 
  
**        PROCESS NEXT KEYWORD. 
  
 ARG30    GE     B4,B0,ARG31 IF NOT A TERMINATOR. 
          SA2    CCFLAG      FETCH CONTINUE CARD FLAG.
          ZR     X2,ARG      EXIT IF FLAG NOT SET.
          MX6    0
          SA6    A2          RESET FLAG TO ZERO.
          SB5    B0 
          SA6    A5+B1       ZERO WORD TO INDICATE END OF CARD IMAGE. 
          MX6    1
          SA6    GACC 
 ARG31    RJ     GAV
          ZR     X6,ARG30    IGNORE EMPTY ARGUMENT
  
          SA2    KEYS 
          MX3    7*CHAR 
          SB7    L.KEYS 
          SA6    ERA.A1 
  
 ARG32    BX4    X3*X2       SEARCH KEYWORD LIST
          SB7    B7-2 
          BX7    X4-X6
          ZR     X7,ARG40    IF FOUND 
          SA2    A2+2 
          NZ     B7,ARG32    IF MORE KEYS TO CHECK
          EQ     E.FM        IF NOT FOUND 
  
**        KEYWORD PARAMETER --
*                CHECK PRESENCE / ABSENCE OF = VALUE. 
  
 ARG40    SB7    X2 
          SA2    A2+B1        GET DEFAULT VALUE 
          BX6    X2 
          SX3    B4-3         CHECK FOR EQUAL SIGN
          MI     B7,ARG48    IF SPECIAL ARGUMENT
          SA6    B7          STORE DEFAULT VALUE
          ZR     X3,ARG44    IF FOLLOWED BY = 
          EQ     ARG30        LOOP FOR NEXT ARGUMENT
  
 ARG44    MX1    1
          BX7    -X1*X2      PRESERVE TOGGLE FLAG 
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          LX6    CHAR 
          SX1    1R0
          IX3    X6-X1
          NZ     X3,ARG46    IF ARGUMENT NOT = 0
          BX6    X3 
          EQ     ARG47
  
 ARG46    ZR     X7,E.NE     IF ARG MUST BE ZERO. 
          LX6    -CHAR
 ARG47    SA6    B7          STORE ARGUMENT VALUE 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 ARG48    SB7    -B7         PROCESS SPECIAL ARGUMENT 
          JP     B7 
  
**        PROCESS SPECIAL ARGUMENTS.
* 
*         ENTRY  (X0) = MASK -6 
*                (X2) = DEFAULT VALUE FOR KEYWORD 
*                (X3) = (CHARACTER TYPE FROM GAC) - 3 (0 IF = SIGN) 
*                (X4) = KEYWORD LEFT JUSTIFIED ZERO FILLED
*                (X5) = CURRENT WORD OF CARD IMAGE
*                (X6) = (X2)
*                (A0) = 10
*                (B2) = 6 
*                (B3) = $ MODE FROM GAC 
*                (B4) = CHARACTER TYPE FROM GAC 
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5)
*         EXIT   TO PROCESS NEXT KEYWORD
*                X0,X5 A0,A5 B2,B3,B5  PRESERVED. 
  
**        PROCESS ABORT OPTION - A OR A=0.
  
 ARG=A    NZ     X3,ARGA1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          LX6    CHAR 
          SX2    1R0
          IX3    X6-X2
          NZ     X3,E.NE     NOT A=0. 
          MX6    0
 ARGA1    LX6    59-29
          SA1    CP.ABORT 
          MX3    59 
          LX3    29 
          BX1    X3*X1
          BX6    X1+X6       ADD IN ABORT FLAG
          SA6    A1 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS B OPTION - B, B=0, OR B=LFN.
  
 ARG=B    NZ     X3,ARGB1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          RJ     CHK         CHECK NAME FOR LEGALITY
 ARGB1    SA2    FVTBL+2     POINT TO FV.LGO. 
          SA6    BFLAG       .NZ. IF B=LFN
          RJ     CFN         CHANGE FILE NAME 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS DB OPTION - DB, DB=ID, DB=0.
  
 #FID     IFEQ   .FID,ON
 ARG=DB   NZ     X3,ARGDB1   IF NO =
          RJ     GAV         GET VALUE
          ZR     X6,E.ME
          RJ     CHK         CHK FOR VALID NAME 
 ARGDB1   NZ     X6,ARGDB2   IF NOT = 0 
          SA6    CO.ID
          EQ     ARG30
  
 ARGDB2   LX6    2*CHAR 
          SX2    2RID 
          IX3    X6-X2
          NZ     X3,E.DB     IF UNRECOGNIZED VALUE
          MX6    1
          SA6    CO.ID
          EQ     ARG30
 #FID     ENDIF 
  
**        PROCESS E OPTION - E, E=LFN, OR E=0.
  
 ARG=E    NZ     X3,ARGE1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          RJ     CHK         CHECK NAME FOR LEGALITY
          NZ     X6,ARGE1    IF NOT E=0 
          SX6    OFF
          SA6    UFLAG
          EQ     ARG30
  
 ARGE1    SA2    FVTBL+4     POINT TO FV.CMPS.
          RJ     CFN         CHANGE FILE NAME 
          MX6    1
          SA6    UFLAG
          EQ     ARG30
  
**        PROCESS SYSEDIT OPTION - SYSEDIT, OR SYSEDIT=0. 
  
 ARG=EDT  NZ     X3,ARGEDT1  IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          LX6    CHAR 
          SX2    1R0
          IX3    X6-X2
          NZ     X3,E.NE     NOT SYSEDIT=0
          SX6    OFF
          SA6    CO.EDT 
          SA3    F.LFN
          MX6    1
          LX6    1+P.EXT
          BX7    X6+X3       MAKE SURE EXT BIT IS SET 
          SA7    A3 
          EQ     ARG30
  
 ARGEDT1  MX6    1
          SA6    CO.EDT 
          SA3    F.LFN
          LX6    1+P.EXT
          BX7    -X6*X3      REMOVE EXT BIT 
          SA7    A3          SAVE FILE BITS FOR SYMTAB WORD B 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS EL OPTION - EL=A, EL=N, EL=I, EL=W, OR EL=F.
  
 ARG=EL   NZ     X3,E.EQV    IF EL NOT EQUIVALENCED 
          RJ     GAC         GET ARGUMENT CHARACTER 
          SX3    X4-1RA 
          NZ     B4,E.ME     IF SEPERATOR 
          NZ     X3,ARGEL1   IF NOT EL=A
          MX6    1
          SA6    /MASTER/ANSI 
          SA6    LOP=N
          SA6    /MASTER/IEFLG
          EQ     ARGEL7 
  
 ARGEL1   SX3    X4-1RF 
          NZ     X3,ARGEL2   IF NOT EL=F
          SX6    OFF
          SA6    LOP=N
          SA6    /MASTER/IEFLG
          EQ     ARGEL6 
  
 ARGEL2   SX3    X4-1RW 
          NZ     X3,ARGEL3   IF NOT EL=W
          SX6    OFF
          SA6    LOP=N
          MX6    1
          EQ     ARGEL5 
  
 ARGEL3   SX3    X4-1RI 
          MX6    1
          ZR     X3,ARGEL4   IF EL=I
          SX1    X4-1RN 
          NZ     X1,E.EL     IF NOT A VALID ARGUMENT
 ARGEL4   SA6    LOP=N
 ARGEL5   SA6    /MASTER/IEFLG
          SX6    OFF
 ARGEL6   SA6    /MASTER/ANSI 
 ARGEL7   RJ     GAC
          ZR     B4,E.EL     IF ALPHNUMERIC 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS G OPTION - G, G=0, G=LFN, OR G=LFN/OVL. 
  
 ARG=G    BX7    X6          (X7)=DEFAULT LFN 
          IX6    X6-X6           OVL = NO NAME
          NZ     X3,ARGG1    IF NO =
          RJ     GAV         GET FILE NAME
          ZR     X6,E.ME
          RJ     CHK
          SB7    B1+B1        (B7)=2 FOR SLASH TEST 
          BX7    X6 
          MX6    0
          NE     B7,B4,ARGG1  IF NO / 
          RJ     GAV         GET OVERLAY NAME 
 ARGG1    ZR     X7,ARG30    IF *G=0*, IGNORE IT
          SX2    B1 
          BX6    X6+X2       SET *G* FLAG 
          EQ     ARGS2
  
**        PROCESS I OPTION - I, OR I=LFN. 
  
 ARG=I    NZ     X3,ARGI1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          RJ     CHK         CHECK NAME FOR LEGALITY
          ZR     X6,E.IN     IF I=0 
 ARGI1    SA2    FVTBL       POINT TO FV.IN.
          RJ     CFN         CHANGE FILE NAME 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS L OPTION - L, L=0, OR L=LFN.
  
 ARG=L    NZ     X3,ARGL1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          RJ     CHK         CHECK NAME FOR LEGALITY
          NZ     X6,ARGL1    IF NOT L=0 
          SA6    CP.LISTF 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 ARGL1    SA2    FVTBL+1     POINT TO FV.OUT. 
          RJ     CFN         CHANGE FILE NAME 
          SX6    1
          SA6    CP.LISTF    SET LIST ON
          EQ     ARG30
  
**        PROCESS LCM OPTION - LCM=I OR LCM=D.
  
 ARG=LCM  NZ     X3,ARGLCM1  IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
 ARGLCM1  LX6    CHAR 
          SX2    1RD
          IX3    X6-X2
          NZ     X3,ARGLCM2  IF NOT D 
          SX6    OFF
          SA6    DIRECT 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 ARGLCM2  SX2    1RI
          IX3    X6-X2
          NZ     X3,E.LCM    IF NOT I EITHER
          MX6    1
          SA6    DIRECT 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS M OPTION - M        (CYBER 76 ONLY) 
  
 .T       IFNE   TEST,0 
 #RM      IFEQ   OT#RM,7
 ARG=M    ZR     X3,E.EN     IF M EQUIVALENCED
          SA6    OT.RM       SET TO ZR FOR 6RM OBJECT TIME I/O
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
 #RM      ENDIF 
 .T       ENDIF 
  
**        PROCESS ML OPTION.
  
 ARG=ML   NZ     X3,ARG30    IF NO =
          SB6    9*CHAR 
          MX6    0
 ARGML1   RJ     GAC         GET ARGUMENT CHARACTER 
          NZ     B4,ARGML2   IF SEPARATOR 
          LX4    B6 
          SB6    B6-B2
          BX6    X6+X4
          PL     B6,ARGML1   IF NOT .GT. 9 CHARACTERS 
          EQ     E.ML        ** MORE THAN 9 CHARACTERS ** 
  
 ARGML2   SA6    CP.MODL
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS OPT OPTION - OPT=0, 1, OR 2.
  
 ARG=OPT  NZ     X3,ARGOPT1  IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
 ARGOPT1  LX6    CHAR 
          SX3    X6-1R0 
          MI     X3,E.OPT 
          AX6    CHAR 
          NZ     X6,E.OPT    IF MORE THAN 1 CHARACTER 
          SX6    X3-3 
          PL     X6,E.OPT    IF OPT GT 2
          BX6    X3 
          SA6    CO.OLVL
          MX7    1
          SA7    OPTFLG      .MI. FOR *OPT ARG APPEARED*
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS P OPTION - P OR P=0 
  
 ARG=P    NZ     X3,ARGP1    IF NO =
          RJ     GAV
          ZR     X6,E.ME
          SX3    1R0
          LX6    CHAR 
          IX6    X6-X3
          NZ     X6,E.NE     IF NOT P=0 
          MX6    1
 ARGP1    SA6    CP.PAGE
          EQ     ARG30
  
**        PROCESS PL OPTION - PL=N
  
 ARG=PL   NZ     X3,ARGPL2   IF NO =
          SB6    10*CHAR
          MX6    0
 ARGPL1   RJ     GAC         GET ARGUMENT CHARACTER 
          NZ     B4,ARGPL2   IF SEPARATOR 
          SB6    B6-B2
          LX4    B6 
          BX6    X6+X4
          PL     B6,ARGPL1   IF NOT .GT. 10 CHARACTERS
          EQ     E.PL1       MORE THAN 10 CHARACTERS
  
 ARGPL2   SA6    PLARG
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS PD OPTION  -  PD,PD=6 OR 8
  
 ARG=PD   NZ     X3,ARGPD1   IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME     IF NO ARGUMENT 
 ARGPD1   LX6    CHAR 
          SX2    X6-1R6 
          SX1    2RS
          SX3    6
          ZR     X2,ARGPD2   IF PD = 6
          SX2    X6-1R8 
          SX1    2RT
          SX3    8
          ZR     X2,ARGPD2   IF PD = 8
          EQ     E.PD 
 ARGPD2   AX6    CHAR 
          NZ     X6,E.PD     IF MORE THAN ONE CHARACTER ARGUMENT
          LX1    CHAR*8 
          BX6    X1 
          SA6    CP.PD
          EQ     ARG30
  
**        PROCESS PS OPTION  -  PS=N
  
 ARG=PS   NZ     X3,E.PS     IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
          SA6    CP.PS
          EQ     ARG30
  
**        PROCESS R OPTION - R, OR R=0, 1, 2, OR 3. 
  
 ARG=R    NZ     X3,ARGR1    IF NO =
          RJ     GAV         GET ARGUMENT VALUE 
          ZR     X6,E.ME
 ARGR1    LX6    CHAR 
          SX3    X6-1R0 
          MI     X3,E.REF 
          AX6    CHAR 
          NZ     X6,E.REF    IF MORE THAN 1 CHARACTER 
          SX1    3           MAXIMUM REF LEVEL
          MX6    X1-X3       (X6)=MIN(REF,MAXREF) 
          SA6    /MASTER/R=FLAG    SAVE REF MAP LEVEL 
          LX6    58          (X6)=.MI. FOR R=2,3, .PL. FOR R=0,1
          SA6    /MASTER/RSELECT
          MI     X6,ARGR2 
          MX7    0
          SA7    /MASTER/RSELECT   .ZR. FOR R=0 OR 1
          LX6    1           (X6) = .MI. FOR R=1 (TS MODE)
 ARGR2    SA6    /MASTER/LOP=M
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
**        PROCESS ROUND OPTION - ROUND=*/+- IN ANY COMBINATION OR 0.
  
 ARG=RND  ZR     X3,ARGRND1  IF AN =
          SA6    ROPFLAG
          EQ     ARG30
 ARGRND1  RJ     GAC         GET NEXT CHARACTER 
          SX3    X4-1R0 
          MX6    0
          SA6    ROPFLAG
          NZ     X3,ARGRND2  IF NOT *ROUND = 0* 
          RJ     GAC
          ZR     B4,E.RND 
          EQ     ARG30
  
 ARGRND2  ZR     B4,E.RND    ALPHANUMERIC ILLEGAL 
          MI     B4,ARG30 
          SX3    X4-1R/-1 
          PL     X3,ARG30    SEPERATOR
          SA2    ROPFLAG
          BX4    -X4
          SX3    B1 
          SB6    X4+59       59-1RCHAR
          LX3    B6,X3
          BX6    X2+X3
          SA6    A2 
          RJ     GAC
          EQ     ARGRND2
  
**        PROCESS S OPTION - S, S=0, S=OVL, OR S=LIB/OVL. 
  
 ARG=S    MX7    0           LIB = NO NAME
          NZ     X3,ARGS1    IF NO =
          RJ     GAV         GET LIB OR OVL 
          ZR     X6,E.ME
          RJ     CHK
          SB7    B1+B1        FOR SLASH TEST
          NE     B7,B4,ARGS1  IF NO / 
          BX7    X6          SET LIBRARY NAME 
          RJ     GAV         GET OVERLAY NAME 
 ARGS1    NZ     X6,ARGS2  IF NOT S OR S=0
          SA6    CP.LIB      SET *S=0* FLAG 
          EQ     ARG30
  
 ARGS2    SA2    CP.STEXT    GET SYSTEM TEXT COUNTER
          SB6    X2-7 
          SB7    X2+B1
          ZR     B6,E.S7     IF HAVE 7 ALREADY
          SA6    A2+B7       STORE OVERLAY NAME 
          SA7    CP.LIB+B7   STORE FILE OR LIBRARY NAME 
          SX6    B7 
          SA6    A2          STORE UPDATED COUNT
          EQ     ARG30
  
**        PROCESS SNAP OPTION - SNAP=MREDTINPQSAHG OR ANY COMBINATION.
  
 ARG=SNP  NZ     X3,ARGSNP2  IF NO =
          BX6    X3 
          MX7    1
 ARGSNP1  RJ     GAC
          NZ     B4,ARGSNP2  IF SEPARATOR 
          SB7    X4-60
          AX3    X7,B7       SET BIT 2**(59-CHARACTER)
          BX6    X6+X3
          EQ     ARGSNP1
  
 ARGSNP2  SA6    CO.SNAP
          EQ     ARG30
  
  
**        VARIOUS CELLS NEED BY THE ARGUMENT PROCESSOR. 
  
 ERFLAG   DATA   2RER        ERROR RECOVERY OPTION
 PLARG    DATA   0           PLIMIT ARGUMENT
 CNFLCT   DATA   0           .MI. IF CONTROL CARD OPTION CONFLICT 
 EXECUTE  DATA   7REXECUTE
 MASK60   DATA   60606060606060606060B
 MASK40   DATA   40404040404040404040B
 MASK20   DATA   20202020202020202020B
 BLANKS   DATA   10H
 PRNSPY   DATA   0LPRNTSPY
 FTEXT    DATA   6LFTNMAC    NAME OF OBJECT TIME TEXT 
 BFLAG    DATA   0           .NZ. IF B=LFN APPEARED 
 OPTFLG   DATA   0           .MI. IF OPT ARG APPEARED 
 PWFLAG   DATA   0           .NZ. IF PW APPEARED
 TSFLAG   DATA   2RTS 
 CHK      EJECT 
**        CHK -  CHECK FILE NAME FOR LEGALITY.
* 
*         ENTRY  (X6) = NAME TO BE CHECKED (0L FORMAT). 
* 
*         EXIT   (X6) = NAME, WITH ANY UNDISPLAYABLE CHARACTERS REMOVED 
*                            IF NAME WAS *0*, REPLY IS BINARY ZERO. 
*                TO E.LFN IF BAD NAME.
* 
*         RULES  1.  MAXIMUM OF SEVEN CHARACTERS. 
*                2.  NO CHARACTER \ 60B.
*                3.  BEGINS W. ALPHABETIC (SCOPE ONLY) OR IS 1L0. 
*                4.  CONTAINS NO CHARACTERS \ 1R+.
*         CHARACTERS ILLEGAL BY RULE 2. WILL BE REPLACED BY CHAR-40B. 
*         USES   X1, X2, X3, X6 
*                A1, A3 
*                ALL OTHERS PRESERVED 
  
  
 CHK      ENTRY. *
          BX2    X6 
          SX1    X2 
          IX6    X6-X6
          LX2    2*CHAR 
          SX3    X2-2R0 +1R 
          ZR     X3,CHK      IF *0* 
          LX2    -2*CHAR     RESTORE (X2) 
  
          PL     X3,E.LFN    IF FIRST CHAR NOT ALPHABETIC 
  
          NZ     X1,E.LFN    IF MORE THAN 7 CHARS 
          SA1    MASK60 
          SA3    MASK20 
          BX6    X1*X2
          IX6    X6+X3       FORCE CARRY FROM ALL NON-DISPLAYABLES. 
          LX3    2
          BX1    X3*X6       ISOLATE CARRY BITS 
          LX1    -1 
          BX6    -X1*X2      CLEAR HI BIT OF NASTIES
          NZ     X1,E.LFN 
          EQ     CHK         EXIT.. 
 CCERR    SPACE  4,20 
**        CCERR - CONTROL CARD ERROR MESSAGES.
* 
* 
*         ERROR  TYPE,(TEXT)
* 
*                *TYPE*      IF BLANK ONLY *TEXT* WILL BE DISPLAYED,
*                            IF *A* THE BAD ARGUMENT WILL BE PRINTED
*                            FROM ERA.A1. 
*                *TEXT*      ERROR MESSAGE TEXT -- A PERIOD WILL BE 
*                            APPENDED BEFORE DISPLAYING.
*                            TEXT IS DISPLAYED 40 CHARACTERS PER LINE.
*                            PLEASE SPACE PROPERLY SO THAT WORDS ARE NOT
*                            SPLIT ACROSS LINES.
* 
*         USES   X1, X2, X6 
*                A1, A2, A6 
*                B6 
* 
*         CALLS  MESSAGE
  
 ERROR    MACRO  TYPE,TEXT
          LOCAL  A,B,B1,C,D,E 
  
 A        MICRO  1,,*TEXT*
 C        MICRO  1,9,*TEXT* 
 D        MICRO  10,,*TEXT.*
  
          USE    CCMSG
.1        IFC    EQ,/TYPE// 
 E        VFD    1/0
.1        ELSE
 E        VFD    1/1
.1        ENDIF 
  
          VFD    5/0,54/9R"C" 
          DIS    ,*"D"* 
          USE    *
  
          SB6    E
          RJ     IEM         ISSUE ERROR MESSAGE
 ERROR    ENDM
  
*         ERROR MESSAGE CELLS 
 ERA.A1   DATA   0           BAD FIELD
 ERA.A2   DIS    ,$** NO COMPILATION.$
 ERA.A3   DIS    ,$** FTN CONTROL CARD ERRORS.$ 
  
*         ERROR PROCESSORS
  
  
 E.BGO    ERROR  ,(B=0 AND GO IS INCONSISTENT)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE CONFLICT
          EQ     MB18 
  
 E.DC     ERROR  ,(DB IMPLIES TS -- TS MODE NOW ON) 
          MX6    1
          SA6    CO.TS
          EQ     MB10A
  
 E.DOPT   ERROR  ,(D IMPLIES OPT=0 -- OPT IGNORED)
          EQ     MB14 
  
 #FID     IFEQ   .FID,ON
 E.DB     ERROR  ,(DB ARG NOT 0 OR ID)
          MX6    1
          SA6    CNFLCT 
          EQ     ARG30
 #FID     ENDIF 
  
 E.EAND   ERROR  ,(E AND B,C,GO,OL,TS,SEQ OR Q CONFLICT)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE CONFLICT
          EQ     MB16 
  
 E.EF     ERROR  ,(WARNING -- TERMINATOR MISSING) 
          EQ     ARG30
  
 E.EL     ERROR  ,(EL ARG NOT A,N,I,W OR F -- IGNORED)
          EQ     ERA.SK      SKIP EXCESS CHARACTERS 
  
 E.EN     ERROR  A,(MAY NOT BE EQUIVALENCED)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE ERROR 
          SB7    B0 
          RJ     GAV         SKIP FILE NAME 
          EQ     ARG30
  
 E.EQV    ERROR  A,(MUST BE EQUIVALENCED --        IGNORED) 
          EQ     ARG30
  
 #FID     IFEQ   .FID,ON
 E.ERDB   ERROR  ,(INTERACTIVE DEBUG IMPILES ER OPTION) 
          MX6    1
          SA6    CNFLCT 
          EQ     MB19 
 #FID     ENDIF 
  
E.FER     SB3    10          TEN CHAR PER WORD
          SB2    0           CHAR COUNTER 
          MX0    -6          CHAR MASK
E.FER1    GE     B2,B3,E.FER2   IF B2 GT 10 EXIT FROM LOOP
          LX4    6
          SB2    B2+B1       INCREMENT CHAR COUNTER 
          BX3    X0*X4       MASK OFF ONE CHAR
          NZ     X3,E.FER1   IF NON-ZERO,LOOP AGAIN 
          SX3    55B
          BX4    X4+X3       REPLACE ZERO WITH BLANK
          EQ     E.FER1      REPLACE MORE ZERO WITH BLANK 
  
E.FER2    BX6    X5 
          SA6    ERA.A1      LISTS FILES IN CONFLICT
          ERROR  A,(IS USED FOR MORE THAN ONE OPTION) 
          MX6    1
          SA6    CNFLCT 
          EQ     MB19 
  
 E.FM     ERROR  A,(IS UNRECOGNIZABLE -- IGNORED) 
          EQ     ARG30
  
 E.F7     SA6    ERA.A1 
          ERROR  A,(IS MORE THAN 7 CHARACTERS --   EXCESS IGNORED)
          EQ     GAV8 
  
 E.IN     ERROR  ,(INPUT FILE MAY NOT BE SUPPRESSED --      IGNORED)
          EQ     ARG30
  
 E.LCM    ERROR  ,(ONLY LCM=I OR LCM=D IS ALLOWED)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE ERROR 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 E.LFN    BX6    X2          (X6)=ILLEGAL NAME
          SA6    ERA.A1 
          ERROR  A,(IS AN ILLEGAL FILE NAME)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE ERROR 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 E.ME     ERROR  ,(= WITH NO FOLLOWING VALUE -- IGNORED)
          EQ     ARG30
  
 E.ML     ERROR  ,(ML ARG IS MORE THAN 9 CHARACTERS --      EXCESS IGNOR
,ED)
          EQ     ERA.SK      SKIP EXCESS CHARACTERS 
  
 #RM      IFEQ   OT#RM,7
 E.MTS    ERROR  ,(M OPTION NOT ALLOWED WITH TS)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE CONFLICT
          EQ     MB19B
 #RM      ENDIF 
  
 E.NE     ERROR  A,(MAY ONLY BE EQUIV TO 0 --      IGNORED) 
          EQ     ARG30
  
 E.OPT    ERROR  ,(OPT LEVEL NOT 0, 1, OR 2 -- IGNORED) 
          EQ     ARG30
  
 E.PD     ERROR  ,(PD ARGUMENT NOT 6 OR 8  --  IGNORED) 
          EQ     ARG30
  
 E.PL     ERROR  ,(INVALID NUMERIC FIELD IN PL ARG --       IGNORED)
          EQ     MIB5C
  
 E.PL1    ERROR  ,(PL ARG IS TOO LONG -- EXCESS IGNORED)
          EQ     ERA.SK      SKIP EXCESS CHARACTERS 
  
 E.PS     ERROR  ,(MISSING NUMERIC FIELD IN PS ARGUMENT  --  IGNORED) 
          EQ     ARG30
  
 E.PS1    ERROR  ,(INVALID NUMERIC FIELD IN PS ARGUMENT  --  IGNORED) 
          EQ     MIB3B
  
 E.PS2    ERROR  ,(PS .LT. 4 -- IGNORED)
          EQ     MIB3B
  
 E.PW     ERROR  ,(PW IMPLIES TS -- TS MODE NOW ON) 
          MX6    1
          SA6    CO.TS
          EQ     MB11 
  
 E.PW1    ERROR  ,(PW NOT .GE. 50 OR .LE. 136 -- IGNORED) 
          MX6    0
          EQ     MIB2 
  
 E.QAND   ERROR  ,(Q AND B,C,GO,OL,TS OR SEQ CONFLICT)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE CONFLICT
          EQ     MB17 
  
 E.REF    ERROR  ,(R ARGUMENT NOT 0, 1, 2 OR 3 -- IGNORED)
          EQ     ARG30
  
 E.RND    ERROR  ,(ROUND ARG NOT +-*/ OR 0 -- IGNORED)
          EQ     ERA.SK 
  
 #RM      IFEQ   OT#RM,7
 E.STAT   ERROR  ,(STATIC NOT ALLOWED WITH 7RM/SCOPE 2.......IGNORED) 
          EQ     MB19B
 #RM      ENDIF 
  
 E.SEQPW  ERROR  ,(PW AND SEQ IMPLY TS) 
          MX6    1
          SA6    CNFLCT 
          EQ     MB13 
  
 E.SP     ERROR  ,(INVALID NUMERIC FIELD IN SPY ARGUMENT) 
          EQ     END2        ABORT
  
 E.SW     ERROR  ,(SPY BINWIDTH MUST BE A POWER OF TWO) 
          EQ     END2        ABORT
  
 E.S7     ERROR  ,(MORE THAN 7 SYSTEMS TEXTS SPECIFIED) 
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE ERROR 
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 E.TSDC   ERROR  ,(TS AND D OR C OR PMD NOT ALLOWED)
          MX6    1
          SA6    CNFLCT      FLAG UNCORRECTABLE CONFLICT
          EQ     MB12A
  
 E.TSEQ   ERROR  ,(SEQ IMPLIES TS -- TS MODE NOW ON)
          MX6    1
          SA6    CO.TS
          EQ     MB12A
  
 E.TSOPT  ERROR  ,(TS AND OPT ARE CONFLICTING OPTIONS)
          MX6    1
          SA6    CNFLCT 
          EQ     MB13 
  
 E.TSMD   ERROR  ,(NOT CONFIGURED FOR TS=0 -- IGNORED)
          MX6    1
          SA6    TSFLAG 
          EQ     MB12 
  
 E.UC     MESSAGE ERA.A2,,RCL      COMPILATION ABANDONED
          MX6    0
          SA6    GOFLAG      INHIBIT LOAD AND GO
          SA1    CER.FL 
          SX6    1
          SA6    A1 
          EQ     ENDFTN 
  
 E.UO     ERROR  ,(UO WITHOUT OPT=2 IGNORED)
          MX6    0
          SA6    UOFLAG 
          EQ     MB15A
  
          USE    CCMSG
          BSS    1
ERBUF     BSS    8
          BSS    1
          USE    *
  
          PURGMAC ERROR 
  
**        ROUTINE TO SKIP EXCESS CHARACTERS UNTIL SEPERATOR.
* 
 ERA.SK   RJ     GAC         SKIP EXCESS CHARS UNTIL SEPARATOR
          ZR     B4,ERA.SK
          EQ     ARG30       LOOP FOR NEXT ARGUMENT 
  
 IEM      ENTRY. *           ISSUE ERROR MESSAGE
          SA2    ERA.A3 
          ZR     X2,IEM1     IF NOT FIRST TIME
          MESSAGE ERA.A3,,RCL 
          MX6    0
          SA6    A2 
 IEM1     SA3    B6 
          SA6    ERBUF-1
          PL     X3,IEM2     IF NOTHING IN ERA.A1 
          SA1    ERA.A1      PICK UP BAD ARGUMENT 
          SA2    MASK40 
          SX6    B1 
          IX6    X1-X6
          BX1    -X6+X1 
          BX6    X2*X1
          BX1    X6 
          LX1    55 
          SA2    BLANKS 
          IX1    X6-X1
          IX6    X6+X1
          SA1    ERA.A1 
          BX2    -X6*X2 
          IX6    X1+X2
          LX6    54          POSITION BLANK IN FRONT
          SA6    A6+B1
          SA3    B6 
  
 IEM2     MX2    -12
          MX1    CHAR 
 IEM3     BX6    -X1*X3 
          SA3    A3+B1
          BX7    X1*X3
          BX6    X6+X7
          LX6    CHAR 
          SA6    A6+B1
          BX7    -X2*X3 
          NZ     X7,IEM3     IF MOVE NOT COMPLETE 
          BX6    -X1*X3 
          LX6    CHAR 
          SA6    A6+B1
  
          MESSAGE ERBUF,,RCL
          EQ     IEM
 GAC      EJECT  4,15 
**        GAC - GET ARGUMENT CHARACTER. 
* 
*         ENTRY  (X0) = MASK -6.
*                (X5) = CURRENT WORD OF CARD IMAGE. 
*                (A0) = 10. 
*                (A5) = ADDRESS OF (X5).
*                (B3) = $ MODE,  -1 = NORMAL,  0 = QUOTE MODE.
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5). 
* 
*         EXIT   (X4) = CHARACTER.
*                (B4) = CHARACTER TYPE,  -1 = TERMINATOR,  0 = ALPHANUM 
*                            +1 = SEPARATOR,  +2 = /, +3 = =. 
*                (X5, A5, B3, B5)  UPDATED. 
*                (X0, X6, X7, A0, A4, A7, B2, B6, B7)  PRESERVED. 
* 
*         CALLS  SYS=, MSG=.
  
  
 GAC      ENTRY. *           ENTRY/EXIT 
 GAC1     ZR     B5,GAC5     IF (X5) IS EMPTY 
          LX5    CHAR 
          SB5    B5-B1       EXTRACT NEXT CHARACTER 
          BX4    -X0*X5 
          SB4    X4-1R$ 
          ZR     B4,GAC3     IF $ 
          ZR     B3,GAC4     IF IN QUOTE MODE 
          SB4    B0 
          MI     B3,GAC2     IF NOT LEAVING QUOTE MODE
          SB3    -B1
 GAC2     SX2    X4-1R9-1    CLASSIFY CHARACTER 
          SX3    X4-1R.-1 
          MI     X2,GAC      IF ALPHANUMERIC
          SB4    B1 
          LX2    2
          PL     X3,GAC      IF NON-DISPLAY 
          SA3    GACA 
          SB4    X2 
          LX2    X3,B4       GET CHARACTER TYPE CODE
          AX2    -4 
          SB4    X2 
          NZ     X2,GAC      IF NOT BLANK 
          PL     X2,GAC 
          EQ     GAC1        IGNORE BLANK 
  
 GAC3     SB3    B3+B1
          LE     B3,B1,GAC1  IF NOT SECOND $ OF A PAIR IN QUOTE MODE
          SB3    B0 
 GAC4     SB4    B0          QUOTE MODE, RETURN WITH CHARACTER TYPE = 0 
          EQ     GAC
  
 GAC5     SA1    GACC 
          SB5    A0 
          ZR     X1,GAC7     IF INITIAL ENTRY 
          SA5    A5+B1       GET NEXT WORD
          NZ     X5,GAC1     IF NOT END OF CARD 
          MI     X5,GAC1
          SA6    GACB        SAVE (X6)
          CONTRLC GACC,READ 
          SA1    RA.CCD 
          NZ     X1,GAC6
          PL     X1,E.EF     IF NO MORE CONTROL CARDS 
 GAC6     MESSAGE RA.CCD,,RCL 
 GAC7     SB4    60-CHAR+1
          SA2    BLANKS 
          MX6    0           STORE ZERO WORD AFTER CARD IMAGE 
          SA6    RA.CCD+8 
          BX6    X2 
 GAC8     SA5    A6-B1       BLANK FILL CARD IMAGE
          SA6    A5 
          ZR     X5,GAC8
          MX1    -1 
          IX4    X5+X1
          SA2    MASK40 
          BX1    -X5*X4 
          BX4    X1*X2
          LX1    X4,B4
          IX2    X4-X1
          BX1    X4+X2
          BX2    X1*X6
          IX6    X5+X2
          SA6    A6 
          SA1    GACB 
          SA6    GACC          INDICATE NOT FIRST TIME
          BX6    X1          RESTORE (X6) 
          SA5    RA.CCD      SCAN NEW CARD
          EQ     GAC1 
  
*                  +   -   *   /   (    )   $   =   BL   ,    . 
 GACA     VFD    4/1,4/1,4/1,4/2,4/1,4/-1,4/0,4/3,4/-0,4/1,4/-1,*P/0
 GACB     CON    0           STORAGE FOR SAVING (X6)
 GACC     CON    0           STATUS WORD FOR CONTRLC + FIRST TIME FLAG
 GAV      SPACE  4,20 
**        GAV - GET ARGUMENT VALUE. 
* 
*         ENTRY  (X0) = MASK -CHAR
*                (X5) = CURRENT WORD OF CARD IMAGE. 
*                (A0) = 10. 
*                (A5) = ADDRESS OF (X5).
*                (B2) = CHAR
*                (B3) = $ MODE. 
*                (B5) = NUMBER OF CHARACTERS REMAINING IN (X5). 
* 
*         EXIT   (X6) = VALUE SCANNED, LEFT JUSTIFIED WITH 00 FILL. 
*                (X4) = CHARACTER FOLLOWING ARGUMENT. 
*                (B4) = CHARACTER TYPE. 
*                (X5, A5, B3, B5)  UPDATED. 
* 
*         USES   A1,A2,A3,A4,A6  B6  X1,X2,X3 
*                A0,A5,A7  B2,B7  X0,X7  PRESERVED. 
* 
*         IF VALUE SCANNED IS MORE THAN 7 CHARACTERS, ERROR.
  
  
 GAV      ENTRY. *           ENTRY/EXIT 
          MX6    0
          SB6    7*CHAR      INDICATE EMPTY ACCUMULATOR 
  
 GAV2     RJ     GAC         GET ARGUMENT CHARACTER 
          NZ     B4,GAV4     IF SEPARATOR 
          LX4    B6 
          SB6    B6-B2
          BX6    X6+X4
          PL     B6,GAV2     LOOP 
          LX6    2*CHAR      LEFT JUSTIFY VALUE 
          EQ     E.F7        MORE THAN 7 CHARACTERS (RETURN GAV8) 
  
 GAV4     LX6    2*CHAR      LEFT JUSTIFY VALUE 
          EQ     GAV
  
 GAV8     RJ     GAC         SKIP EXCESS CHARS UNTIL SEPARATOR
          ZR     B4,GAV8
          SA1    ERA.A1 
          BX6    X1          RESTORE (X6) = FIRST 7 CHARACTERS OF ARG 
          EQ     GAV
 CFF      EJECT 
**        CFF - CHANGE FILE NAME IN FET/FIT.
* 
*         (RECORD MGR OFF) - CHANGES OR CLEARS FILE NAME IN FET.
*         FOR A NAME CHANGE, THE EXISTING FET FILE MODE BIT IS RETAINED 
*         AND THE CIO COMPLETE BIT IS SET.
*         FOR A NAME CLEAR, FET WORD 1 IS CLEARED TO ZERO.
* 
*         (RECORD MGR ON) - CHANGES OR CLEARS FILE NAME IN FIT. 
* 
* 
*         ENTRY  (X2) = FET/FIT ADDRESS 
*                (X6) = ACTION REQUEST--
*                       TO CLEAR,  = 0
*                       TO CHANGE, = NEW NAME, 7 CHARS MAX, LEFT ADJ
* 
*         EXIT   NAME CHANGED OR CLEARED
* 
*         USES   X - 3, 6, 7
*                A - 1, 3, 6
*                B - 6
* 
*         CALLS  (RECORD MGR OFF) - NONE
*                (RECORD MGR ON)  - STORE 
  
  
 CFF      ENTRY. *           ** ENTRY/EXIT ** 
  
 #RM      IFEQ   CP#RM,0
  
          ZR     X6,CFF2     IF NAME TO BE CLEARED
          SA3    X2          (X3) = FET WORD 1
          SX7    2
          BX3    X7*X3       EXTRACT FILE MODE BIT
          SX7    X3+1        TURN CIO COMPLETE BIT ON 
          IX6    X6+X7       42/NEW FILE NAME,16/0,1/OLD MODE BIT,1/1 
 CFF2     SA6    X2          UPDATE FET WORD 1
          EQ     CFF         EXIT 
  
 #RM      ELSE
  
          SA1    A5          SAVE (A5) AND (X5) 
          BX3    X5 
          SB6    B5          SAVE (B5)
          STORE  X2,LFN=X6   NEW NAME TO FIT
          SA5    A1          RESTORE (A5) AND (X5)
          BX5    X3 
          SB5    B6          RESTORE (B5) 
          EQ     CFF         EXIT 
  
 #RM      ENDIF 
 CFL      EJECT 
**        CFL - CHECK FIELD LENGTH. 
* 
*         COMPARES CURRENT FIELD LENGTH VS. MINIMUM FIELD LENGTH. 
*         EXITS IF CURRENT FL IS ABOVE MINIMUM. OTHERWISE, REQUESTS 
*         FIELD LENGTH EQUAL TO THE NOMINAL FIELD LENGTH FOR THIS MODE
*         (I.E. TS, OPT=0,1,2 OR DEBUG) OR THE MAXIMUM FOR THIS JOB 
*         STEP - WHICHEVER IS SMALLER.
* 
*         ENTRY  (CP.AFLS) = CURRENT FL.
* 
*         EXITS  NORMAL--    RETURNS TO CALLER VIA ENTRY POINT. 
*                            (CP.AFLS) = NEW CURRENT FL.
*                            (CP.NFLS) = NEW CURRENT USABLE FL, ADJUSTED
*                                        FOR DEBUG OPTION.
* 
*                ERROR--     ABORTS JOB.
* 
*         USES   X - 1, 2, 6, 7 
*                A - 1, 2, 6, 7 
*                B - 2, 3 
* 
*         CALLS  FTNEND, MEMORY, MESSAGE
  
  
 CFL2     SA1    DFLAG       DEBUG OPTION FLAG
          SX7    X6-10       LEAVE 10-WORD SAFETY ZONE
          ZR     X1,CFL3     IF DEBUG OPTION OFF
          SX7    X7-S.GCON   RESERVE SPACE FOR DEBUG GLOBAL CON TABLE 
 CFL3     SA7    CP.NFLS     UPDATE TO CURRENT UNRESERVED FL
          SA6    CP.AFLS     UPDATE TO CURRENT FL 
          LX6    30 
          SA6    INT.FL      COMPILER INITIAL FIELD LENGTH
          SA7    O.GCON      SET GLOBAL CON TABLE FWA 
  
 #LCM     IFNE   CT.ECS,0 
  
*         CHECK LCM FL , REQUEST SOME IF OPT .GE. 2 
  
          MEMORY LCM,LCM.MM,R 
          SA1    LCM.MM 
          BX6    X1 
          LX6    59-1        LCM.MM = 1S59 IF REDUCE MODE 
          SA6    A1 
          AX1    30 
          PL     X6,CFL9     IF FIXED FL MODE 
          SA4    CO.OLVL
          SX5    X4-2 
          MI     X5,CFL9     IF OPTLVL .LT. 2 
          SX7    IN.LCM 
          IX3    X1-X7
          LX7    30 
          PL     X3,CFL9     IF LCM.FL .GE. IN.LCM
          SA7    GT1
          MEMORY LCM,GT1,R,,NOABT 
          SA1    GT1
          AX1    30 
  
 CFL9     BX7    X1 
          SA7    CP.AFLL     CP.AFLL = LCM.FL 
 #LCM     ENDIF 
  
  
 CFL      ENTRY. *           ** ENTRY/EXIT ** 
  
*         CHECK CURRENT MEMORY SIZE.
  
*         GET MAXIMUM SCM FIELD LENGTH FOR THIS JOB STEP
  
          MEMORY SCM,MAX.FL,RCL    GET MAX FL 
  
          SA1    CP.AFLS     CURRENT FIELD LENGTH 
          SB2    -MIN.FL     (B2) = -MIN FL FOR OPT = 0 OR 1
          SX7    NOM.FL      (X7) = NOMINAL FL FOR OPT = 0 OR 1 
          SA2    CO.OLVL     OPT LEVEL
          SX6    X2-2 
          MI     X6,CFL1     IF OPT .LT.2 
          SB2    -MIN.OFL    (B2) = -MIN.FL FOR OPT = 2 OR 3
          SX7    NOM.OFL     (X7) = NOMINAL FL FOR OPT = 2 OR 3 
 CFL1     SA2    DFLAG       DEBUG OPTION FLAG
          ZR     X2,CFL1A    IF DEBUG OFF 
          SB2    -MIN.DFL    (B2) = -MIN FL FOR DEBUG 
          SX7    NOM.DFL     (X7) = NOMINAL FL OF DEBUG 
 CFL1A    SA2    CO.TS
          ZR     X2,CFL1B    IF TS NOT SELECTED 
          SB2    -MIN.TFL    (B2) = -MIN FL FOR TS MODE 
          SX7    NOM.TFL     (X7) = NOMINAL FL FOR TS MODE
 CFL1B    SB3    X1+B2       (B3) = CURRENT FL - MINIMUM FL 
          BX6    X1          (X6) = CURRENT FL
          PL     B3,CFL2     IF ENOUGH MEMORY 
          SA1    MAX.FL 
          AX1    30 
          SB3    X1+B2       MAX.FL-MIN.FL
          MI     B3,CFL5     IF NOT ENOUGH MEMORY 
  
*         REQUEST MORE MEMORY.
  
          MX6    X1-X7       MIN OF MAX.FL AND NOMINAL FL 
          LX6    30 
          SA6    GT1
          MEMORY SCM,GT1,RCL
          SA1    GT1         GET NEW FL 
          AX1    30 
          BX6    X1 
          EQ     CFL2        FL NOW OK
  
*         NOT ENOUGH MEMORY; SEND ERROR MESSAGE; ABORT JOB. 
  
 CFL5     SA1    DFLAG       DEBUG OPTION FLAG
          SA3    CO.TS       TS OPTION FLAG 
          SA2    MSG.FL+2 
          ZR     X1,CFL6     IF DEBUG OPTION OFF
          SX7    3R"MIN.DFL"-3R"MIN.FL" 
          EQ     CFL7A
 CFL6     ZR     X3,CFL7     IF NOT TS MODE 
          SX7    3R"MIN.TFL"-3R"MIN.FL" 
          EQ     CFL7A
 CFL7     SA4    CO.OLVL     OPT LEVEL
          SX3    X4-2 
          MI     X3,CFL8     IF OPT .LT. 2
          SX7    3R"MIN.OFL"-3R"MIN.FL" 
 CFL7A    LX7    5*CHAR 
          IX6    X2+X7
          SA6    A2          INSERT MIN DEBUG FL IN ERROR MSG TEXT
 CFL8     MESSAGE  MSG.FL,,RCL
          EQ     END2        ABORT
  
  
  
          LIST   A
 MSG.FL   DIS    2,   FTN NEEDS AT LEAS 
          DIS    ,/T "MIN.FL"00B "SCM" FL.  / 
          LIST   *
 CFN      EJECT 
**        CFN - CHANGE FILE NAME. 
* 
*         CHANGES OR CLEARS ENTRY IN THE FILE VECTOR TABLE. 
*         CALLS -CFF- TO UPDATE THE FET OR FIT.  EXITS WITHOUT ACTION 
*         IF THE VECTOR TABLE ENTRY WAS ALREADY EMPTY, BECAUSE A
*         CONTROL CARD OPTION HAS DESELECTED THE FILE.
* 
*         ENTRY  (X2) = FILE VECTOR TABLE ENTRY 
*                (A2) = ADDRESS OF (X2) ENTRY 
*                (X6) = NEW NAME, MAX 7 CHARACTERS, LEFT ADJUSTED 
*                       ACTION REQUEST -- 
*                       .ZR. = CLEAR ENTRY
*                       .NZ. = CHANGE NAME; KEEP PREVIOUS FET/FIT ADDR
* 
*         EXIT   VARIES WITH ENTRY CONDITIONS 
* 
*         USES   X - 3, 5, 6, 7 
*                A - 7
*                B - NONE 
* 
*         CALLS  CFF
  
  
 CFN      ENTRY. *           ** ENTRY/EXIT ** 
          ZR     X2,CFN      IF EMPTY TABLE ENTRY, EXIT 
          MX7    0
          SX3    X2          FET/FIT ADDRESS
          ZR     X6,CFN2
          IX7    X6+X3       42/NEW NAME, 18/FET OR FIT ADDRESS 
 CFN2     SA7    A2          UPDATE TABLE 
          CALL   CFF
          EQ     CFN         EXIT 
          SPACE  4
*CALL COMCDXB 
*CALL FA=SET
 #OS      IFNE   .OS,2
*CALL     COMCCPM 
 #OS      ENDIF 
 IBA      TITLE  COMPILER INITIALIZATION SUBROUTINES
**        IBA - INITIALIZE BUFFER ALLOCATIONS.
* 
*         IF SOURCE LISTING OPTION OFF (L=0), EXPAND INPUT BUFFER AND 
*         SHRINK OUTPUT BUFFER (CYBER 74 / 6700 OR SMALLER ONLY). 
* 
*         BUFFER SIZES WERE INITIALLY SET TO 2 PASS SIZES.
*         IF TS WAS SELECTED BUFFER SIZES ARE RESET.
* 
*         BUFFER SPACE IS ACTUALLY ALLOCATED IN THE PRIMARY OVERLAYS. 
*         ONLY THE FETS ARE SET UP HERE.
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (B1) = 1 
* 
*         USES   X - 1, 2, 6, 7 
*                A - 1, 2, 6, 7 
*                B - 2
* 
*         CALLS  SETFIL 
  
  
 IBA      ENTRY. *           ** ENTRY/EXIT ** 
  
 #RM      IFNE   CP#RM,7
  
*         IF LIST OPTION OFF, SHRINK -OUT- AND EXPAND -IN- BUFFER.
  
          SA1    SLIST
          NZ     X1,IBA2     IF SOURCE LISTING OPTION ON
          SX6    L.XPINB
          SB2    O.XPINB
          SX7    L.MINBUF 
          LX6    18 
          LX7    18 
          SA6    F.IN+I.CBSET 
          SA7    F.OUT+I.CBSET
  
          SETFIL FILE=F.IN,MODE=INIT,FWA=B2 
          SETFIL FILE=F.OUT,MODE=INIT,FWA=OBUF
  
*         IF TS WAS SELECTED RESET CIO BUFFER SIZES 
  
 IBA2     SA1    CO.TS
          ZR     X1,IBA3     IF *TS* OPTION NOT SELECTED
          SX6    LB.LGO 
          LX6    18 
          SA6    F.LGO+I.CBSET
          SX6    LB.RMAP
          LX6    18 
          SA6    F.RMAP+I.CBSET 
          SX6    LB.LF
          LX6    18 
          SA6    F.LF+I.CBSET 
 IBA3     BSS    0
  
 #RM      ENDIF 
  
 #RM      IFGE   CP#RM,6
  
*         IF TS SELECTED RESET RM HOLDING BUFFER SIZES. 
  
          SA1    TSFLAG 
          ZR     X1,IBA3A    IF TS NOT SELECTED 
          SX6    LB.LGO 
          LX6    18 
          SA6    F.LGO+I.HBSET
          SX6    LB.RMAP
          LX6    18 
          SA6    F.RMAP+I.HBSET 
          SX6    LB.LF
          LX6    18 
          SA6    F.LF+I.HBSET 
          EQ     IBA         EXIT 
  
 IBA3A    BSS    0
  
 #RM      ENDIF 
  
 #RM      IFEQ   CP#RM,0
          SA1    F.RLST+I.CBSET 
 #RM      ELSE
          SA1    F.RLST+I.HBSET 
 #RM      ENDIF 
  
          AX1    19 
          SX6    X1-1        MAX.RL = BUFLEN/2 - 1
          SA6    MAX.RL 
          EQ     IBA         EXIT 
 MIA      EJECT 
**        MIA - MISCELLANEOUS INITIALIZATION, PART A. 
* 
*         ENTRY  (X0) = ECS/LCM FIELD LENGTH
*                (A0) = CM /SCM FIELD LENGTH
*                (B1) = 1 
* 
*         EXIT   (B1) = 1 
* 
*         USES   X - 0, 1, 6, 7 
*                A - 1, 6, 7
*                B - 2, 3 
* 
*         CALLS  TIMER, DATE, CLOCK 
  
  
 MIA      ENTRY. *           ** ENTRY/EXIT ** 
  
**        SAVE FIELD LENGTHS. 
* 
          SX6    A0          CM/SCM FIELD LENGTH
          BX7    X0 
          SA6    CP.AFLS
          SA7    CP.AFLL     SAVE FOR *COMPASS* 
          SA6    CP.NFLS
          SA7    CP.NFLL     SAVE FOR *COMPASS* 
          NO
          LX6    30 
          SA6    FTIFL       SAVE FOR EXIT RESTORATION
  
  
  
**        INSERT DATE AND TIME IN HEADER LINE 
* 
          DATE   TL.DATE
          CLOCK  TL.TIME
  
  
  
**        SAVE CPU START TIME.
* 
 .CT      IFNE   CTIMO,0
          CALL   TIMER
          SA6    TIME0       SAVE START TIME
          SA6    TIME1
 .CT      ENDIF 
  
  
  
**        OBTAIN CURRENT SENSE SWITCH VALUES (CYBER 76/ 7600 ONLY.) 
* 
 #OS      IFEQ   .OS,2       IF SCOPE 2 
          SSW                UPDATE RA.SSW
 #OS      ENDIF 
  
  
  
**        CHANGE NAME OF FTN OVERLAY LIBRARY IF (0,0) OVERLAY LOADED
*         FROM A NON-STANDARD LIBRARY OR FILE (3-WORD CALLS ONLY).
* 
 .LDR     IFEQ   LDRCALL,3
          SA1    RA.LWP      (X1) = LOADER REPLY WORD 
          SA2    RA.PGN      (X2) = ACTUAL LIBRARY NAME 
          LX1    59-18       LIBRARY FLAG TO B59
          MX6    42 
          MI     X1,MIA1     IF FTN LOADED FROM LIBRARY FILE
          SX7    2040B       CLEAR LIBRARY BIT
          LX7    36 
          SA7    OVLB 
 MIA1     SA3    MIAA        (X3) = STANDARD SYSTEM LIBRARY NAME
          BX6    X6*X2
          IX2    X6-X3
          ZR     X2,MIA1A    IF USER DID NOT CHANGE NAME
          SA6    OVLA        SAVE FOR ASSEMBLING OVERLAY LOAD CALLS 
 MIA1A    BSS    0
  
 .LDR     ELSE
  
  
**        LOAD FROM A FILE (TEST MODE, 2-WORD CALLS ONLY).
* 
 .T       IFNE   TEST,0 
          SA2    RA.PGN      (X2) = NAME OF FILE CONTAINING *FTN* 
          MX7    42 
          BX6    X7*X2       REMOVE LOADER PARAMS 
          SA6    OVLA        SAVE FOR ASSEMBLING OVERLAY LOAD CALLS 
 .T       ENDIF 
 .LDR     ENDIF 
  
  
 #FID     IFEQ   .FID,ON
 #MD      IFGE   .MODES,1 
**        OBTAIN GLOBAL INTERACTIVE DEBUG VALUE 
  
          GETLC  CO.ID
          SA1    CO.ID
          LX1    59-DC.FIDP 
          MX2    1
          AX1    60 
          BX6    X1*X2
          SA6    A1 
 #MD      ENDIF 
 #FID     ENDIF 
  
  
  
**        OBTAIN  JOB ORIGIN TYPE FROM BITS 24-35 OF RA+66.  IF VALUE IS
*         0, 1, OR 2, JOT IS TYPE BATCH.  IF GREATER, JOT IS TYPE 
*         TERMINAL. 
* 
          SA1    66B
          MX0    -12
          AX1    24          RIGHT JUSTIFY JOT
          BX1    -X0*X1      ISOLATE THAT FIELD 
          MX7    0
          SX1    X1-3 
          MI     X1,MIA2A    IF JOT LESS THAN 3 (BATCH) 
          SX7    1           JOT FOR TERMINAL JOB 
 MIA2A    SA7    JOT         STORE JOB ORIGIN TYPE
  
  
  
**        CLEAR JOB COMMUNICATIONS AREA ABOVE FILE VECTOR TABLE.
* 
          SB3    RA.PGN      (B3) = END OF SEGMENT TO BE CLEARED
          SX6    0
          SB2    FVLEN
          SA6    RA.ARG+B2
 MIA3     SA6    A6+B1       CLEAR WORD 
          SB2    A6 
          LT     B2,B3,MIA3  IF SEGMENT NOT ALL CLEARED 
          SA6    RA.ORG      CLEAR ISOLATED LOCATION
  
  
  
**        INITIALIZE SOURCE LINE INPUT AREA.
* 
          SA6    CP.CARD     MARK SOURCE INPUT AREA EMPTY 
          EQ     MIA         EXIT 
  
  
  
 MIAA     DATA   0L"FTNMAIN"
 MIB      EJECT 
**        MIB - MISCELLANEOUS INITIALIZATION, PART B. 
* 
*         ENTRY  (B1) = 1 
* 
*         EXIT   (B1) = 1 
* 
*         USES   X - 1, 2, 5, 6, 7
*                A - 1, 2, 6, 7 
*                B - 2, 3 
* 
*         CALLS  MESSAGE, STORE 
  
  
 MIB      ENTRY. *           ** ENTRY/EXIT ** 
**        MOVE FILE VECTOR TABLE TO JOB COMMUNICATION AREA, BEGINNING 
*         AT -RA.ARG-.
* 
          SB2    0
          SB3    FVLEN
 MIB0     SA1    FVTBL+B2 
          SB2    B2+B1
          BX6    X1 
          SA6    RA.ARG-1+B2
          LT     B2,B3,MIB0 
  
  
**        IF L=0 TURN OFF ALL LIST OPTIONS. 
* 
          SA1    CP.LSTF
          NZ     X1,MIB1     IF L NOT 0 
          BX6    X1 
          SA6    /MASTER/R=FLAG 
          SA6    /MASTER/RSELECT
          SA6    /MASTER/LOP=M
          SA6    /MASTER/OLIST
          SA6    SLIST
          SA6    /MASTER/IEFLG
          SA6    LOP=N
          SA6    /MASTER/ANSI 
          SA6    CP.BLF 
 MIB1     SA1    CP.BLF 
          LX6    B1,X1
          SA6    A1          SET STANDARD *COMPCOM* FORMAT
  
**        CHECK FOR CONFLICTS WITH TS OPTION. 
* 
          BX6    X6-X6
          SA1    TSFLAG 
          SA2    CO.TS
          SA3    CO.MODE
          SA4    PWFLAG 
          IFEQ   .FID,ON,1
          SA5    CO.ID
          NZ     X1,MB10     IF TS=0 NOT ON CONTROL CARD
  
 #MD      IFEQ   .MODES,2 
          EQ     E.TSMD      TS=0 NOT ALLOWED IN THIS CONFIGURATION 
 #MD      ENDIF 
  
          SA6    A2          TURN OFF TS
          IX0    X3+X4
          NZ     X0,E.SEQPW  TS=0 AND PW OR SEQ CONFLICT
          EQ     MB13 
  
 MB10     MI     X1,MB12     IF TS ON CONTROL CARD
          SA6    A1          CLEAR TS CONTROL CARD FLAG 
          MI     X2,MB12B    IF TS DEFAULTED ON 
          IFEQ   .FID,ON,1
          NZ     X5,E.DC     DB WITHOUT TS IMPLIES TS 
 MB10A    NZ     X4,E.PW     PW WITHOUT TS IMPLIES TS 
 MB11     NZ     X3,E.TSEQ   SEQ WITHOUT TS IMPLIES TS
          EQ     MB13 
  
 MB12     SA1    TSFLAG      MAY COME HERE FROM E.TSMD
          BX7    X1 
          SA7    CO.TS       TURN ON TS 
          SA3    DFLAG
          SA4    CAFLAG 
          IX0    X3+X4
          SA3    PMDFLAG
          IX0    X0+X3
          NZ     X0,E.TSDC   TS AND D OR C CONFLICT 
 MB12A    SA4    OPTFLG 
          MI     X4,E.TSOPT  TS AND OPT CONFLICT
          EQ     MB15 
  
 MB12B    SA4    OPTFLG 
          SA3    DFLAG
          IX0    X3+X4
          SA5    CAFLAG 
          IX0    X0+X5
          ZR     X0,MB13     IF OPT, D OR C NOT ON CONTROL CARD 
          SA6    A2          TURN OFF TS
  
**        RECONCILE OPT, DEBUG AND TRACE SELECTIONS.
* 
 MB13     SA2    CO.OLVL
          ZR     X2,MB14     IF OPT=0 
          SA3    DFLAG
          ZR     X3,MB15     IF DEBUG NOT SELECTED
          BX6    X6-X6
          SA6    A2          FORCE OPT=0
          SA4    OPTFLG 
          NZ     X4,E.DOPT   DEBUG SELECTED WITH OPT .NZ. 
 MB14     MX6    1
          SA6    CBNFLG      FORCE TRACE ON 
  
**        CHECK FOR UO WITHOUT OPT=2
* 
 MB15     SA2    CO.OLVL
          SA3    UOFLAG 
          SX4    X2-2 
          ZR     X4,MB15A    IF OPT=2 
          ZR     X3,MB15A    IF UO=0
          EQ     E.UO        UO WITHOUT OPT=2 IGNORED 
**        CHECK FOR E AND B, C, GO, OL, TS, SEQ OR Q SELECTION. 
* 
 MB15A    SA2    UFLAG
          ZR     X2,MB16     IF E OPTION NOT SELECTED 
          SA3    BFLAG
          SA4    CAFLAG 
          IX0    X3+X4
          SA5    GOFLAG 
          IX0    X0+X5
          SA2    /MASTER/OLIST
          IX0    X0+X2
          SA3    TSFLAG 
          IX0    X0+X3
          SA4    QFLAG
          IX0    X0+X4
          SA5    CO.MODE
          IX0    X0+X5
          NZ     X0,E.EAND   IF E AND B C GO OL TS SEQ OR Q 
          BX6    X6-X6
          SA6    CO.TS       INSURE TS IS OFF 
  
**        CHECK FOR  Q AND B, C, GO, OL, TS, OR SEQ SELECTION.
* 
 MB16     SA2    QFLAG
          ZR     X2,MB17     IF Q NOT SELECTED
          SA3    TSFLAG 
          SA4    CO.MODE
          IX0    X3+X4
          SA5    /MASTER/OLIST
          IX0    X0+X5
          SA2    CAFLAG 
          IX0    X0+X2
          SA3    GOFLAG 
          IX0    X0+X3
          SA4    BFLAG
          IX0    X0+X4
          NZ     X0,E.QAND   IF Q AND B C GO OL TS OR SEQ 
          BX6    X6-X6
          SA6    CO.TS       INSURE TS IS OFF 
  
**        CHECK FOR B=0 AND GO SELECTION. 
* 
 MB17     SA2    GOFLAG 
          ZR     X2,MB18     IF GO NOT SELECTED 
          SA3    FV.LGO 
          NZ     X3,MB18     IF B SELECTED
          EQ     E.BGO       B=0 AND GO IS INCONSISTENT 
  
**        SET UP ER OPTION. 
* 
 MB18     SX0    2RER 
          SA1    ERFLAG 
          IX2    X0-X1
  
          IFEQ   .FID,ON,2
          SA3    CO.ID       INTERACTIVE DEBUG FLAG 
  
          ZR     X2,MB18AB   IF ER ON CONTROL CARD
  
          IFEQ   .FID,ON,2
          ZR     X3,MB18AA   IF DB NOT ON 
          ZR     X1,E.ERDB   IF ER=0 AND DB=ID
  
 MB18AA   BX6    X1 
          EQ     MB18D       SET ER OPTION
 MB18AB   BSS    0
  
 #FID     IFEQ   .FID,ON
          ZR     X3,MB18A    IF DB OFF
          MX6    1
          EQ     MB18D       SET ER OPTION
 #FID     ENDIF 
  
 MB18A    SA2    CO.TS
          ZR     X2,MB18B    IF NOT TS
          SX6    "CC.ERT" 
          EQ     MB18C       SET ER OPTION
 MB18B    SA2    CO.OLVL
          SB7    X2+*+2 
          JP     B7 
+         SX6    "CC.ER0"    OPT=0
          EQ     MB18C       SET ER OPTION
+         SX6    "CC.ER1"    OPT=1
          EQ     MB18C       SET ER OPTION
+         SX6    "CC.ER2"    OPT=2
 MB18C    LX6    59 
 MB18D    SA6    CO.ER
  
**        CYBER 76 / SCOPE 2 CONFLICTS  --  STATIC, M + TS. 
* 
 #RM      IFEQ   OT#RM,7
          SA2    OT.RM
          ZR     X2,MB19A    IF CRM (M-OPTION) SELECTED 
          SA3    CO.STA 
          MX6    0
          SA6    A3          ENSURE *STATIC* OFF
          NZ     X3,E.STAT   IF *STATIC* SELECTED 
          EQ     MB19B
  
 MB19A    SA3    TSFLAG 
          NZ     X3,E.MTS    IF TS SELECTED 
 MB19B    BSS    0
 #RM      ENDIF 
          SX7    0           OUTPUT FILE FLAG 
          SB5    4           INITIAL COUNTER LIMIT
          SB3    B1          INITIALIZE COUNTER 
          SB2    B0          INITIALIZE COUNTER 
          MX0    42          FILE-NAME
 MB19C    SA1    FV.IN+B2    KEY TO BE MATCHED
          BX5    X0*X1       MASK OFF FILE-NAME 
 MB19D    SA2    A1+B3       PICK UP ELEMENT OF ARRAY 
          BX4    X0*X2       MASK OFF FILE-NAME 
          BX3    X5-X4
          NZ     X3,MB19E    IF FILE-NAME DOES NOT MATCH
          NZ     X7,E.FER    IF MORE THAN 2 OUTPUT FILES
          SA4    OUTLIT 
          BX3    X5-X4
          NZ     X3,E.FER    IF NOT OUTPUT FILES
          SX7    2           SET OUTPUT FILES FLAG
 MB19E    SB3    B3+B1
          LE     B3,B5,MB19D IF MORE ELEMENT TO CHECK 
          SB2    B2+B1       RESET COUNTERS 
          SB5    B5-B1
          SB3    B1 
          GT     B5,MB19C    IF MORE TO CHECK 
  
**        IF UNRESOLVED OPTION CONFLICTS TERMINATE COMPILATION. 
* 
 MB19     SA2    CNFLCT 
          NZ     X2,E.UC     IF UNRESOLVED CONFLICTS
  
          GETPAGE GP.PAGE    GET JOB PAGE PARAMETERS
  
**        SET PAGE WIDTH IF PW OPTION SELECTED. 
* 
          SX6    "CC.PW"
          SA5    PWFLAG      CONTROL CARD PW OPTION 
          ZR     X5,MIB2     IF PW NOT ON CONTROL CARD
          SB7    B1 
          RJ     DXB         CONVERT WIDTH TO BINARY
          SX1    X6-50
          MI     X1,E.PW1    IF PW .LT. 50
          SX1    X6-137 
          PL     X1,E.PW1    IF PW .GT. 136 
 MIB2     SA6    CP.PW
  
  
**        IF PAGE-SIZE (PS-OPTION) WAS NOT SPECIFICED,
*         SET PS TO IP.PS.
* 
 MIB3     SA5    CP.PS
          ZR     X5,MIB3B    IF *PS* NOT ON CC
          MX0    CHAR 
          BX0    X0*X5
          BX6    X5 
          ZR     X0,MIB3A    IF BINARY ALREADY
          SB7    B1          DECIMAL
          RJ     DXB
          NZ     X4,E.PS1    IF BAD CONVERSION
 MIB3A    BX7    -X6         FOR COMPASS
          SA7    A5 
          SX6    X6-4 
          NG     X6,E.PS2    IF .LT. 4 (MIN PAGE SIZE)
          SX6    X6+1 
          SA6    LCP.PS      COMPENSATE FOR HEADER
          EQ     MIB3C
  
*         USE SYSTEM PAGE SIZE
  
 MIB3B    SA1    GP.PAGE
          MX0    -8 
          AX1    12+8        POSITION FOR *PS*
          BX6    -X0*X1 
          EQ     MIB3A       USE JOB DEFAULT VALUE
  
 MIB3C    SA4    CP.PD
          SA1    GP.PAGE
          MX0    -3 
          AX1    12+8+8+1    *PD*/2 
          BX6    -X0*X1 
          LX6    6
          SX6    X6+2055B    BASE FOR S AND L DENSITY CONTROL 
          LX6    8*CHAR 
          SA6    RS.PD       SAVE RESTORE *PD*
          NZ     X4,MIB3D    IF *PD* SET
          SA6    CP.PD       FORCE *PD* INITIALLY 
  
**        IF DEBUG OPTION IS ON AND THE DEBUG INPUT FILE NAME DIFFERS 
*         FROM THE MAIN INPUT FILE NAME, SUBSTITUTE THE DEBUG NAME IN 
*         THE MAIN INPUT FET/FIT.  DO NOT CHANGE THE FILE VECTOR TABLE, 
*         SO THAT THE DEBUG PROCESSOR CAN LATER RESTORE THE MAIN INPUT
*         NAME TO THE MAIN INPUT FET/FIT. 
* 
 MIB3D    SA1    DFLAG
          SA2    FV.IN
          ZR     X1,MIB4A    IF DEBUG OPTION OFF
          MX5    7*6
          BX6    X5*X1       (X6) = DEBUG INPUT FILE NAME 
          MX7    1
          BX5    X5*X2       (X5) =  MAIN INPUT FILE NAME 
          SA7    CP.ERCT     TURN *COMPASS* DEBUG OPTION ON 
          IX1    X6-X5
          NZ     X1,MIB4     IF DIFFERENT INPUT FILES 
          SX6    B1 
          SA6    DFLAG       FLAG TO SIGNAL (DEBUG=MAIN) INPUT FILE 
          EQ     MIB4A
  
 MIB4     CALL   CFF         CHANGE NAME IN FET/FIT 
  
  
**        IF COMPASS ASSEMBLY (C-OPTION) SELECTED,
*         PUT "FTNMAC" IN LIST OF TEXTS.
 MIB4A    SA1    CAFLAG 
          ZR     X1,MIB5     IF ASSEMBLY BY FAX 
          SA2    CP.STEXT 
          SX0    X2-7 
          PL     X0,E.S7     ONLY SEVEN TEXTS ALLOWED 
          SA3    FTEXT       NAME OF OBJECT TIME TEXT 
          NZ     X2,MIB4B    IF G OR S TEXTS WERE SPECIFIED 
          SA2    CP.LIB      S=0 FLAG 
 MIB4B    SX7    X2+B1
          BX6    X3 
          SA7    CP.STEXT    INCREMENT NUMBER OF TEXTS
          SA6    X7+CP.STEXT
  
  
**        IF AUTOMATIC EXECUTION (G-OPTION) SELECTED, MOVE THE BINARY 
*         OUTPUT FILE NAME TO THE G-OPTION FLAG CELL. 
* 
 MIB5     SA1    GOFLAG 
          ZR     X1,MIB5D    IF GO=0
          SA2    FV.LGO 
          MX1    7*CHAR 
          BX6    X1*X2
          SA6    A1 
 MIB5D    BSS    0
  
  
  
**        IF QUICK COMPILATION (Q-OPTION) SELECTED, CLEAR BINARY
*         OUTPUT FILE NAME. 
* 
          SA1    QFLAG
          SA2    FV.LGO 
          ZR     X1,MIB5A    IF Q-OPTION OFF
          BX6    X6-X6
          CALL   CFN         CLEAR BINARY OUTPUT FILE NAME
  
**        IF PL OPTION SELECTED CHANGE VALUE OF PLIMIT. 
* 
 MIB5A    SA5    PLARG
          ZR     X5,MIB5C    IF PL NOT SELECTED 
          SB7    1
          RJ     DXB         CONVERT COUNT TO BINARY
          NZ     X4,E.PL     IF ERROR IN NUMBER 
          SA6    PLIMIT 
 MIB5C    BSS    0
  
  
  
**        IF -SPY- (W-OPTION) IS SELECTED, POST AUTOMATIC CALL TO THE 
*         -SPY- REPORT GENERATOR. 
*         (APPLIES ONLY TO CYBER 74 / 6700 AND SMALLER MODELS.) 
*         RESTRICTION-- THE AUTO CALL USES THE G-OPTION MECHANISM, AND
*         THUS CAUSES A *G* ON THE CONTROL CARD TO BE IGNORED.
* 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 .T       IFNE   TEST,0 
  
          SA5    SPYW        SPY OPTION PARAMETER 
          SB7    B0 
          ZR     X5,MIB5B    IF SPY OPTION OFF
          RJ     DXB         CONVERT OCTAL TO BINARY
          NZ     X4,E.SP     IF ERROR IN SPY WIDTH
          CX3    X6 
          SB7    X3 
          NE     B7,B1,E.SW  IF NOT A POWER OF 2
          SX7    300600B     LIMIT *SPY* TO 3000B - 60000B
          LX6    36 
          BX7    X6+X7
          SA2    PRNSPY      NAME OF REPORT GENERATOR 
          LX7    12 
          SA7    SPYW        STORE PARAMETER WORD 
          BX6    X2 
          SA6    GOFLAG      POST CALL (SIMULATED G-OPTION) 
 MIB5B    BSS    0
  
 .T       ENDIF 
 #OS      ENDIF 
  
  
  
**        TURN -OUTPUT MACRO DEFS- FLAG ON IF ANY OF THE FOLLOWING
*         OPTIONS ARE SELECTED -- 
*                C = COMPASS ASSEMBLY OPTION
*                E = EDIT/UPDATE OUTPUT OPTION
*                O = OBJECT CODE LIST OPTION
* 
          SA1    CAFLAG      C-OPTION FLAG
          SA2    UFLAG       E-OPTION FLAG
          BX7    X1+X2
          SA1    /MASTER/OLIST     OL-OPTION FLAG 
          BX6    X7+X1
          SA6    MACFLAG     TURN -OUTPUT MACRO DEFS- FLAG ON 
  
  
  
**        IF C- OR E-OPTION IS SELECTED, INHIBIT UNLOADING THE
*         -CMPS- FILE AT END OF COMPILATION.
* 
          ZR     X7,MIB6     IF C- AND E-OPTIONS BOTH OFF 
  
 #RM      IFEQ   CP#RM,0
          SX6    -B1
          SA6    SCRTBL+3    REMOVE -CMPS- FROM SCRATCH FILE TABLE
 #RM      ELSE
          STORE  FI.CMPS,CF=R      SET CLOSE FLAG = REWIND
 #RM      ENDIF 
  
  
  
**        CONVERT CONTROL CARD OPTIONS TO DPC AND MOVE TO TITLE LINE. 
* 
 MIB6     MX0    -6          (X0) = ONE-CHARACTER EXTRACTION MASK 
          SA6    CCBUF       (A6) = STRING BUFFER STORE POINTER 
  
*         OPTIMIZATION LEVEL OPTION.
  
          SA2    CO.TS
          MI     X2,MIB6D    IF IN TS MODE
          SA2    DFLAG
          ZR     X2,MIB6A    IF DEBUG OPTION OFF
          SA2    CO.STA 
          ZR     X2,MIB6B    IF STATIC OPTION OFF 
          EQ     MIB7A
  
 MIB6A    SA2    UOFLAG 
          ZR     X2,MIB6B    IF UO NOT SELECTED 
          EQ     MIB6C
  
 MIB6B    SA1    OLIT        *OPT=* 
          RJ     MIBA        BURST *OPT=* TO STRING BUFFER
          SA2    CO.OLVL     (X2) = OPTIMIZATION LEVEL
          SX1    1R0
          IX1    X1+X2
          LX1    9*CHAR 
          SA2    UOFLAG 
          ZR     X2,MIB6E    IF UO NOT SELECTED 
          RJ     MIBA        STORE OPT LEVEL TO STRING BUFFER 
 MIB6C    SA1    UOLIT       * UO*
          EQ     MIB6E
  
 MIB6D    SA1    TSLIT       *TS* 
*         DISABLE PMDMP IF TS MODE SPECIFIED
          SX7    0
          SA7    PMDFLAG
 #FID     IFEQ   .FID,ON
          SA2    CO.ID
          ZR     X2,MIB6E    IF ID OPTION OFF 
          RJ     MIBA        BURST *TS* TO STRING BUFFER
          SA1    IDLIT       * ID*
 #FID     ENDIF 
 MIB6E    RJ     MIBA 
  
*         ROUND OPTIONS.
  
 MIB7A    SA2    ROPFLAG     (X2) = ROUND OPTION FLAGS
          SA1    RLIT        * ROUND=*
          ZR     X2,MIB9     IF ROUND OPTION OFF
          RJ     MIBA 
          LX2    59-22       + OPTION FLAG TO BIT 59
          SB2    1R+
          SB3    1R/
 MIB7     PL     X2,MIB8     IF OPTION OFF
          SX1    B2 
          LX1    9*CHAR 
          RJ     MIBA        OPTION CHARACTER TO STRING BUFFER
 MIB8     SB2    B2+B1
          LX2    1           NEXT OPTION FLAG TO BIT 59 
          LE     B2,B3,MIB7  IF ALL ROUND OPTIONS NOT PROCESSED 
  
*         TRACE OPTION. 
  
 MIB9     SA2    CBNFLG 
          SA1    TLIT 
          ZR     X2,MIB10    IF TRACE OPTION OFF
          RJ     MIBA        *TRACE* TO STRING BUFFER 
  
*         DEBUG OPTION. 
  
 MIB10    SA2    DFLAG
          SA1    DLIT 
          ZR     X2,MIB10A   IF DEBUG OPTION OFF
          RJ     MIBA        *DEBUG* TO STRING BUFFER 
  
*         STATIC OPTION 
  
 MIB10A   SA2    CO.STA 
          SA1    SLIT        * STATIC*
          ZR     X2,MIB10B   IF STATIC OPTION OFF 
          RJ     MIBA        BURST * STATIC* TO STRING BUFFER 
  
*         PMDMP OPTION
          SPACE 
MIB10B    SA2    PMDFLAG
          SA1    PMDLIT 
          ZR     X2,MIB11    IF PMDMP DISABLED
          RJ     MIBA        *PMDMP* TO STRING BUFFER 
          SPACE  1
*         PACK UP STRING BUFFER AND STORE IN TITLE LINE.
  
 MIB11    SB2    A6          (B2) = ADDR OF LAST CHARACTER BURST
          SB3    CCBUF
          SB4    TL.CCOP
          SB5    TL.CCOP+3
          MX2    1           (X2) = WORD PACKING LOOP COUNTER 
          BX6    X6-X6       CLEAR PACKING REGISTER 
 MIB12    SB3    B3+B1
          LX2    6           INCREMENT WORD PACK COUNTER
          SA1    B3          (X1) = NEXT STRING BUFFER CHARACTER
          LX6    6           SHIFT PACKING REGISTER TO NEXT CHARACTER 
          LE     B3,B2,MIB13 IF CHARACTER AVAILABLE TO PACK 
          SX1    1R          BLANK FILL 
 MIB13    BX6    X6+X1       PACK CHARACTER 
          PL     X2,MIB12    IF FULL WORD NOT PACKED
          SA6    B4          FULL WORD TO TITLE LINE
          SB4    B4+B1
          BX6    X6-X6       CLEAR PACKING REGISTER 
          LT     B4,B5,MIB12 IF MORE OPTION WORDS TO FILL IN TITLE LINE 
  
  
  
**        DETERMINE PRESENT COMPUTER MODEL AND PLACE IN TITLE LINE. 
* 
          MX1    1
          SB2    1S6
          AX1    B2 
          SX3    6
          MI     X1,MIB14    IF MODEL 76 / 7600 
          SX6    0220B
          SB2    MIB14
          LX6    48 
          BX4    X6          FORM  +         JP     B2
          LX4    30                -         JP     B2
          BX6    X4+X6
+         SA6    *+1         STORE *JP B2* (BOTH UPPER AND LOWER) 
          SX3    3
+         SX3    4           EXECUTE IF MODEL 74/6600, JUMP IF 73/6400
 MIB14    SA1    TL.CPU      *  70/7X   * 
          LX3    6*6
          IX6    X1+X3
          SA6    A1          CURRENT CPU TYPE TO TITLE LINE 
          SX4    2R70 
          LX4    8*CHAR 
          LX3    2*CHAR 
          IX6    X3+X4
          SA6    CP.CPU 
  
  
**        REMOVE PERIOD FROM END OF TIME IN TITLE LINE. 
* 
          SA1    TL.TIME
          SX2    1R 
          MX3    54 
          BX1    X3*X1
          BX6    X1+X2
          SA6    A1          BLANK FINAL PERIOD IN TIME 
  
  
**        CROSS MODEL COMPILATION OPTION. 
* 
 #RM      IFLE   CP#RM,6
 .T       IFEQ   TEST,0 
*         DO NOT ALLOW MODEL 76 COMPILATION ON MODEL 74 OR LESS UNLESS
*         IN TEST MODE. 
          MX6    0
          SA6    OT.RM       FORCE OBJECT TIME I/O TO ZERO
 .T       ENDIF 
 #RM      ELSE
*         CHANGE RECORD TYPE ON MODEL 76 FOR EXECUTION ON LOWER CYBER 
          SA2    OT.RM
          NZ     X2,MIB            IF 7RM OBJECT MODE - EXIT
          STORE  FI.LGO,RT=S       CHANGE RECORD TYPE TO S
 #RM      ENDIF 
  
          EQ     MIB         EXIT 
  
 GP.PAGE  BSSZ   2           *GETPAGE* RETURN BLOCK 
  
          SPACE  4,8
*         MISC INITIALIZATION LITERALS. 
  
 DLIT     DATA   6L DEBUG 
 OLIT     DATA   4LOPT= 
 RLIT     DATA   7L ROUND=
 TLIT     DATA   6L TRACE 
 OUTLIT   DATA   6LOUTPUT 
PMDLIT    DATA   8L  PMDMP
 TSLIT    DATA   2LTS 
 UOLIT    DATA   3L UO
 SLIT     DATA   7L STATIC
 IDLIT    DATA   3L ID
 MIBA     SPACE  4,8
**        MIBA - BURST DISPLAY-CODED WORD TO BUFFER, 1 CHAR/WORD. 
* 
*         CHARACTERS ARE BURST UNTIL A 6-BIT ZERO BYTE IS FOUND.
*         THE INPUT WORD MUST CONTAIN AT LEAST ONE ZERO BYTE, TO
*         TERMINATE THE BURST.
* 
*         ENTRY  (X0) = MASK(54)
*                (X1) = NOT MORE THAN 9 CHARS TO BURST, -L- FORMAT
*                (A6) = ADDR LAST STRING BUFFER ENTRY 
*                (B1) = 1 
* 
*         EXIT   CHARACTERS BURST TO BUFFER, -R- FORMAT.
*                (A6) = ADDR LAST STRING BUFFER ENTRY 
*                (B1) = 1 
* 
*         USES   X1, X6, A6 
* 
*         CALLS  NONE 
  
  
 MIBA     ENTRY. *           ** ENTRY/EXIT ** 
          BX1    X0*X1       GUARANTEE BURST TERMINATOR 
          ZR     X1,MIBA     IF NOTHING TO BURST
          LX1    6
 MIBA2    BX6    -X0*X1      EXTRACT CHARACTER
          IX1    X1-X6
          SA6    A6+B1
          LX1    6
          NZ     X1,MIBA2    IF MORE TO BURST 
          EQ     MIBA        EXIT 
          TITLE  INITIALIZATION TABLES
 FVTBL    SPACE  4,8
**        FILE VECTOR TABLE.
* 
*         GENERATE TABLE OF DEFAULT FILE NAMES, FET/FIT POINTERS, AND 
*         TABLE ORDINALS.  THE TABLE IS MOVED TO THE JOB COMMUNICATIONS 
*         AREA, BEGINNING AT -RA.ARG-, BY THE LOOP AT -MIA2-. 
* 
*         AFTER THE TABLE IS MOVED TO LOW CORE, THE ENTRY FOR A FILE
*         CAN BE REFERENCED BY THE SYMBOL -FV.NAME-, WHERE *NAME* IS
*         THE FILE NAME.
* 
*         THE TABLE IS FORMED BY THE -FVEC- MACRO, USING REMOTE CALLS 
*         ISSUED FROM THE -FET- MACRO.
 FVEC     SPACE  4,8
**        FVEC - MACRO TO FORM FILE VECTOR TABLE ENTRIES. 
* 
* 
*         FVEC      FILE
* 
*         ENTRY  *FILE* = FILE NAME 
* 
*         EXIT   TABLE ENTRY IS FORMED. 
*                FV.*FILE* IS DEFINED AND DECLARED AN ENTRY POINT.
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC   FVEC
  
  
 FVEC     MACRO  FILE 
          ENTRY  FV.FILE
 FV.FILE  =      *L 
 #RM      IFEQ   CP#RM,0
          VFD    42/0L"FILE",18/FE.FILE 
 #RM      ELSE
          VFD    42/0L"FILE",18/FI.FILE 
 #RM      ENDIF 
 FVEC     ENDM
  
  
  
*         FORM TABLE ENTRIES. 
  
 FVTBL    BSS    0           DEFINE FILE VECTOR TABLE BASE ADDRESS
          LOC    RA.ARG      ULTIMATE TABLE ADDRESS (AFTER MOVE)
  
          LIST   D
 FVEC     HERE               -RMT- GENERATED BY -FET- MACRO 
          LIST   *
  
          LOC    *O 
  
  
  
          ENTRY  FVLEN
 FVLEN    =      *-FVTBL     DEFINE TABLE LENGTH
 COPYRITE SPACE  4,8
**        COPYRIGHT.
* 
          DIS    4,COPYRIGHT CONTROL DATA CORP. 1973-1982 
 CCBUF    SPACE  4,8
**        CONTROL CARD OPTION BUFFER
* 
*         THE CONTROL CARD OPTIONS WILL BE BURST HERE, ONE CHARACTER
*         PER WORD FOR DISPLAYING IN THE TITLE LINE.
*         THE BUFFER ORIGIN IS EQUATED TO -FVTBL- TO REUSE THE TABLE
*         IMAGE SPACE AFTER THE TABLE HAS BEEN MOVED TO LOW CORE. 
  
 CCBUF    =      FVTBL
  
 #OS      IFEQ   .OS,2       IF SCOPE 2 
          BSS    L.MAXLL*10D-*+CCBUF   INSURE SPACE TO BURST CC OPTIONS 
 #OS      ENDIF 
 BUFFERS  TITLE  I/O BUFFERS AND BLOCK LENGTH COMPUTATIONS
          TITLE  BUFFERS
*         COMPUTE BLOCK LENGTHS.
  
 L.RESFTN SET    0           CLEAR BLOCK LENGTH SUMMATION COUNTER 
 BLKNR    MICRO              CLEAR BLOCK NUMBER COUNTER 
  
          LIST   D
 BLKLEN   HERE               -RMT- GENERATED BY -BLKORG- MACRO
          LIST   *
  
  
  
**        TOTAL RESIDENT CODE SPACE.
* 
 L.RESFTN SET    RA.ORG+LDR.00+CP.LCOM+LDR.EP+L.RESFTN+EPSLAK 
          SPACE  4,8
 #RM      IFNE   CP#RM,7
  
**        STANDARD INPUT/OUTPUT BUFFER SPACE ALLOCATIONS. 
  
 OBUF     EQU    O.INIT            OUTPUT BUFFER FWA
 OBUFL    =      CP.ORG-L.RESFTN-IBUFL
  
 7        ERRMI  OBUFL-"BUFL"      FTN (0,0) RESIDENT CODE IS TOO LONG. 
  
 IBUF     EQU    OBUF+OBUFL        INPUT BUFFER FWA 
  
*         FORCE SYSTEM LOADER TO RESERVE ALL REMAINING SPACE BELOW
*         *CP.ORG* FOR THE (0,0) OVERLAY I/O BUFFER AREA. 
  
          USE    CCMSG
          BSS    0
 L.CCMSG  SET    *-O.CCMSG   LENGTH OF CONTROL CARD ERROR MESSAGE BLOCK 
          USE    *
  
 BUFFERS  SPACE  3
**        SHRINK OUTPUT BUFFER WHEN SOURCE LISTING SUPPRESSED (L=0).
  
 L.MINBUF EQU    101B              MINIMUM OUTPUT BUFFER LENGTH 
  
 O.XPINB  EQENT  OBUF+L.MINBUF     EXPANDED INPUT BUFFER FWA
 L.XPINB  =      OBUFL+IBUFL-L.MINBUF  EXPANDED INPUT BUFFER LENGTH 
  
          LIST   D
 CIOBUF   HERE               -RMT- GENERATED AFTER -LC.RMAP- DEFINITION 
          LIST   *
  
 #RM      ENDIF 
 ZZZZFTN  SPACE  3,15 
 #ZFTN#   IFEQ   .OS,2       IF SCOPE 2 
 END      MICRO  1,,/END    FTN/
          "END" 
          IDENT  ZZZZFTN
          TITLE  Z Z Z Z F T N  -  DUMMY (0,0) OVERLAY FOR 7600 
          LCC    OVERLAY(ZZZZFTN,0,0) 
*CALL SSTCALL 
***       -ZZZZFTN- IS A DUMMY ROUTINE THAT EXISTS ONLY TO IMPROVE
*         THE USAGE OF SCM SPACE IN CYBER 76 / 7600 COMPUTERS UNDER 
*         THE SCOPE 2 OPERATING SYSTEM. 
* 
*         WITHOUT -ZZZZFTN-, WE WOULD WASTE THE SCM SPACE OCCUPIED BY 
*         THE -FTN- INITIALIZATION CODE (CONTROL CARD CRACKER, FILE 
*         OPENS, BUFFER SPACE ALLOCATIONS, ETC.), BECAUSE WE HAVE NO WAY
*         TO DIRECT THE SCOPE 2 LOADER TO OVERLAY THIS CODE WITH THE
*         PRIMARY OVERLAYS. 
* 
*         -ZZZZFTN-, HOWEVER, REGAINS THIS SPACE BY MISDIRECTING THE
*         LOADER TO SUIT OUR PURPOSE.  IN REALITY, -ZZZZFTN- IS A DUMMY 
*         (0,0) OVERLAY WHOSE LENGTH CORRESPONDS EXACTLY TO THE LENGTH
*         OF ONLY THE RESIDENT PORTION OF THE REAL -FTN- (0,0) OVERLAY. 
*         WHEN THE LOADER IS CALLED TO CREATE THE ABSOLUTE BINARY 
*         OVERLAYS, THE REAL -FTN- (0,0) OVERLAY IS FIRST GENERATED AND 
*         WRITTEN TO THE FILE -FTN-.  NEXT, LOADER GENERATES THE
*         -ZZZZFTN- (0,0) OVERLAY AND WRITES IT TO -ZZZZFTN-.  THEN THE 
*         PRIMARY AND SECONDARY OVERLAYS ARE GENERATED AND WRITTEN TO 
*         -FTN-.  THE PRIMARY AND SECONDARY OVERLAYS WILL BE LINKED 
*         TO THE SHORT -ZZZZFTN-, BECAUSE THAT WAS THE LAST (0,0) 
*         RELOCATABLE BINARY ENCOUNTERED ON THE LOAD FILE.  THUS, THESE 
*         OVERLAYS WILL BE RELOCATED TO AND LATER LOADED AT THE END OF
*         THE REAL -FTN- RESIDENT CODE --- THE DESIRED END RESULT.
* 
*         NOTE THAT -ZZZZFTN- DOES NOT APPEAR ON THE FINAL ABSOLUTE 
*         BINARY FILE -FTN- BECAUSE ITS LOADER CONTROL (LCC) DIRECTIVE
*         SPECIFIED THAT IT WAS TO BE WRITTEN TO THE FILE -ZZZZFTN-.
*         THE HIGHER OVERLAYS, HOWEVER, ARE WRITTEN TO -FTN- FOR
*         CONVENTIONAL USE. 
* 
*         TO INSURE THAT -ZZZZFTN- REMAINS THE SAME LENGTH AS THE 
*         RESIDENT PORTION OF -FTN-, THE RESIDENT SOURCE CODE IS KEPT IN
*         AN UPDATE *COMDECK NAMED -FTNRES-.  THIS *COMDECK IS CALLED 
*         INTO BOTH -FTN- AND -ZZZZFTN-, SO THAT FUTURE CODE MODIFICA-
*         TIONS WILL AFFECT BOTH IDENTICALLY. 
* 
*         ALSO, -ZZZZFTN- REMAINS A PART OF THE UPDATE *DECK NAMED
*         -FTN-, SO THAT IT NEED NOT BE SPECIFIED SEPARATELY ON 
*         *COMPILE CARDS WHEN DOING QUICK OR SELECTIVE UPDATES. 
 #ZFTN#   ENDIF 
  
          LIST   -L,-R       DO NOT LIST FTNRES CALL
 #ZFTN#   IFEQ   .OS,2       IF SCOPE 2 
*CALL FTNRES
 #ZFTN#   ENDIF 
          LIST   L,F,R
  
 #ZFTN#   IFEQ   .OS,2       IF SCOPE 2 
          ENTRY  FTN
 FTN      BSS    0
  
  
**        DUMMY FILE VECTOR TABLE.
*         REQUIRED ONLY TO DEFINE -FV.XXX- ENTRY POINTS.
* 
          PURGMAC   FVEC
 FVEC     MACRO  FILE 
          ENTRY  FV.FILE
          LOC    VLOC 
 FV.FILE  BSS    0
 VLOC     SET    VLOC+1 
 FVEC     ENDM
  
*         FORM TABLE ENTRIES. 
  
 VLOC     SET    RA.ARG      INITIALIZE VECTOR TABLE ENTRY LOCATION 
  
          LIST   D
 FVEC     HERE
          LIST   *
  
          LOC    *O 
  
          ENTRY  FVLEN
 FVLEN    =      VLOC-RA.ARG DEFINE VECTOR TABLE LENGTH 
  
**        SUM AND CHECK THE RESIDENT CODE LENGTH. 
* 
 L.RESFTN SET    0           CLEAR BLOCK LENGTH SUMMATION COUNTER 
 BLKNR    MICRO              CLEAR BLOCK NUMBER COUNTER 
  
          LIST   D
 BLKLEN   HERE
          LIST   *
  
 L.RESFTN SET    RA.ORG+LDR.00+CP.LCOM+LDR.EP+L.RESFTN+EPSLAK 
*                                          EPSLAK ZERO FOR SCOPE 2
 7        ERRMI  CP.ORG+1-L.RESFTN FTN (0,0) RESIDENT CODE IS TOO LONG
  
  
**        FORCE -ZZZZFTN- TO END AT -CP.ORG-. 
* 
          BSS    CP.ORG-L.RESFTN
  
 #ZFTN#   ENDIF 
  
          END    FTN
