*COMDECK FTNRES 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
*                            VALID ONLY FOR NOS,NOS-BE
          LDSET  EPT=FTN
          LDSET  EPT=FTN4 
 #OS      ENDIF 
  
          LIST   F,X
  
          SPACE  3
*** 
*         CONTROL DATA PROPRIETARY PRODUCT. 
*         COPYRIGHT CONTROL DATA CORP. 1973,1974,1975,1976,1977 
*         COPYRIGHT CONTROL DATA CORP. 1978,1979,1980,1981,1982 
          SPACE  3
*** 
*         FTN - 0.0 OVERLAY OF THE FORTRAN EXTENDED COMPILER
* 
*         FUNCTIONS 
*                SYSTEM INTERFACE AND I/O SUBROUTINES 
*                CONTROL CARD CRACKER 
*                COMPILER INITIALIZATION
          TITLE  INSTALLATION OPTIONS 
***       COMPILER INSTALLATION OPTIONS.
* 
*         THE FOLLOWING OPTIONS MAY BE CHANGED TO MEET INSTALLATION 
*         NEEDS.  THEY ARE LOCATED HERE (RATHER THAN IN THE -OPTIONS- 
*         COMDECK) TO REDUCE THE SIZE OF THE GLOBAL ASSEMBLY TEXT 
*         -FTNTEXT- AND MINIMIZE THE FIELD LENGTH NEEDED FOR ASSEMBLY.
 CONFIG   SPACE  4,12 
***       COMPILER CONFIGURATION. 
* 
* 
*         FTN CAN BE ASSEMBLED IN A *SYSTEM* OR A *TEST* CONFIGURATION. 
* 
*         THE SYSTEM CONFIGURATION IS STANDARD, AND IS INTENDED FOR 
*         CUSTOMER INSTALLATION.
* 
*         THE TEST CONFIGURATION IS INTENDED FOR COMPILER INTERNAL
*         DEBUGGING.  IT IS NOT STRUCTURED FOR SYSTEM INSTALLATION, 
*         REQUIRES MORE FIELD LENGTH, AND COMPILES MORE SLOWLY IN THIS
*         MODE.  THUS, IT IS NEITHER SUITED TO NOR INTENDED FOR USE BY
*         CUSTOMERS.  CONTROL DATA CORP. WILL NOT BE RESPONSIBLE FOR
*         DEFICIENCIES IN TEST MODE COMPILER PERFORMANCE. 
* 
*         COMPILER CONFIGURATION IS CONTROLLED BY THE DEFINITION OR 
*         UNDEFINITION OF THE *UPDATE* SYMBOL -TESTFTN- AT COMPILER 
*         INSTALLATION TIME.  NON-STANDARD PROCEDURES ARE NECESSARY FOR 
*         INSTALLATION IN THE TEST CONFIGURATION. 
* 
*         TEST CONFIGURATION FEATURES ARE ... 
* 
*         A) IT WILL LOAD FROM A LOCAL FILE.
* 
*         B) THE REGISTER SNAP ROUTINES WILL BE ASSEMBLED INTO THE
*            1.0 AND 2.0 OVERLAYS.
* 
*         C) THE CONTENTS OF THE SYMBOL TABLE WILL BE DUMPED TO THE 
*            LOCAL FILE "SYMTAB" AT THE END OF PASS 1 ( BEFORE END
*            PROCESSING ) AND AT THE END OF PASS 2 ( BEFORE REFMAP ). 
*            THE UTILITY PROGRAM "RDUMP" MAY BE USED TO PRINT IT OUT. 
* 
*         D) CODE FOR THE SPY OPTION WILL BE ASSEMBLED. 
*            SPY=NNNB OR SPY, -- SET BIN WIDTH FOR PPU ROUTINE SPY AND
*            HAVE IT SPY ON THE COMPILER OVERLAY BY OVERLAY.
*            AT THE END OF COMPILATION "FTN" WILL CALL "PRNSPY" TO
*            PRINT OUT THE HISTOGRAM PREPARED BY <SPY>. 
* 
*         E) OVERLAY EXECUTION MAY BE SELECTIVELY CONTROLLED BY THE 
*            SNAP= CONTROL CARD OPTION.  WHEN SNAP=0 THRU =5 IS SELECTED
*            THE OVERLAY WITH THE MATCHING SECONDARY LEVEL NUMBER WILL
*            BE LOADED BUT NOT EXECUTED.  FTN WILL TURN THE PAUSE BIT 
*            (IN *RA.SSW*) ON, AND LOOP ON RECALL.  BREAKPOINTS MAY NOW 
*            BE PLACED, AND EXECUTION RESUMED BY ENTERING *GO*. 
* 
*         F) THE REPRIEVE UTILITY IN *LSTPRO* WILL FLUSH THE CIO BUFFERS
*            FOR THE *COMPS*, *LGO*, *REFMAP* AND *RLIST* FILES.
*            REPRIEVE CAN BE INHIBITED BY TURNING SENSE SWITCH 6 ON.
* 
*         G) SETTING OT#RM (IN THE *OPTIONS* COMDECK) TO "7" ON A 
*            CYBER 74-2 OR SMALLER WILL PRODUCE CYBER 76 CODE.  THIS
*            CODE CANNOT BE LOADED BY THE SCOPE 2 LOADER BUT IS USEFUL
*           FOR BENCH CHECKING. (THIS FEATURE IS NOT IMPLEMENTED IN TS
*           MODE.)
* 
*         H) A LIMITED CROSS-MODEL CAPABILITY IS AVAILABLE (IN OPT MODE 
*            ONLY) IN THE STANDARD CYBER 76 COMPILER THROUGH THE USE OF 
*            THE "M" OPTION.  BINARY WHICH IS READABLE BY THE SCOPE 3.4 
*            LOADER WILL BE PRODUCED.  THIS CODE WILL STILL BE OPTIMIZED
*            FOR CYBER 76 UNLESS THE OBJECT "MODEL" MICRO IS CHANGED IN 
*            THE OPTIONS COMDECK (WHICH IS CALLED BY FTNTEXT) AND THE 
*            COMPILER IS REBUILT USING THE NEW FTNTEXT (WHICH ALSO ENDS 
*            THE NEED FOR THE "M" OPTION).
 CTL.CARD  SPACE 4,8
***       CONTROL CARD OPTIONS. 
* 
* 
*            OPTION          MEANING
*            ------          -------
* 
*              A             ABORT AT END OF COMPILATION IF COMPILATION 
*                              (OR INTERMIXED ASSEMBLY) FATAL ERRORS. 
*              A=0           DO NOT ABORT 
* 
*              B             PRODUCE OBJECT CODE ON DEFAULT OBJECT FILE 
*              B=0           INHIBIT OBJECT CODE PRODUCTION 
*              B=LFN         PRODUCE OBJECT CODE ON FILE 'LFN'
* 
*              BL            PRODUCE STANDARD (BURSTABLE) LISTING.
*              BL=0          PRODUCE CONDENSED (NO WASTE) LISTING.
* 
*              C             USE 'COMPASS' ASSEMBLER TO PRODUCE OBJECT
*                            CODE (CPU COMPILATION TIME WILL INCREASE 
*                              BY A FACTOR OF APPROXIMATELY 2.6)
*              C=0           USE FTN INTERNAL ASSEMBLER.
* 
*              D             SELECT FORTRAN DEBUG MODE OF COMPILATION 
*                              (THE DEFAULT INPUT FILE WILL BE READ TO
*                              CHECK FOR AN EXTERNAL PACKET)
*              D=LFN         SAME AS 'D' BUT READ FROM FILE 'LFN' 
*              D=0           DO NOT SELECT DEBUG MODE.
* 
*             DB             SELECTS INTERACTIVE DEBUG
*             DB=ID          SAME AS DB 
*             DB=0           DESELECTS INTERACTIVE DEBUG
* 
*              E             GENERATE '*DECK' CARDS PRIOR TO THE
*                              GENERATED COMPASS IMAGES FOR EACH PROGRAM
*                              UNIT ON THE DEFAULT COMPASS IMAGES FILE. 
*                              'B=0' IS FORCED AND THE 'O' AND 'C'
*                              OPTIONS MAY NOT BE SELECTED. 
*              E=LFN         SAME AS 'E' EXCEPT PRODUCE COMPASS IMAGES
*                              ON THE FILE 'LFN'
*              E=0           DESELECT E OPTION. 
* 
*              EL=A          ISSUE ANSI, INFORMATIVE, NOTE, WARNING,
*                            AND FATAL DIAGNOSTICS. 
*              EL=N          ISSUE INFORMATIVE, NOTE, WARNING, AND
*                            FATAL DIAGNOSTICS. 
*              EL=I          SAME AS EL=N.
*              EL=W          LIST WARNING AND FATAL DIAGNOSTICS.
*              EL=F          LIST FATAL DIAGNOSTICS ONLY. 
* 
*              ER            SELECT OBJECT TIME ERROR RECOVERY
*              ER=0          NO OBJECT TIME ERROR RECOVERY
* 
*              G=LFN         LOAD SYSTEM TEXT OVERLAY FROM SEQUENTIAL 
*                            BINARY FILE LFN. 
*              G=LFN/OVL     SEARCH LFN FOR OVERLAY OVL AND LOAD IT.
*              G=0           NO TEXT IS LOADED. 
*              G             LOAD TEXT FROM DEFAULT FILE. 
* 
*              GO            LOAD AND EXECUTE BINARY OBJECT FILE
*                            SPECIFIED BY B OPTION. 
*              GO=0          DO NOT LOAD AND EXECUTE BINARY OBJECT FILE.
* 
*              I             SOURCE INPUT FROM DEFAULT INPUT FILE 
*              I=LFN         SOURCE INPUT FROM FILE 'LFN' 
* 
*              L=LFN         WRITE ALL LISTABLE OUTPUT ON FILE LFN. 
*              L             LIST ON DEFAULT FILE.
*              L=0           LIST ONLY FATAL ERRORS ON DEFAULT FILE.
* 
*              LCM           SELECT OBJECT CODE METHOD FOR CALCULATING
*                              ADDRESSES TO REFERENCE LEVEL 2 VARIABLES 
*                              THAT RESIDE IN DIRECT-ACCESS LCM.
*              LCM=D         18-BIT DIRECT CALCULATION. 
*              LCM=I         21-BIT INDIRECT CALCULATION. 
*                              (APPLIES ONLY TO CYBER 75 / 7600 OR
*                              LARGER MODELS WITH DIRECT-ACCESS LCM.
*                              OPTION IS IGNORED ON SMALLER MODELS.)
* 
*              LTP           SELECT POST MORTEM DUMP (PMDMP)
*              LTP=0         DISABLE PMDMP
*              PMD           SELECT POST MORTEM DUMP (PMDMP)
*              PMD=0         DISABLE PMDMP
* 
*              ML=NNN        MODLEVEL PASSED TO COMPASS.
* 
*              OL            GENERATED OBJECT CODE IS LISTED. 
*              OL=0          GENERATED OBJECT CODE IS NOT LISTED. 
* 
*              OPT=0         MINIMUM OBJECT CODE OPTIMIZATION.
*              OPT=1         STANDARD OBJECT CODE OPTIMIZATION. 
*              OPT=2         MAXIMUM OBJECT CODE OPTIMIZATION.
* 
*              P             CONTINUE PAGE NUMBERS FROM PROGRAM UNIT
*                            TO PROGRAM UNIT. 
*              P=0           PAGE NUMBERING WILL BEGIN AT 1 FOR EACH
*                            NEW PROGRAM UNIT.
* 
*              PD            PRODUCE LISTING AT 8 LINES PER INCH. 
*              PD=6          PRODUCE LISTING AT 6 LINES PER INCH. 
*              PD=8          PRODUCE LISTING AT 8 LINES PER INCH. 
* 
*              PL=NNN        LIMIT LENGTH OF THE EXECUTION-TIME PRINT 
*                              FILE TO *NNN* LINES.  DEFAULT VALUE IS 
*                              5000 LINES.
* 
*              PS=NNN        MAXIMUM LENGTH IN LINES OF EACH PAGE.
* 
*              PW=N          WIDTH OF PRINTED PAGE FOR COMPILE TIME 
*                            OUTPUT, WHERE N IS THE LENGTH IN CHARACTERS
* 
*              R=0           SELECT NO FORTRAN CROSS-REFERENCE MAP
*              R=1           SELECT SHORT CROSS-REFERENCE MAP 
*              R=2           SELECT FULL  CROSS-REFERENCE MAP 
*              R=3           SELECT FULL  CROSS-REFERENCE MAP AND A MAP 
*                              OF EQUIVALENCE CLASSES AND COMMON BLOCKS 
* 
*              ROUND=+-*/    (ANY OR ALL OF THE OPERATORS +-*/ MAY
*                              APPEAR) SELECT ROUND MACHINE INSTRUCTIONS
*                              TO BE USED ON REAL AND COMPLEX OPERANDS
*                              OF THE DESIGNATED OPERATORS. 
*              ROUND         SAME AS ROUND=+-*/ 
*              ROUND=0       NO ROUNDING IS PERFORMED.
* 
*              S             USE DEFAULT SYSTEMS TEXT NAME FOR INTER- 
*                              MIXED COMPASS PROGRAM UNITS
*              S=0           SELECT NO SYSTEMS TEXT 
*              S=LFN         USE 'LFN' AS SYSTEMS TEXT FOR INTER-MIXED
*                              COMPASS PROGRAM UNITS
* 
*              SL            LIST SOURCE PROGRAM. 
*              SL=0          DO NOT LIST SOURCE PROGRAM.
* 
*              SYSEDIT       INHIBIT USAGE OF ENTRY POINTS FOR FILE 
*                            ENVIRONMENT TABLE ADDRESS PASSING AND FORCE
*                            A LOW-CORE SEARCH FOR EACH I/O REFERENCE 
*                            (EXECUTION TIME WILL INCREASE).
*              SYSEDIT=0     DESELECT SYSEDIT OPTION. 
* 
*              T             SELECT FULL ERROR CHECKING FOR BASIC 
*                              EXTERNAL FUNCTIONS (EXECUTION TIME WILL
*                              INCREASE)
*              T=0           TRACE MODE NOT SELECTED
* 
*              TS            SELECT TIME SHARING MODE.
*              TS=0          SELECT 2-PASS COMPILER.
* 
*                UO          SELECT UNSAFE OPTIMIZATIONS ( OPT=2 ONLY ) 
* 
*              X=LFN         NAME OF FILE WITH COMPASS XTEXT. 
*              X             SAME AS X=OPL. 
* 
*              Z             SUBROUTINE CALLS WITH NO PARAMETERS PASS A 
*                            ZERO WORD. 
*              Z=0           NO ZERO WORD IS PASSED.
* 
  
  
  
**        DEFAULT CONTROL CARD OPTIONS. 
* 
*         THE STANDARD DEFAULT OPTIONS ARE LISTED BELOW.  OPTIONS WILL
*         BE SET TO THESE VALUES WHEN THE CONTROL CARD CALL IS JUST,
*                            FTN. 
* 
*         ANY OPTION MAY BE CHANGED TO MEET INSTALLATION NEEDS BY 
*         REVISING THE APPROPRIATE MICRO, WHICH FOLLOWS.
* 
* 
*         A=0 
*         B=LGO 
*         BL=0
*         C=0 
*         D=0 
*         DB = (SYSTEM FID COMMUNICATION CELL)
*         E=0 
*         EL=I
*         ER=0
*         G=0 
*         GO=0
*         I=INPUT 
*         L=OUTPUT
*         LCM=D 
*         OL=0
*         OPT=1 
*         P=0 
*         PD = JOB DEFAULT
*         PL=5000 
*         PS = JOB DEFAULT
*         PW=126
*         Q=0 
*         R=1 
*         ROUND=0 
*         S=SYSTEXT 
*         SEQ=0 
*         SL
*         SYSEDIT=0 
*         T=0 
*         TS=0
*         UO=0
*         X=OLDPL 
*         Z=0 
  
  
  
**        SELECT DEFAULT CONTROL CARD OPTIONS.
* 
*         THE CONTROL CARD OPTIONS ARE DIVIDED INTO THREE TYPES, THE
*         FIRST GROUP CONSISTS OF OPTIONS WHICH CAN ONLY BE TOGGLED,
*         I.E., OPTION OR OPTION=0.  THE SECOND TYPE IS OF THE FORM 
*         OPTION=LFN, WHERE LFN IS A FILE NAME.  THE THIRD IS OF THE
*         FORM OPTION=ARG WHERE ARG IS AN APPROPRIATE ARGUMENT. 
  
  
**        TOGGLED OPTIONS.
* 
*         TO SELECT A DEFAULT DIFFERENT FROM THE STANDARD SET THE 
*         APPROPRIATE MICRO TO EITHER *ON* OR *OFF* IN THE FOLLOWING
*         TABLE.
  
 ON       EQU    1
 OFF      EQU    0
 CHAR     EQU    6
  
*                   VALUE        OPTION 
 CC.A     MICRO  1,, OFF           A
 CC.BL    MICRO  1,, OFF           BL 
 CC.C     MICRO  1,, OFF           C
 CC.ERT   MICRO  1,, ON       ER WITH TS
 CC.ER0   MICRO  1,, ON     ER WITH OPT=0 
 CC.ER1   MICRO  1,, OFF    ER WITH OPT=1 
 CC.ER2   MICRO  1,, OFF    ER WITH OPT=2 
 CC.GO    MICRO  1,, OFF           GO 
 CC.PMD   MICRO  1,, OFF
 CC.OL    MICRO  1,, OFF           OL 
 CC.P     MICRO  1,, OFF           P
 CC.Q     MICRO  1,, OFF           Q
 CC.SL    MICRO  1,, ON            SL 
 CC.SEQ   MICRO  1,, OFF          SEQ 
 CC.STA   MICRO  1,, OFF         STATIC 
 CC.EDT   MICRO  1,, OFF        SYSEDIT 
 CC.T     MICRO  1,, OFF           T
 CC.TS    MICRO  1,, OFF           TS 
 CC.Z     MICRO  1,, OFF           Z
  
  
  
**        FILE OPTIONS. 
* 
*         EXCEPT WHERE NOTED THE FOLLOWING MICROS SHOULD BE SET TO
*         EITHER *OFF* OR A FILE NAME OF UP TO 7 CHARACTERS.
  
*                   VALUE        OPTION        NOTE 
 CC.B     MICRO  1,, LGO           B         FILENAME ONLY
 CC.D     MICRO  1,, OFF           D
 CC.E     MICRO  1,, OFF           E
 CC.I     MICRO  1,, INPUT         I         FILENAME ONLY
 CC.L     MICRO  1,, OUTPUT        L
  
*         THE FOLLOWING FILE OPTION MICROS SHOULD BE SET TO THE FILENAME
*         DESIRED WHEN THE OPTION IS SPECIFIED ON THE CONTROL CARD BUT
*         IS NOT EQUIVALENCED.  FOR EXAMPLE - FTN,I. WOULD BE AS IF 
*         FTN,I=COMPILE WERE SPECIFIED IF THE CCA.I MICRO BELOW IS NOT
*         CHANGED.  THE ONLY ACCEPTABLE VALUE OF THESE MICROS IS A
*         FILE NAME OF ONE TO SEVEN CHARACTERS. 
  
*                   VALUE        OPTION 
 CCA.B    MICRO  1,, LGO           B
 CCA.D    MICRO  1,, INPUT         D
 CCA.E    MICRO  1,, COMPS         E
 CCA.G    MICRO  1,, SYSTEXT       G
 CCA.I    MICRO  1,, COMPILE       I
 CCA.L    MICRO  1,, OUTPUT        L
 CCA.S    MICRO  1,, SYSTEXT       S
 CCA.X    MICRO  1,, OPL           X
  
  
  
**        OPTION=ARGUMENT OPTIONS 
* 
*         TO SELECT A DEFAULT DIFFERENT THAN THE STANDARD MAKE CHANGES
*         AS NOTED BELOW. 
  
*                   VALUE        OPTION           ACCEPTABLE VALUE
 CC.AE    MICRO  1,, OFF          EL=A        ON, OFF (ANSI DIAGNOSTICS)
 CC.NE    MICRO  1,, ON           EL=N        ON, OFF (NOTE DIAGNOSTICS)
 CC.IE    MICRO  1,, ON        EL=I OR W       ON, OFF (INFO/WARN ERROR)
 CC.LCM   MICRO  1,, OFF         LCM=D         ON, LCM=D -- OFF, LCM=I
 CC.OPT   MICRO  1,, 1           OPT=N            N = 0, 1, OR 2
 CC.PL    MICRO  1,, 5000         PL               NUMBER OF LINES
 CC.PW    MICRO  1,, 0             PW=     PAGE WIDTH FOR TS MODE,
*                                          0 FOR STANDARD WIDTH (136) 
 CC.R     MICRO  1,, 1            R=N             N = 0, 1, 2, OR 3 
 CC.ROUND MICRO  1,, 0           ROUND=           0  FOR NO ROUNDING
*                                                 1B FOR /
*                                                 2B FOR *
*                                                 4B FOR -
*                                                10B FOR +
*                                          ADD (OCTAL) FOR MORE THAN ONE
  
*CALL     IOBUFL
  
 CIOBUF   RMT 
 LC.IN    =      IBUFL
 LC.OUT   =      OBUFL
 LC.ERRS  =      OBUFL
 CIOBUF   RMT 
  
**        TS BUFFER LENGTHS  CIO BUFFERS OR RM HOLDING BUFFERS
  
 MBUFL    MICRO  1,, 201B    MINIMUM BUFFER LENGTH
 LB.LGO   EQENT  "MBUFL"
 LB.RMAP  EQENT  "MBUFL"
 LB.LF    EQENT  "MBUFL"
 MISC.OPT SPACE  4,8
***       MISCELLANEOUS OPTIONS.
* 
  
  
**        DEFAULT FIELD LENGTH REQUEST INCREMENT. 
* 
*         FTN ADDS THIS VALUE TO THE MINIMUM FL (DETERMINED BY THE
*         COMPILER CONFIGURATION AND OPTIONS) TO ARRIVE AT THE FL 
*         REQUESTED WHEN THE JOB FL IS SYSTEM-CONTROLLED. 
* 
 IN.FL    =      4000B
 IN.LCM   =      30000B      INITIAL LCM REQUEST ( OPT=2 ONLY ) 
  
  
  
**        FTN OVERLAY LIBRARY NAMES.
* 
 FTNMAIN  MICRO  1,, NUCLEUS       (0,0) OVERLAY
 FTNOVL   MICRO  1,, SYSOVL        OTHER OVERLAYS 
  
  
  
**        COMPILATION TIME DAYFILE MESSAGE. 
* 
*         0 = DO NOT ISSUE MESSAGE
*         1 = ISSUE MESSAGE 
* 
 CTIMO    =      1
 MAXOPT   SPACE  2
 MAXOPT   =      2+TEST/TEST MAX OPT LEVEL
  
  
***   *** THERE ARE NO INSTALLATION OPTIONS BEYOND THIS LINE ***   ***
 FILES    EJECT 
**        INTERNAL FILE NAMES.
* 
 IN       MICRO  1,, "CC.I" 
  
          IFC    EQ,/"CC.L"/OFF/,2
 OUT      MICRO  1,, OUTPUT 
          SKIP   1
 OUT      MICRO  1,, "CC.L" 
  
 LGO      MICRO  1,, "CC.B" 
 ERRS     MICRO  1,, OUTPUT 
  
 .T       IFEQ   TEST,0 
 CMPS     MICRO  1,, ZZZZZFC
 OPT      MICRO  1,, ZZZZZOP
 RLST     MICRO  1,, ZZZZZRL
 RMAP     MICRO  1,, ZZZZZRM
 .T       ELSE
 CMPS     MICRO  1,, COMPS
 OPT      MICRO  1,, FTNOPT 
 RLST     MICRO  1,, RLIST
 RMAP     MICRO  1,, FTNRMAP
 .T       ENDIF 
  
          IFC    NE,/"CC.E"/OFF/,1
 CMPS     MICRO  1,, "CC.E" 
          TITLE  LOCAL BLOCK ORDER AND ORIGINS
***       ESTABLISH LOCAL BLOCK ORDER AND ORIGINS.
* 
  
  
**        BLKORG - DEFINE BLOCK ORIGIN; ASSIGN BLOCK NUMBER.
* 
*         THIS MACRO DEFINES THE ORIGIN OF A LOCAL BLOCK, ASSIGNS IT
*         A BLOCK NUMBER, AND GENERATES REMOTE CODE FOR COMPUTING THE 
*         BLOCK LENGTH. 
* 
* 
*         BLKORG    NAME,LEN
* 
*         ENTRY  *NAME* = BLOCK NAME
*                *LEN*  = BLOCK LENGTH, AS FOLLOWS ...
*                         A.  MUST BE SPECIFIED FOR BLOCKS THAT END 
*                             WITH THE ORIGIN COUNTER MISPOSITIONED 
*                             (E.G., 6RM INTERNAL BLOCKS).
*                         B.  SHOULD NOT BE SPECIFIED FOR ANY OTHER 
*                             BLOCK, SO THAT LENGTH CAN BE CALCULATED 
*                             AUTOMATICALLY TO ACCOMMODATE CODE CHANGES.
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC   BLKORG
  
  
 BLKORG   MACRO  BLKNAM,LEN 
*                            INCREMENT BLOCK NUMBER.
 BLKNR    DECMIC "BLKNR"+1,2
*                            ESTABLISH BLOCK FWA. 
          USE    BLKNAM 
 '?OBK#"BLKNR" BSS    0 
          USE    *
*                            SAVE MACRO CALL FOR LENGTH COMPUTATION.
 BLKLEN   RMT 
          BLKLEN (BLKNAM),LEN 
 BLKLEN   RMT 
* 
 BLKORG   ENDM
  
  
  
**        BLKLEN - MACRO TO SUM LOCAL BLOCK LENGTHS.
* 
* 
*         BLKLEN    BLKNAM,LENGTH 
* 
*         ENTRY  *BLKNAM* = NAME OF LOCAL RESIDENT CODE BLOCK.
*                *LENGTH* = BLOCK LENGTH, IF IT HAD TO BE SPECIFIED IN
*                           ADVANCE (SEE -BLKORG- MACRO).  MAY BE NIL.
* 
*         EXIT   *L.RESFTN* IS SET TO THE TOTAL BLOCK LENGTH. 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
          PURGMAC   BLKLEN
  
  
 BLKLEN   MACRO  BLKNAM,LEN 
*                            INCREMENT BLOCK NUMBER.
 BLKNR    DECMIC "BLKNR"+1,2
*                            COMPUTE BLOCK LENGTH IF NOT SPECIFIED. 
 .CBL     IFC    EQ, LEN
          USE    BLKNAM 
          BSS    0
 L.RESFTN SET    L.RESFTN+*-'?OBK#"BLKNR" 
          USE    *
 .CBL     ELSE
*                            ADD SPECIFIED BLOCK LENGTH TO TOTAL. 
 L.RESFTN SET    L.RESFTN+LEN 
 .CBL     ENDIF 
 BLKLEN   ENDM
  
  
  
**        DEFINE THE BLOCKS.
* 
*         TO GAIN PROPER CONTROL, THE -BLKORG- MACRO MUST BE CALLED FOR 
*         EACH LOCAL BLOCK IN -FTN-, BEFORE ANY CODE IS GENERATED FOR 
*         THAT BLOCK.  THIS ESTABLISHES THE ORIGIN OF EACH BLOCK FOR
*         LATER BLOCK LENGTH CALCULATION AND DETERMINES THE BLOCK 
*         SEQUENCE IN THE ASSEMBLED BINARY CODE.
* 
  
 BLKNR    MICRO              CLEAR BLOCK NUMBER COUNTER 
  
  
  
**        NOMINAL PROGRAM BLOCK.
* 
          BLKORG 0
  
  
  
**        FTN RESIDENT CODE BLOCK.
* 
          BLKORG FTNRES 
  
  
  
**        FTN INITIALIZATION CODE BLOCK.
* 
*         THE COMPILER INITIALIZATION BLOCK MUST BE THE LAST CODE BLOCK 
*         SO THAT IT CAN BE OVERLAID AFTER INITIALIZATION IS FINISHED.
* 
          USE    FTNINIT
          BSS    0
  
  
**        CONTROL CARD CRACKER ERROR MESSAGE BLOCK. 
* 
*         THIS BLOCK CONTAINS THE ERROR MESSAGES PUT OUT BY THE CONTROL 
*         CARD CRACKER.   IT WILL BE OVERLAID WITH THE INITIALIZATION 
*         CODE BLOCK. 
* 
          USE    CCMSG
 O.CCMSG  BSS    0
          USE    FTNRES 
          TITLE  /COMPCOM/ INTERFACE
***       PROVIDE DEFINITIONS FOR /COMPCOM/.
* 
  
  
**        DEFINE MICROS FOR /COMPCOM/.
* 
 CP.ABORT MICRO  1,, "CC.A" 
 CP.BLF   MICRO  1,, 1S59*"CC.BL" 
 CP.F=    MICRO  1,, -2      VALUE FOR PROCESSOR *F 
  
          IFC    EQ,/"CC.P"/OFF/,2
 CP.PAGE  MICRO  1,, 1S59    DO NOT PROPAGATE PAGE NUMBERS
          SKIP   1
 CP.PAGE  MICRO  1,, 0       PROPAGATE PAGE NUMBERS 
  
          IFC    EQ,/"CC.L"/OFF/,2
 CP.LISTF MICRO  1,, 0
          SKIP   1
 CP.LISTF MICRO  1,, 1
  
 LISTRM   MICRO  1,, -       DO NOT LIST I/O SUBROUTINES
  
 #M       IFEQ   CP#RM,0
 COMPCOM  SPACE  4
**        DEFINE FET MACRO FOR /COMPCOM/. 
* 
 FET      MACRO 
          BSS    8
  ENDM
  
 #M       ENDIF 
 COMPCOM  SPACE  4
          USE    /COMPCOM/
  
  
**        THE FOLLOWING BSS ALIGNS COMPCOM AND RESERVES 3 WORDS FOR 
*         FUTURE 54 TABLE ENTRY POINTS.  PLEASE NOTE THAT ANY CHANGES 
*         WILL AFFECT INTERMIXED COMPASS SUBPROGRAMS. 
* 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 LDR.EP   =      2           RESERVED FOR ENTRY POINTS
 #OS      ELSE
 LDR.EP   =      3           RESERVED FOR ENTRY POINTS
 #OS      ENDIF 
          BSS    LDR.EP 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 EPSLAK   SET    3-LDR.EP    EPSLAK ADDED TO TOTAL RESIDENT CODE SPACE
*                            TO MAINTAIN CORRECT ALIGNMENT. 
 #OS      ELSE
 EPSLAK   SET    0
 #OS      ENDIF 
  
          LIST   -F 
*CALL COMPCOM 
          TITLE  /COMPCOM/ INTERFACE
***       LINK FTN TO /COMPCOM/.
* 
          LIST   F,X
  
  
**        BEGIN RESIDENT CODE BLOCK.
* 
          USE    FTNRES 
  
  
  
**        EQUATE FTN AND /COMPCOM/ LOCATIONS. 
* 
 CP.ERCT  EQENT  CP.ERRCT 
 CP.FLIN  EQENT  CP.LINE+2   FTN SOURCE LISTING LINE FWA
 CP.LSTF  EQENT  CP.LISTF 
 FL       EQENT  CP.AFLS
 CP.IFMT  EQENT  CP.IFORM 
 AMODE    EQENT  CP.IFORM    SOURCE FILE FORMAT 
 CP.BUF   EQENT  CP.CARD
 CO.ABT   EQENT  CP.ABORT 
 CP.MXFL  EQENT  CP.MAXFL 
 COMRET   EQENT  CP.CDC      BIT 59 FLAGS COMPASS CALLED
  
          ENTRY  CP.AFLS
          ENTRY  CP.BLF 
          ENTRY  CP.CARD
          ENTRY  CP.CPU 
          ENTRY  CP.MODL
          ENTRY  CP.NFLS
          ENTRY  CP.PAGE
          ENTRY  CP.PD
          ENTRY  CP.PS
          ENTRY  CP.PW
  
          IFNE   CP#RM,7,1
          ENTRY  SYS=,RCL=,WNB=,MSG=
  
  
  
**        DEFINE LOCAL NAMES FOR /COMPCOM/ FETS AND FITS. 
* 
 #RM      IFNE   CP#RM,7     FETS DEFINED FOR CIO AND 6RM ONLY
 FE.IN    =      CP.IFET
 FE.LGO   =      CP.BFET
 FE.OUT   =      CP.OFET
 FE.ERRS   =     CP.EFET
 #RM      ENDIF 
  
 #RM      IFGE   CP#RM,6     FITS DEFINED FOR 6RM AND 7RM ONLY
 FI.IN    =      CP.IFIT
 FI.LGO   =      CP.BFIT
 FI.OUT   =      CP.OFIT
 FI.ERRS  =      CP.EFIT
 #RM      ENDIF 
          TITLE  COMPILER FIELD LENGTH REQUIREMENTS 
***       COMPILER FIELD LENGTH REQUIREMENTS. 
* 
*         THE FOLLOWING SYMBOLS AND MICROS SPECIFY THE MINIMUM CM/SCM 
*         FIELD LENGTH REQUIREMENTS (WHICH VARY WITH COMPILER CONFIGU-
*         RATION) AND THE NOMINAL DEFAULT AND MAXIMUM FIELD LENGTHS 
*         REQUESTED WHEN JOB FL IS SYSTEM-CONTROLLED. 
* 
  
  
*         FL INCREMENT FOR I/O BUFFERS. 
  
 IB.FL    SET    0           INITIALIZE SYMBOL VALUE
  
*         ADD FOR PASS 1 CIO BUFFERS. 
  
 #RM      IFNE   CP#RM,7
 IB.FL    SET    LC.CMPS+LC.LGO+LC.RMAP 
 #RM      ENDIF 
  
*         ADD FOR PASS 1 FILE HOLDING BUFFERS.
  
 #RM      IFGE   CP#RM,6
 IB.FL    SET    IB.FL+LH.LGO+LH.RMAP 
 #RM      ENDIF 
  
 IB.FL    SET    IB.FL/100B*100B   TRUNCATE TO NEAREST 100B 
  
  
  
*         FL INCREMENT FOR INTERNAL TEST MODE COMPILER CONFIGURATION. 
  
 IT.FL    =      6000B*TEST 
  
*         MINIMUM TS MODE FIELD LENGTH. 
  
          ENTRY  MIN.TFL
 MIN.TFL  EQENT  34000B+IT.FL+IB.FL 
          ERRNG  IP.MFL-MIN.TFL 
 MIN.TFL  OCTMIC MIN.TFL
 MIN.TFL  MICRO  1,3, "MIN.TFL" 
  
  
  
*         MINIMUM OPTIMIZING MODE FIELD LENGTH - OPT = 0 OR 1.
  
 MIN.FL   =      42000B+IT.FL+IB.FL 
          ERRNG  IP.MFL-MIN.FL     NON-DEBUG FL .GT. INSTALLATION LIMIT 
 MIN.FL   OCTMIC MIN.FL 
 MIN.FL   MICRO  1,3, "MIN.FL"
  
  
  
*         MINIMUM OPTIMIZING MODE FIELD LENGTH - OPT = 2 OR 3.
  
 MIN.OFL  =      MIN.FL+12000B-4000B*.OVL/.OVL
          ERRNG  IP.MFL-MIN.OFL    FL .GT. INSTALLATION LIMIT 
 MIN.OFL  OCTMIC MIN.OFL
 MIN.OFL  MICRO  1,3, "MIN.OFL" 
  
  
  
*         MINIMUM DEBUG FIELD LENGTH. 
  
 MIN.DFL  =      MIN.FL+15000B
          ERRNG  IP.MFL-MIN.DFL    DEBUG FL .GT. INSTALLATION LIMIT 
 MIN.DFL  OCTMIC MIN.DFL
 MIN.DFL  MICRO  1,3, "MIN.DFL" 
  
  
  
*         NOMINAL TS MODE FIELD LENGTH (FOR MEMORY REQUESTS). 
  
 NOM.TFL  MIN    MIN.TFL+IN.FL,IP.MFL 
          ENTRY  NOM.TFL
  
  
  
*         NOMINAL OPT = 0 OR 1 FIELD LENGTH (FOR MEMORY REQUESTS).
  
 NOM.FL   MIN    MIN.FL+IN.FL,IP.MFL
  
  
  
*         NOMINAL OPT = 2 OR 3 FIELD LENGTH (FOR MEMORY REQUESTS).
  
 NOM.OFL  MIN    MIN.OFL+IN.FL,IP.MFL 
  
  
  
*         NOMINAL DEBUG FIELD LENGTH (FOR MEMORY REQUESTS). 
  
 NOM.DFL  MIN    MIN.DFL+IN.FL,IP.MFL 
  
  
  
*         MEM DOWN FIELD LENGTH FOR *GO* MODE.
  
 MEM.GOFL EQU    34000B 
 FETS     TITLE  FILE MANAGEMENT TABLES 
*         A MACRO TO FORM THE FETS
  
 CPFET    OPSYN     FET      SAVE /COMPCOM/ FET MACRO DEFINITION
          PURGMAC   FET 
  
 FET      MACRO  NAME,FIRST,MODE,TABLE
          LOCAL  REORG
 #RM      IFEQ   CP#RM,0
* 
*                            FOR CONVENTIONAL CIO I/O.
* 
 REORG    SET    0
*         CHECK FOR EXISTING /COMPCOM/ FET DEFINITION.
 .CD      IF     DEF,FE.NAME
 REORG    SET    1
*         TO REDEFINE /COMPCOM/ FET.
          ORG    FE.NAME
 .CD      ELSE
 FE.NAME  BSS    0
 .CD      ENDIF 
*         LINK GLOBAL FILE SYMBOLS TO FETS. 
 F.NAME   =      FE.NAME
* 
*         FORM FET. 
* 
          VFD    42/0L"NAME",18/MODE+1
          VFD    36/0,6/3,18/FIRST
          CON    FIRST
          CON    FIRST
          CON    FIRST+LC.NAME
*         (I.CBSET)          PASS 1 BUFFER RESET PARAMS.
          VFD    24/0,18/LC.NAME,18/FIRST 
          BSSZ   2                 RANDOM FILE INFO 
 .CD      IFEQ   REORG,1
*         RETURN TO NOMINAL BLOCK.
          USE    *
 .CD      ENDIF 
 #RM      ENDIF 
* 
*                            FOR RECORD MANAGER I/O.
* 
 #RM      IFGE   CP#RM,6
*                            DEFINE PSEUDO-FET BASE ADDRESS.
 FP.NAME  BSS    0
*         (I.FIT)            FLAGS AND FIT POINTER. 
*                            1/HOLD BUF FLAG, 1/SPILL FLAG, 58/FIT ADDR 
*                -HOLDING BUFFER EXISTS- FLAG  ( 1=YES, 0=NO )
          VFD    1/1*LH.NAME/LH.NAME
*                -FILE SPILLED- FLAG           ( 1=YES, 0=NO )
          VFD    1/0
*                            -UNCONDIT BUF FLUSH- FLAG  ( 1=YES, 0=NO ) 
          IFC    NE, TABLE  ,2
          VFD    1/0
          SKIP   1
          VFD    1/1
*                RESERVED FOR CDC.
          VFD    39/0 
*                FIT ADDRESS. 
          VFD    18/FI.NAME 
*                            HOLDING BUFFER CONTROL PARAMETERS. 
 .HB      IFNE   LH.NAME,0
*         (I.FIRST), (I.IN), (I.OUT), (I.LIMIT) 
          DUP    4,1
          VFD    42/0,18/** 
*         (I.HBSET)          HOLDING BUFFER RESET VALUES. 
          VFD    24/0,18/LH.NAME,18/**
 .HB      ENDIF 
* 
*         LINK GLOBAL FILE SYMBOLS TO PSEUDO-FETS.
 F.NAME   =      FP.NAME
 #RM      ENDIF 
* 
*         DECLARE GLOBAL FILE SYMBOLS AS ENTRY POINTS.
          ENTRY  F.NAME 
* 
*         FORM FILE VECTOR TABLE FOR JOB COMMUNICATIONS AREA (RA.ARG).
* 
*         /FVEC-HERE/ APPEARS AT -FVTBL-. 
 FVEC     RMT 
          FVEC   NAME 
 FVEC     RMT 
* 
 FET      ENDM
 FETS     SPACE  4
  
***       CIO CODE VALUES FOR FILE MODES. 
  
 BINARY   EQU    2
 CODED    EQU    0
 FET/FIT  SPACE  4,8
**        SCRATCH FILE DISPOSITION. 
*         (APPLIES ONLY WHEN RECORD MANAGER I/O IS SELECTED.) 
* 
*         SELECT -CLOSE FLAG- (CF) PARAMETER FOR EACH SCRATCH FILE FIT. 
*         THE PARAMETER MAY BE ALTERED DURING COMPILER INITIALIZATION,
*         TO COMPLY WITH CONTROL CARD OPTION SELECTIONS.
* 
 #RM      IFGE   CP#RM,6
 .T       IFEQ   TEST,0 
*                SYSTEM MODE COMPILER - UNLOAD SCRATCH FILES. 
 SFD      MICRO  1,, U
 .T       ELSE
*                TEST MODE COMPILER - REWIND SCRATCH FILES. 
 SFD      MICRO  1,, R
 .T       ENDIF 
 #RM      ENDIF 
 FET/FIT  SPACE  4,8
***       FET/FIT AREAS.
* 
* 
 INPUT    SPACE  3,5
**        INPUT  -  FORTRAN SOURCE INPUT FILE.
  
          FET    IN,IBUF,CODED
 OUTPUT   SPACE  3,5
**        OUTPUT  -  LISTABLE OUTPUT FILE.
  
          FET    OUT,OBUF,CODED 
 LGO      SPACE  3,5
**        LGO  -  EXECUTABLE BINARY (LOAD-AND-GO) FILE. 
  
          FET    LGO,0,BINARY 
  
  
**        ERRORS FILE FOR INTERMIXED COMPASS SET TO OUTPUT. 
  
          FET    ERRS,0,CODED 
 COMPS    SPACE  3,11 
**        COMPS - COMPASS IMAGE FILE
  
          FET    CMPS,0,CODED,TABLE 
 #RM      IFEQ   CP#RM,7
 FI.CMPS  FILE   LFN="CMPS",FO=SQ,OF=R,CF="SFD",PD=IO,EO=T,CM=YES,BT=,RT
,=W,MRL=80D 
          BSSZ   FI.CMPS+20D-*
 #RM      ENDIF 
 RLIST    SPACE  3,11 
**        RLIST/LONGFILE - INTERMEDIATE SCRATCH FILE
  
          FET    RLST,0,BINARY,TABLE
 #RM      IFEQ   CP#RM,7
 FI.RLST  FILE   LFN="RLST",FO=SQ,OF=R,CF="SFD",PD=IO,EO=T,CM=NO,BT=,RT=
,W
          BSSZ   FI.RLST+20D-*
 #RM      ENDIF 
  
**        EQUATE LONGFILE NAME (TS MODE) TO RLIST NAME (2 PASS).
  
 F.LF     EQENT  F.RLST 
 REFMAP   SPACE  3,11 
**        REFMAP  -  LONG REFERENCE MAP (R=2 OR 3) SCRATCH FILE.
  
          FET    RMAP,0,BINARY,TABLE
 #RM      IFEQ   CP#RM,7
 FI.RMAP  FILE   LFN="RMAP",FO=SQ,OF=R,CF="SFD",PD=IO,EO=T,CM=NO,BT=,RT=
,W
          BSSZ   FI.RMAP+20D-*
 #RM      ENDIF 
 OPT      SPACE  3,11 
**        OPT/DEBUG  -  SCRATCH FILE FOR <OPT=2> OR <DEBUG> MODES.
  
          FET    OPT,0,BINARY 
 #RM      IFEQ   CP#RM,7
 FI.OPT   FILE   LFN="OPT",FO=WA,OF=R,CF="SFD",PD=IO,EO=T,RT=W,MRL=37777
,7B 
          BSSZ   FI.OPT+20D-* 
 #RM      ENDIF 
  
  
  
**        EQUATE DEBUG FILE NAME TO OPT FILE NAME.
* 
 F.DEBUG  EQENT  F.OPT
 #RM      IFGE   CP#RM,6
          ENTRY  FI.OPT 
 FI.DBG   EQENT  FI.OPT 
 #RM      ENDIF 
  
  
  
**        DEFINE OUTPUT FILE NAME FOR FORTRAN-CODED I/O STATEMENTS. 
* 
 OUTPUT"C" EQENT F.OUT
          TITLE  CONSTANTS, DATA, FLAGS, TEMP STORAGE 
          SPACE  3
**        USAGE OF CELLS IN JOB COMMUNICATIONS AREA.
* 
 SYM1     =      RA.SSW+12B        INVERTED FWA OF SYMBOL TABLE 
 LDRP     =      RA.SSW+17B - 21B  3 WORDS FOR LOADER CALL PARAM LIST 
 LISTOP   SPACE  4,8
**        LISTING CONTROL FLAGS AFFECTED BY C/-LIST DIRECTIVES. 
  
*         MASTER COPY OF LISTING CONTROL FLAGS. 
  
 LSTMSTR  BSS    0
          ENTRY  LSTMSTR
  
          QUAL   MASTER 
  
 ANSI     CON    1S59*"CC.AE"   1S59 IF ANSI DIAGNOSTICS, ELSE 0
 IEFLG    CON    1S59*"CC.IE"   1S59 IF INFORMATIVE ERRORS, ELSE 0
  
          IFC    NE,/"CC.R"/0/,2
 LOP=M    CON    1S59        .MI. IF R.NE.0 
          SKIP   1
 LOP=M    CON    0           .ZR. IF R=0
  
 LOP=O    CON    1S59*"CC.OL"   1S59 FOR OBJECT LIST, ELSE 0
  
          IFC    GE,/"CC.R"/2/,2
 LOP=R    CON    1S59           .MI. FOR R=2 OR R=3 
          SKIP   1
 LOP=R    CON    0              .PL. FOR R=0 OR R=1 
  
 LOP=W    =      IEFLG
 LOP=X    =      ANSI 
 OLIST    =      LOP=O
 RSELECT  =      LOP=R
 R=FLAG   CON    "CC.R"         R = N (0, 1, 2, 3)
  
          QUAL   *
  
 L.MSTR   =      *-LSTMSTR
          ENTRY  L.MSTR 
 MLOP=O   EQENT  /MASTER/LOP=O
 MLOP=R   EQENT  /MASTER/LOP=R
 MLOP=X   EQENT  /MASTER/LOP=X
          SPACE  4,8
**        MISCELLANEOUS FLAGS.
  
 FTIFL    VFD    12/0,18/**,30/0   INITIAL CM/SCM FIELD LENGTH
 F.TABS   ENTRY. 0           FWA TABLE AREA IN TS-MODE
 GL.DRL   ENTRY. 100B        LENGTH OF GLOBAL DRL 
 GL.DVL   ENTRY. 100B        LENGTH OF GLOBAL DVL 
 GL.IND   ENTRY. 100B        LENGTH OF DEBUG RANDOM FILE INDEX
 GL.SYM   ENTRY. 0           GLOBAL O.SYM (RESET IN LSTPRO) 
 INT.FL   ENTRY. 0           COMPILER INITIAL FIELD LENGTH
 JOT      ENTRY. 0           JOB ORIGIN TYPE (0 - BATCH, 1 - TERMINAL)
 LASTREC  ENTRY. 57333333333334000005B    UPDATED DISPOW AND RECORD 
 LCP.PS   ENTRY. 0           LCP.PS (LOCAL CELL FOR CP.PS) = CP.PS-3
 RS.PD    ENTRY. 0           RESTORE PRINT DENSITY
          ENTRY  LDPT 
 LDRFL    VFD    12/0,18/MEM.GOFL,30/0   FIELD LENGTH FOR LOADING IN GO MD
 LGOIO    ENTRY. -1          -1 IF BIN IS ON DISK(NO CMLOD) 
*                             0 IF BIN IS IN SCM
*                            +1 IF BIN IS IN LCM
 L.GCON   ENTRY. 0           LENGTH OF GLOBAL DEBUG CON TABLE 
*                                  0  - INTERSPERSED STATEMENTS 
 MACFLAG  ENTRY. 0           OLIST .OR. UFLAG 
*                                  IF = 0 THEN DONT SEND MACROS TO COMPS
 MAX.FL   ENTRY. 7777777776BS30    JOB STEP MAX FL (-1 FOR MEMORY CALL) 
 MAX.RL   ENTRY. 0           MAX RECORD LENGTH FOR OPT=2
 O.GCON   ENTRY. 0           FWA OF GLOBAL DEBUG CON TABLE
 PR.MXFL  ENTRY. 0           MAX FL USED BY CURRENT PROGRAM UNIT
 W.TABS   ENTRY. 0           AMOUNT OF CORE TO BE MANAGED IN TS-MODE
 CER.FL   ENTRY. 0           1 IF CONTROL CARD ERROR OR NULL PROGRAM
 .MODES   EQU    1
          SPACE  3
**        FLAGS ASSOCIATED WITH THE CONTROL CARD OPTIONS. 
  
 PDFLAG   ENTRY. 1S59        SET IF ISSUE PD, ELSE NOT SET
 CAFLAG   ENTRY. 1S59*"CC.C"    1S59 IF COMPASS ASSEMBLY ELSE 0 
 CBNFLG   ENTRY. 1S59*"CC.T"    1S59 IF TRACE MODE ELSE 0 
 CCFLAG   ENTRY.  0 
 .T       IFNE   TEST,0 
 .OS2     IFNE   .OS,2
 CO.BRK   ENTRY. 0           LIST OF OVERLAY NRS (0L FMT) AS SET UP BY
*                              *BREAK=* CC OPTION.
*                              E.G.  BREAK=2122  WOULD BE  4L2122 
 .OS2     ENDIF 
 .T       ENDIF 
 CO.EDT   ENTRY. 1S59*"CC.EDT"  1S59 IF SYSEDIT ON ELSE 0 
 CO.ER    ENTRY. 0           1S59 IF ER ON ELSE 0 
  
          IFEQ   .FID,ON,1
 CO.ID    ENTRY. 0           1S59 IF DB=ID ELSE 0 
  
 CO.MODE  ENTRY. 1S59*"CC.SEQ"  1S59 FOR SEQUENCED INPUT IN TS MODE 
  
          IFC    LE,/"CC.OPT"/2/,2
 CO.OLVL  ENTRY. "CC.OPT"    OPTIMIZATION LEVEL 
          SKIP   1
 CO.OLVL  ENTRY. 2           OPTIMIZATION LEVEL 
  
 CO.REW   ENTRY. 0           .MI. IF REWIND OF INPUT AND LGO SELECTED 
 CO.RND   ENTRY. "CC.ROUND"S19  ROUNDED ARITHMETIC FLAG 
 CO.SNAP  ENTRY. 0           .NZ. IF SNAPS DESIRED
 CO.STA   ENTRY. "CC.STA"    1S59 IF STATIC LOAD
 CO.TBK   EQENT  CBNFLG      ALTERNATE NAME FOR TRACE MODE FLAG 
 CO.TS    CON    1S59*"CC.TS"      1S59 IF TS MODE ELSE 0 
  
          IFC    EQ,/"CC.D"/OFF/,2
 DFLAG    ENTRY. 0           IF DEBUG NOT SELECTED
          SKIP   1
 DFLAG    ENTRY. 0L"CC.D"    DEBUG FILE NAME IF SELECTED
  
 DIRECT   ENTRY. 1S59*"CC.LCM"  1S59 IF LCM=D ELSE 0
  
*         F.LFN  BITS TO SET FOR A FILE NAME (WORD B OF SYMTAB).
 L1       SET    60-P.TYP-L.TYP 
 L2       SET    P.TYP-P.EXT-1
 EXT      SET    0
          IFEQ   "CC.EDT",0,1 
 EXT      SET    1
          ENTRY  F.LFN
 F.LFN    VFD    L1/0,L.TYP/T.LFN,L2/0,1/EXT,*P/0 
  
 GOFLAG   CON    1S59*"CC.GO"   1S59 IF COMPILE AND GO SELECTED ELSE 0
 LOP=F    ENTRY. 1S59           LIST FATAL ERRORS ALWAYS
 LOP=N    ENTRY. 1S59*"CC.NE"   1S59 IF NOTE DIAGNOSTICS ELSE 0 
 LOP=1    ENTRY. OFF            USED IN TS MODE FOR ERROR FLAG
PMDFLAG   ENTRY. 1S59*"CC.PMD"  1S59 IF PMDMP ENABLED, ELSE 0 
 OT.RM    ENTRY. OT#RM-6        OBJECT TIME I/O (0=6RM, 1=7RM)
 PLIMIT   ENTRY. "CC.PL"        OBJECT TIME PRINT LIMIT 
 QFLAG    ENTRY. 1S59*"CC.Q"    1S59 IF QUICK MODE COMPILATION ELSE 0 
 ROPFLAG  EQENT  CO.RND         ALTERNATE NAME FOR ROUNDED ARITHMETIC FL
 SLIST    ENTRY. 1S59*"CC.SL"   1S59 FOR SOURCE LIST ELSE 0 
 SPPFLAG  ENTRY. 0              SYSTEM PROGRAMMER PACKAGE FLAG
 UFLAG    ENTRY. "CC.E"         .NZ. IF E OPT SELECTED ELSE 0 
 UOFLAG   ENTRY. 0           "0 IF *UO* SELECTED
 ZFLAG    ENTRY. 1S59*"CC.Z"    1S59 IF ZERO WORD LOAD FOR APLIST ELSE 0
          SPACE  3,6
**        FLAGS ASSOCIATED WITH LCM USEAGE ( OPT .GE. 2 ) 
  
 LCM.OA   ENTRY. 0           ORIGIN OF ALLOCATABLE LCM
 LCM.MM   ENTRY. 0           MEMORY MODE ( = 1S59 IF REDUCE MODE )
 LCM.MU   ENTRY. 0           MEMORY USED
 LCM.FL   EQENT  CP.AFLL     LCM FIELD LENGTH ( ACTUAL )
          SPACE  4,8
**        GLOBAL TEMPORARY STORAGE CELLS. 
* 
*         THESE SCRATCH CELLS ARE AVAILABLE TO ANY USER AT ANY TIME.
*         THEY ARE INTENDED FOR USE WITH IN-LINE CODE, AND SHOULD NOT 
*         BE EXPECTED TO SURVIVE OVER SUBROUTINE CALLS. 
  
 GT1      EQENT  CP.LINE
 GT2      EQENT  CP.LINE+1
          SPACE  4,8
          ENTRY  L.MAXCD
 L.MAXCD  =      10D         SOURCE INPUT LINE MAX LENGTH (WORDS) 
 L.MAXLL  =      L.MAXCD+2   OUTPUT LISTING LINE MAX LENGTH (WORDS) 
          EJECT 
**        NAMES OF THE OVERLAYS LOADED BY FTN.
  
 OVLA     ENTRY. 0L"FTNOVL"  NAME OF FTN (LIBRARY OR FILE)
          ENTRY  OVLB 
 OVLB     VFD    6/**,6/**,12/2140B,18/**,18/**    LOAD REQUEST WORD
 OVL10    ENTRY. 5LFTN10     TS MODE OVERLAY
 OVL20    ENTRY. 5LFTN20     OPTIMIZATION MODE PRIMARY OVERLAY
 OVL21    ENTRY. 5LFTN21     OPTIMIZATION MODE PASS 1 
 #OVL     IFEQ   .OVL,0 
 OVL22    ENTRY. 5LFTN25     FAX,REFMAP AND OPTIMIZATION PASS 2 
 #OVL     ELSE
 OVL22    ENTRY. 5LFTN22     OPTIMIZATION MODE PASS 2 
 #OVL     ENDIF 
 OVL23    ENTRY. 5LFTN23     OPTIMIZATION MODE ERROR MESSAGES 
 OVL24    ENTRY. 5LFTN24     DEBUG MODE PRIMARY OVERLAY 
 OVL25    ENTRY. 5LFTN25     FAX AND REFMAP OVERLAY 
  
 CMPSLDR  VFD    12/0100B,9/014B,3/0,18/**,18/CP.ORG
 CMPSOVL  DATA   0L"CP.NAME"       NAME OF *COMPASS* (1,0) OVERLAY
  
  
  
**        DEFINE MAIN TITLE LINE. 
* 
 .T       IFNE   TEST,0 
 MODLVL   MICRO  1,, "MODLVL" 
 MODLVL   MICRO  1,9,$"MODLVL"*T*      $
 .T       ENDIF 
 TARGET   MICRO  1,4,$"MODEL"    $
  
          ENTRY  O.TITL 
 O.TITL   BSS    0
  
          LIST   A
 TL.JECT  ENTRY. 10H1                            PRINTER SPACE CODE 
 TL.PTYP  ENTRY. 10H                             PROGRAM UNIT TYPE
 TL.PNAM  ENTRY. 10H                             PROGRAM UNIT NAME
 TL.CPU   DATA   10H  70/"TARGET"                PROCESSING CPUS
 TL.CCOP  ENTRY. 10H                             CONTROL CARD OPTIONS 
          DATA   10H
          DATA   10H
 O.TTLA   ENTRY. (10H  FTN "VER"+)                PROCESSOR NAME
          DATA   10H"MODLVL"                     PROCESSOR MOD LEVEL
 TL.DATE  ENTRY. 10H MM/DD/YY                    DATE 
 TL.TIME  ENTRY. 10H HH.MM.SS                    TIME OF DAY
          DATA    4APAGE
 TL.PAGE  ENTRY. 0                               PAGE NUMBER
          LIST   *
  
          ENTRY  L.TITL 
 L.TITL   =      *-O.TITL 
 L.TTLA   EQENT  *-O.TTLA-1  1ST TITLE LENGTH IN PW MODE
 L.TTLB   EQENT  O.TTLA-TL.PTYP-1  2ND TITLE LENGTH IN PW MODE
  
**        SET ENTRY POINT ADDRESS FOR OVERLAY DIRECTIVE PARAMETER 
#RM       IFEQ   CP#RM,7
          LOC    777B 
#RM       ELSE
          LOC    2777B
#RM       ENDIF 
 LDPT     BSS    0
          LOC    *O 
          TITLE  LOAD OVERLAYS
***       LOAD OVERLAYS.
* 
  
  
**        FORM 2-WORD LOADER REQUEST FOR LOADING *COMPASS* ASSEMBLER
*         (1,0) OVERLAY.
* 
          ENTRY  LDCOM
 LDCOM    SA5    LCM.FL 
          MX7    0
          BX6    X5 
          SA6    CP.NFLL     CP.NFLL = CP.AFLL , SO WE KEEP OUR LCM 
          SA7    GT1
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SYSTEM RPV,RCL,GT1 CANCEL REPRIEVE REQUEST
 #OS      ELSE
          REPRIEVE  GT1      CANCEL REPRIEVE REQUEST
 #OS      ENDIF 
          SA5    CP.NFLS     LWA SPACE AVAILABLE FOR LOADING
          SA4    CMPSOVL     NAME OF *COMPASS* (1,0) OVERLAY
          SA1    CMPSLDR     OVERLAY LEVEL, LDR FLAGS, FWA LOAD 
          LX5    18 
          BX6    X4 
          IX7    X1+X5
  
  
  
**        REQUEST OVERLAY LOAD. 
* 
*         ENTRY  (X4) = LIBRARY OR FILE NAME, -L- FORMAT
*                (X6) = OVERLAY NAME, -L- FORMAT
*                (X7) = LOADER REQUEST WORD 1, FORMAT --
*                       12/OVERLAY LEVEL (0P0S),
*                        9/LOADER REQUEST FLAGS,
*                        3/0, 
*                       18/LWA SPACE AVAILABLE TO LOADER, 
*                       18/FWA LOAD 
* 
          ENTRY  LOVER
 LOVER    BSS    0
  
          IFNE   TEST,0,1 
          SA6    LOVOVR      SAVE (X6) = OVERLAY NAME (0L FMT)
  
          SA7    RA.ORG      SAVE (X7) = LDR REQUEST WORD 1 
          SA6    LOVERM+1    OVERLAY NAME TO ERROR MESSAGE TEXT 
          IFNE   TEST,0,2 
          IFLE   CT.CPU,74,1
          SA6    IBAX        SAVE OVERLAY NAME FOR INDEX BUFFER SEARCH
          SB1    1
          SA7    LDRP+1      OVL LVL, FLAGS, ADDR TO LDR REQUEST WORD 1 
  
*         PROCESS 2-WORD LOADER CALL. 
  
 .LDR     IFEQ   LDRCALL,2
 .T       IFNE   TEST,0 
          BX6    X4          SUBSTITUTE FILE NAME FOR OVERLAY NAME
 .T       ENDIF 
          SA6    A7-B1       OVERLAY OR FILE NAME TO LDR REQUEST WORD 0 
 .LDR     ENDIF 
  
*         PROCESS 3-WORD LOADER CALL. 
  
 .LDR     IFEQ   LDRCALL,3
          SA6    A7+B1       OVERLAY NAME TO LDR REQUEST WORD 2 
          BX7    X4 
          SA7    A7-B1       LIBRARY OR FILE NAME TO LDR REQUEST WORD 0 
 .LDR     ENDIF 
  
          BX6    X6-X6
          SA6    RA.LDR      CLEAR LOADER COMMUNICATIONS CELL 
  
 .T       IFNE   TEST,0 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          CALL   OFFSPY      TURN -SPY- OFF 
  
*         SEARCH INDEX BUFFER FOR OVERLAY NAME AND SEE IF *LINK* HAS
*         FILLED IN THE DISK ADDRESS"S OF THE OVERLAYS DURING LOADING.
  
          SA1    IBA=+1 
          SA3    IBAX 
          SB2    2
  
 LOV1     BX2    X3-X1
          SA1    A1+B2
          NZ     X2,LOV1
  
          SA5    A1-B1
          ZR     X5,LOV2     IF NOT FOUND IN INDEX BUFFER 
  
*         (X5) = 18/LWA+1,18/FWA OF LOAD,24/DISK ADDRSSS OF OVERLAY 
*         SETUP A *FET* AND READ THE OVERLAY IN 
  
          MX0    -24
          SA3    OVLA        LFN
          SX7    12B         READ REQUEST 
          BX6    -X0*X5 
          SA6    LFET+6      DISK ADDRESS 
          AX5    24 
          SA4    LFET-1 
          BX6    X3+X7
          SB6    X5          (B6) = FWA OF LOAD 
          SA6    A4+B1       LFN + CODE 
          SX3    X5 
          BX7    X3+X4
          SA7    A6+B1       FIRST = FWA
          AX5    18 
          SX5    X5+100B
          SX7    X5+B1
          SA7    A7+B1       IN = OUT = LWA+1 
          SA7    A7+B1
          MX0    42 
          SA4    A7+B1
          BX4    X0*X4       PRESERVE FNT ADDRESS 
          SX7    X7+17B      LIMIT = LWA+2 + 77TBL LEN
          BX6    X4+X7
          SA6    A4 
          MX7    0
          SA7    B6          CONT(FWA) = 0 IN CASE WE DONT GET ANYTHING 
          SYSTEM CIO,R,LFET  ISSUE A READ REQUEST 
          SA2    LFET 
          SA3    B6 
          LX2    59-4 
          PL     X2,LOV6     IF NOT EOR/EOF 
          SB7    X3          (B7) = XFER ADDRESS
          AX3    48 
          SX4    X3-775000B 
          ZR     X4,LOV2A    IF A 50 TABLE
          SX4    X3-775400B 
          NZ     X4,LOV6     IF NOT A 54 TABLE
          SA5    A3+4 
          SB7    X5          (B7) = TRANSFER ADDRESS
          EQ     LOV2A
  
          ENTRY  IBA= 
 IBA=     VFD    42/,18/IBAX-*
          DATA   5LFTN10,0
          ECHO   1,X=(0,1,2,3,4,5)
          DATA   5L_FTN2_X,0
 IBAX     BSSZ   2           SEARCH TERMINATOR
  
          VFD    13/1,29/3,18/0 
 LFET     DATA   3LFTN
          BSSZ   7           REST OF THE FET
  
 LOV2     BSS    0
 #OS      ENDIF 
 .T       ENDIF 
  
          LOADREQ  LDRP,RCL  REQUEST OVERLAY LOAD 
          SA2    LDRP+1      LOADER REPLY WORD
          SB7    X2          (B7) = ENTRY POINT ADDRESS IN NEW OVERLAY
          LX2    59-36       LOADER ERROR STATUS BIT TO B59 
          MI     X2,LOV6     IF LOADER COULD NOT LOAD OVERLAY 
  
  
 LOV2A    BSS    0
  
 .T       IFNE   TEST,0 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
**        PAUSE BEFORE TRANSFERRING TO OVERLAY IF *SNAP=(OVL NR)* SET.
*         USEFUL FOR CONSOLE DEBUGGING.  ASSEMBLED ONLY IN TEST MODE. 
* 
          SA1    RA.ORG      (X1) = SAVED OVERLAY CONTROL FLAGS, ETC. 
          SA2    CO.SNAP
          MX6    -3 
          LX1    -39-9
          SA3    RA.SSW 
          BX7    -X6*X1      (X7) = SECONDARY OVERLAY NUMBER
          SB2    X7+1R0 
          LX2    B2 
          PL     X2,LOV4     IF THIS OVERLAY NUMBER NOT CHOSEN
          SX6    1S12 
          BX7    X3+X6
          SA7    A3          PAUSE BIT ON - TO WAIT FOR BREAKPOINT SET
 LOV3     RECALL
          SA1    RA.SSW 
          NO
          LX1    59-12
          MI     X1,LOV3     IF PAUSE BIT ON, LOOP ON RECALL
  
  
  
**        CALL P-MONITOR PPU PROGRAM *SPY*. 
* 
 LOV4     SA1    SPYW 
          SA2    RA.ORG      (X2) = SAVED OVERLAY CONTROL FLAGS, ETC. 
          ZR     X1,LOV5     IF *SPY* OPTION NOT SELECTED 
          AX2    48-0        (X2) = OVERLAY LEVEL 
          BX6    X1 
          ZR     X2,LOV5     IF (0,0) OVERLAY 
          SX7    X2-0200B 
          ZR     X7,LOV5     IF (2,0) OVERLAY 
          SA1    SPYO 
          MI     X7,LOV4A    IF (1,X) OVERLAY 
          SX7    X7+1L2-1L1 
          LX7    18 
          IX1    X7+X1       7LOVL020S
 LOV4A    BX7    X1 
          SA6    A1-B1       LIMITS TO SPY PARAM LIST 
          SA7    A6-B1       OVERLAY LEVEL TO LIST (SPYP) 
          SYSTEM SPY,RCL,A6 
  
*         HERE TO CHECK FOR CALL TO *IDP* VIA *BREAK=PS* CC OPTION. 
  
 LOV5     SA3    LOVOVR      (X3) = NAME OF OVERLAY TO BE LOADED(0L FMT)
          SA4    CMPSOVL     (X4) = NAME OF COMPASS OVERLAY (0L FMT)
          SA1    CO.BRK 
          SA2    RA.ORG 
          BX6    X3-X4
          AX2    48-0 
          SX4    2R00 
          ZR     X6,LOV5B    IF LOADING COMPASS, IDP NOT POSSIBLE...
*                              AVOID *COMPASS(1,0) LOOKS LIKE FTN(1,0)* 
          MX3    1
  
 LOV5A    MX0    -2*CHAR
          LX1    2*CHAR 
          BX6    -X0*X1 
          LX3    2*CHAR 
          ZR     X6,LOV5B    IF END OF OVR LIST OR (BREAK=PS) NOT SELECT
          MI     X3,LOV5B    IF FINISHED CHECKING ENTIRE WORD 
          IX7    X6-X4       (X7) = OVERLAY NRS IN (0P0S) FORM
          BX6    X7-X2
          NZ     X6,LOV5A    IF NOT CALLING *IDP* FOR THIS OVERLAY
          SB7    B7-1        SET TO *CALL IDP BEFORE NORMAL OVERLAY XEQ*
  
 LOV5B    BSS    0
  
 #OS      ENDIF 
 .T       ENDIF 
  
  
  
**        TRANSFER CONTROL TO NEWLY-LOADED OVERLAY. 
* 
          JP     B7          TO NEW OVERLAY 
  
  
  
**        PROCESS ERROR IN LOADING OVERLAY. 
* 
 LOV6     MESSAGE  LOVERM,,RCL
          EQ     END2        ABORT
  
  
 LOVERM   DIS    ,/CANT LOAD ....    /
  
  
  
          IFNE   TEST,0,1 
 LOVOVR   BSSZ   1           SAVED NAME OF OVERLAY TO BE LOADED (0L FMT)
 STOP     SPACE  4,8
**        *COMPASS* ASSEMBLER RETURN POINT. 
* 
 STOP     MX6    1
          SB1    1
          SA6    COMRET      INDICATE COMPASS CALLED
  
  
  
**        LOAD *FTN* PRIMARY OVERLAY. 
* 
 LDPRI    SA1    CO.TS
          ZR     X1,LD20
          LOVER  OVL10       TS MODE
  
 LD20     LOVER  OVL20       OPTIMIZATION MODE
          TITLE  TERMINATE COMPILATION
***       TERMINATE COMPILATION.
* 
  
  
          ENTRY  ENDFTN 
 ENDFTN   BSS    0
  
  
  
**        SEND COMPILATION TIME TO DAYFILE. 
* 
 .TIM     IFNE   CTIMO,0
          SA2    TIME0       START OF COMPILATION TIME
          CALL   CPTIM
          SA6    CPTMSG      TIME TO DAYFILE MESSAGE TEXT 
          MESSAGE   CPTMSG,,RECALL
 .TIM     ENDIF 
  
**        PROCESS ABNORMAL TERMINATION CONDITIONS.
* 
          SA1    CP.ERRCT 
          SA2    CP.ABORT 
          MX3    1
          LX3    59-29
          BX2    X2*X3
          SA4    CER.FL 
          NZ     X4,END1
          ZR     X1,END4     IF NO COMPILATION OR ASSEMBLY ERRORS 
          MI     X1,END4     IF DEBUG (D) OPTION ON 
 END1     ZR     X2,END4     IF ABORT(A) OPTION OFF 
  
 END2     ABORT  ,NODUMP,S   TO EXIT(S) WITH NO DUMP
  
  
  
**        PROCESS AUTO EXECUTE (GO-OPTION) REQUEST. 
* 
 END4     SA1    GOFLAG 
          ZR     X1,END5     IF GO-OPTION OFF 
          BX6    X1 
          SA6    RA.PGN      POST FILE/PROGRAM NAME FOR MSG AND LOADER
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          MEMORY SCM,LDRFL,RCL     RFL DOWN BEFORE CALLING LOADER 
 #OS      ENDIF 
          MX7    0
          SA7    GT1         CLEAR REQUEST/REPLY CELL FOR *RPV* 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SYSTEM RPV,RCL,GT1 CANCEL REPRIEVE REQUEST
 #OS      ELSE
          REPRIEVE  GT1      CANCEL REPRIEVE REQUEST
 #OS      ENDIF 
  
          MESSAGE   RA.PGN,,RCL 
          LOADREQ   0 
+         EQ     *           WAIT FOR OP SYS TO PICK UP REQUEST 
  
  
  
**        TERMINATE COMPILATION NORMALLY. 
* 
 END5     ENDRUN
          SPACE  4
 #RM      IFEQ   CP#RM,0
  
*         TABLE OF SCRATCH FILES TO BE EVICTED AT END OF COMPILATION
*         MODIFIED AT THE END OF INITIALIZATION WHEN ALL CONTROL
*         CARD OPTIONS ARE KNOWN
  
          ENTRY  SCRTBL 
 SCRTBL   CON    F.RLST 
          CON    F.RMAP 
          CON    F.OPT
          CON    F.CMPS 
          DATA   -1                TABLE TERMINATOR 
  
 #RM      ENDIF 
          TITLE  RESIDENT SUBROUTINES 
 OFFSPY   SPACE  4,8
 .T       IFNE   TEST,0 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
**        OFFSPY - TURN OFF P-MONITOR PPU PROGRAM *SPY*.
* 
*         ENTRY  NO REGISTER REQUIREMENTS.
* 
*         EXIT   *SPY* IS TURNED OFF. 
* 
*         USES   X - 1, 2, 6
*                A - 1, 6 
*                B - NONE 
* 
*         CALLS  RECALL (WNB=)
  
  
 OFFSPY   ENTRY. **          ** ENTRY/EXIT ** 
          SA1    SPYP+1 
          ZR     X1,OFFSPY   IF *SPY* NOT ON, EXIT
          MX6    1
          SA6    A1          TELL *SPY* TO STOP 
          RECALL A1 
          BX6    X6-X6
          SA6    SPYP+1 
          EQ     OFFSPY      EXIT 
  
  
  
 SPYW     BSSZ   1                       CONTROL CARD (W-OPT) PARAMS
*         *SPY* REQUEST PARAMETER LIST
 SPYP     BSSZ   1           7LOVL0P0S
          BSSZ   1           12/BINW,12/:,12/LO,12/HI,12/0
 SPYO     DATA   7LOVL0100
  
 #OS      ENDIF 
 .T       ENDIF 
 REALDEC  SPACE  4,8
 .CT      IFNE   CTIMO,0
  
**        REALDEC - BINARY TO DISPLAY CODE CONVERSION.
* 
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED
*                (B4) = 6 * NEGATIVE OF SCALE FACTOR
* 
*         EXIT   (X6) = DPC CONVERSION, RIGHT JUSTIFIED, SPACE FILLED 
* 
*         USES   X - ALL BUT X0 
*                A - 3, 4, 5
*                B - 2, 3, 4
* 
*         CALLS  NONE 
  
  
 RLD2     LT     B2,B4,RLD4  IF DECIMAL POINT NOT YET APPENDED
          LX3    -6 
          LX6    X3,B2
  
 REALDEC  ENTRY. **          ** ENTRY/EXIT ** 
          SB3    6
          SA5    RLDA        (X5) = 0.1P48+1
          SB2    B0 
          PX1    X1 
          SX4    10 
          MX7    1
          PX4    X4          (X4) = 10.0
          SA3    RLDC        (X3) = 10H 
 RLD3     DX6    X5*X1       (X6) = FRACTIONAL PART 
          FX1    X5*X1       (X1) = INTEGRAL PART 
          ZR     X7,RLD2     IF REMAINING DIGITS ARE ZERO 
 RLD4     LX3    -6 
          SB2    B2+B3
          FX2    X6*X4             DIGIT = 10.0*B 
          NX7    X1 
          SX6    X2+1R0-1R       CONVERT DIGIT TO DISPLAY CODE. 
          IX3    X6+X3
          NE     B2,B4,RLD3  IF DECIMAL POINT NOT NEEDED YET
          SX6    1R.-1R 
          LX3    60-6 
          SB2    B2+B3
          IX3    X3+X6
          EQ     RLD3 
  
*         CONVERSION CONSTANTS. 
  
 RLDA     CON    0.1P48+1 
 RLDC     CON    1H 
          SPACE  4
**        CPTIME - COMPUTE AND CONVERT ELAPSED CPU TIME.
* 
*         ENTRY  (X2) = CPU START TIME IN MILLISECONDS
* 
*         EXIT   (X6) = DPC ELAPSED TIME
* 
*         CALLS  TIMER, REALDEC 
 CPTIM    ENTRY. **          ** ENTRY/EXIT ** 
          CALL   TIMER       RETURNS (X6) = CURRENT CPTIME
          SB4    3*CHAR      (B4)= -REALDEC- SCALE FACTOR, 1.0E-3 
          IX1    X6-X2       (X1) = ELAPSED TIME (BINARY) 
          CALL   REALDEC     RETURNS (X6)=ELP. TIME(DISPLY CODE)
          EQ     CPTIM       EXIT.
  
 TIMER    SPACE  4,8
**        TIMER - OBTAIN ACCUMULATED CPU TIME.
* 
*         TIME IS CONVERTED INTO AN INTEGRAL NUMBER OF MILLISECONDS.
* 
* 
*         ENTRY  NO REQUIREMENTS
* 
*         EXIT   (X6) = CURRENT CPU TIME
* 
*         USES   X - 0, 3, 4, 5, 6
*                A - 5
*                B - NONE 
* 
*         CALLS  TIME 
  
  
 TIMER    ENTRY. **          ** ENTRY/EXIT ** 
          TIME   GT1
          SA5    GT1
          MX0    60-12
          BX4    -X0*X5      MSEC 
          AX5    12 
          SX3    1000D       SEC * 1000 
          MX0    36 
          BX5    -X0*X5 
          IX3    X5*X3
          IX6    X3+X4
          EQ     TIMER
  
  
  
 TIME0    ENTRY. 0           COMPILATION START TIME 
 TIME1    ENTRY. 0
 CPTMSG   DIS    ,*   NNN.NNN CP SECONDS COMPILATION TIME*
  
  
 .CT      ENDIF 
  
  
  
**        END OF RESIDENT CODE IN (0,0) OVERLAY.
          SPACE  4
          USE    FTNINIT
