ASMB,Q,C
      HED ** 16K FTN4 COMPILER (F4.2:PASS2) **
      NAM F4.2,5 92060-16096 REV.2026 800423
* 
*************************************** 
*     FORTRAN-4 COMPILER OVERLAY 2
*************************************** 
* 
*     THIS OVERLAY TRANSLATES THE PSEUDOCODE GENERATED BY 
*   PASS 1 INTO RELOCATABLE BINARY, GENERATES THE ASSEMBLY
*   LISTING, AND LISTS THE ASSIGNMENT TABLE.
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
*     NAME:   F4.2, PART OF FTN4 COMPILER.                    * 
*     SOURCE: 92060-18096                                     * 
*     RELOC:  92060-16096                                     * 
*     PGMR:   BILL GIBBONS.                                   * 
*************************************************************** 
* 
*     EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS 
* 
*     THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS 
*     DEFINED IN AS FOLLOWS 
*                2 -- OA.F  (WRITE PASS FILE ROUTINES)
*                 3 -- NEX.F  (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) 
*                  4  -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) 
*                   5  -- EX.F  (STATEMEXTS USING THE EXPRESSION EVALUATOR) 
*                    6  -- IC.F  (THE CHARACTER INPUT ROUTINES) 
*                     7  -- IDN.F   (THE TOKEN INPUT ROUTINES)
*                      8  -- FTN4    ( THE MAIN)
       EXT F..DP    BASE OF SYMBOL TABLE
   EXT     F.A      ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY)
     EXT   F.ABT    ABORT COMPILE EXTRY 
   EXT     F.AF     ADDRESS FIELD CURREXT F.A 
   EXT     F.AT     ADDRESS TYPE OF CURREXT F.A 
     EXT   F.CC     CHARACTER COUNT 
       EXT F.CCW    FTN OPTION WORD 
       EXT F.D      DO TABLE POINTER
   EXT     F.D0     ARRAY ELEMEXT SIZE
      EXT  F.DID    ADDRESS OF F.IDI
   EXT     F.DNI    ADDRESS OF NID
       EXT F.DO     LWAM - END OF DO TABLE
   EXT     F.DP     BASE OF USER SYMBOL TABLE 
       EXT F.END    END FLAG
     EXT   F.ERF    ERROR FLAG (# OF ER.F CALLS)
      EXT  F.IDI    INPUT ARRAY NON-NUMERIC 
   EXT     F.IM     CURREXT ITEM MODE (REAL, COMPLEX,ECT.)
   EXT     F.IU     CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) 
     EXT   F.LFF    LOCICAL IF FLAG 
       EXT F.LSN    F.A OF LAST STATEMEXT NUMBER
       EXT F.LSP    LAST OPERATION FLAG 
   EXT     F.NT     NAME TAG  0= VAR, 1=CONSTANT. 
   EXT     F.NW     NO. WORDS THIS TABLE F.A EXTRY. 
   EXT     F.R      JSB ERR0 FLAG 
       EXT F.RPL    PROGRAM LOCATION COUNTER
       EXT F.SBF    0= MAIN, ELSE SUBROUTINE
       EXT F.SEG    LOAD A NEW SEGMENT
       EXT F.SFF    SUBROUTINE/FUNCTION FLAG 0/1
       EXT F.SPF    SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL 
* 
*     EXT'S WITH A TRAILING '.F' ARE SUBROUTINES
* 
       EXT AA.F     ASSIGN ADDRESS SUB. 
   EXT     AI.F     ASSIGN ITEM 
     EXT   CRP.F    CROSS REF PAIR SUB. 
   EXT     DAF.F    DEFINE (F.AF) 
   EXT     DIM.F    DEFIND (F.IM) 
   EXT     DIU.F    DEFINE (F.IU) 
   EXT     DL.F     DEFINE LOCATION SUBROUTINE
     EXT   ER.F     ERROR PRINT SUBROUTINE
   EXT     ESC.F    ESTABLISH CONSTANT SUBROUTINE 
   EXT     FA.F     FETCH ASSIGNS 
   EXT     FID.F    FETCH (ID) TO NID (UNPACK)
   EXT     GNA.F    GET NEXT SYMBOL TABLE EXTRY 
   EXT     NTI.F    MOVE NID TO F.IDI (PACKS) 
 EXT       OAI.F    OUTPUT ABS. INSTRUCTION 
 EXT       OC.F     OUTPUT CONSTANT 
 EXT       ODF.F    OUTPUT DOT FUNCTION 
 EXT       OLR.F    OUTPUT LOAD ADDRESS 
 EXT       OS.F     OUTPUT SECTOR TO INTERPASS FILE 
 EXT       PDF.F    PRODUCE DEF SUBROUTINE
     EXT   PSL.F    PRINT LINE ON PRINTER 
  EXT      PTM.F    PROGRAM TERMINATION CODE GEN. 
  EXT      RTN.F    SUBROUTINE RETURN HANDLER 
     EXT   SKL.F    SKIP LINES ON LIST
     EXT   WAR.F    ERROR COMMEXT SUBROUTINE (WARNINGS) 
* 
*     LIBRARY UTILITIES 
* 
      EXT .MVW      MOVE WORDS MACRO
* 
* 
*     OPSYSTEM INTERFACE: 
* 
      EXT EOF.C 
      EXT C.SC1 
*     COMPILER LIB ROUTINES 
* 
* 
* 
      SUP 
      SPC 1 
A     EQU 0 
B     EQU 1 
      SPC 1 
.TBL  EQU 0 
      SPC 1 
      DEC 2         OVERLAY # 
      SKP 
*         ***************** 
*         * END PROCESSOR * 
*         ***************** 
      SPC 1 
*     ASSIGN ADDRESSES TO CONSTANTS 
*     OUTPUT END RECORD FOR LOADER
      SPC 1 
F4.2  ISZ F.END     SET THE END FLAG
      LDB F.LFF 
      LDA K88       88
      SZB           TRUE BRANCH OF LOGICAL "IF"?
      JSB ER.F      YES. BITCH. 
* 
      CCA           SET UP TO 
      STA F.A       FLUSH THE 
      JSB CRP.F     FINAL CROSS REFERENCE PAIR
      LDB F.D       LOC OF LAST DO ENTRY IN DO TABLE
DTCK1 STB T2STF     SAVE DO TABLE PTR 
      CPB F.DO      END OF DO TABLE SEARCH? 
      JMP DTCK5     YES.
      LDA F.LSN     IS THIS STATEMENT # A DO TERM?
      CPA B,I 
      JMP DTCK3     YES. GRIPE. 
* 
      LDB T2STF     OTHERWISE IT IS 
      LDB B,I       SURLY UNDEFINED 
      LDA B,I 
      IOR K8        SO SET THE USED FLAG
      STA B,I       SO IT IS REPORTED LATER 
DTCK2 LDB T2STF     COMPUTE ADDRESS OF NEXT ENTRY 
      ADB K5
      JMP DTCK1 
      SPC 1 
DTCK3 LDA K30.      30
      JSB WAR.F     ILLEGAL DO TERMINATOR 
      JMP DTCK2     CONTINUE THE SCAN 
* 
DTCK5 LDB F.LSN 
      STB F.A       SET F.A INCASE STMT. NUMBER 
      SZB 
      JSB DL.F      DEFINE AF=RPL FOR ST# LOC.
      CCA           SET FLAG
      STA F.CC      TO USE SHORT FORM ERROR MESSAGE 
      LDB F.SPF     GET CURRENT STMT. LEVEL 
      ADB KM3       TEST IF MORE THAN JUST SPECS AND DATA 
      LDA F.SFF     IF BLOCK DATA SUBPROGRAM
      CPA K2        THEN
      CMB           CHANGE SENSE OF TEST
      SSB           IF PROGRAM AND NO EXECUTABLE OR BLOCK DATA WITH 
      JMP ENDP1     THEN GO SEND ERROR
* 
      SZB,RSS       IF JUST STMT. FUNCTIONS 
      CPA K2        AND NOT BLOCK DATA
      JMP ENDP0     THEN
* 
      LDA K78       BITCH 
      JSB WAR.F     ERROR 78: NO EXECUTABLE STMTS 
ENDP0 CLA,INA 
      JSB SKL.F     SKIP TWO LINES
      LDB F.LSP     IF NO PATH
      ADB F.LSN     THEN SET B TO SHOW
      LDA F.SBF     SUBPROGRAM FLAG SET?
      STA F.A 
      SZA,RSS 
      JMP ENDP8     NO, MAIN; GENERATE STOP CALL
* 
      SZB           IF NO PATH TO HERE NO RETURN NEEDED 
      JSB RTN.F     RETURN HANDLER
      JSB FA.F      FETCH ASSIGNS 
      LDA F.IU
      LDB F.SFF     IS IT A FUNCTION? 
      SZB 
      XOR VAR       YES.      THIS AREA (64 WORDS) USED FOR XREF BUFFER 
      LDB A 
      LDA K46 
      SZB 
      JSB WAR.F     FUNCTION NAME NOT USED OR 
      JMP ENDP3     SUBROUTINE NAME USED
      SPC 1 
ENDP8 LDA F.SFF     IF BLOCK DATA SUBPROGRAM
      CPA K2        THEN
      JMP ENDX3     SKIP REST OF THE END STMT. PROCESSING 
* 
      SZB           IF NO PATH TO HERE SKIP TERM CALL 
      JSB PTM.F     GEN PROG TERMINATE EXEC CALL
ENDP3 LDA F.DP
      STA F.A       F.A=DATA POOL START ADDRESS 
ENDP4 CLA           CLEAR 
      STA IGNOR     THE IGNOR SWITCH FOR LABEL GEN. 
      JSB GNA.F     GET NEXT F.A
      SSA,RSS 
      JMP ENDP6     END OF ASSIGNMENT TABLE 
      JSB FA.F      FETCH ASSIGNS 
      LDA F.NW      # OF WORDS IN ENTRY 
      ADA KM3       -3
      SSA 
      JMP ENDP4     1 OR 2-WORD ENTRIES 
* 
      LDA F.A,I     IF NOT USED 
      AND K8        DON'T OUTPUT
      CMA,CLE,INA   SET E IF NOT REFERENCED 
* 
      LDA F.NT
      SZA 
      JMP ENDP5     CONSTANT
* 
      LDB F.IU      IF ARRAY
      CPB SUB       IF SUB
      JMP ENDP4     THEN IT IS OK 
* 
      CPB ARR       THEN
      JMP ENDP4     ALREADY DEFINED 
* 
      CPA F.IU
      JMP ENDP9     F.IU=0, STATEMENT # 
* 
      LDA F.AT      IF
      CPA REL       ALREADY DEFINED 
      ISZ IGNOR     SET SWITCH
      SEZ,RSS       IF REFERENCED 
      JSB AA.F      ASSIGN ADDR TO VARIABLES
      LDA F.AF      GET CURRENT LOAD ADDRESS
      RAL,CLE,SLA,ERA  THEN 
      INA,RSS       IT POINTS TO A SYMBOL WITH
      JMP ENDPI 
* 
      LDA A,I       OFFSET AS THE VALUE 
      LDB F.A       GET OFFSET
      ADB K2        FROM THE ENTRY
      LDB B,I       AND 
      RBL,CLE,ERB   CLEAR THE SIGN
      ADA B         PUT FINAL ADDRESS IN A
      JSB DAF.F     DEFINE ADDRESS OF THIS SYMBOL 
ENDPI LDA F.IM      IF
      CPA ADR       ADDRESS 
      RSS           SKIP
      JMP ENDP4 
      SPC 1 
      LDA IGNOR     IF ADDRESS AND ALREADY DEFINED
      SZA,RSS       NO NOT ALREADY DEFINED
      JMP ENDP4     FORGET IT 
* 
      LDA TWPE      ELSE DEFINE AS A PGM TMP
      JSB DIM.F     AND 
      CCB           GIVE IT 
      ADB TWA       A NAME
      STB TWA 
      LDA F.A 
      ADA K2
      STB A,I 
      JMP ENDP4 
* 
K2    DEC 2 
K5    DEC 5 
KM3   OCT -3
TWA   OCT -4000 
ADR   OCT 70000 
K66   DEC 66
K88   DEC 88
T2STF NOP 
IGNOR NOP 
K8    DEC 8 
K30.  DEC 30
K78   DEC 78
K46   DEC 46
REL   OCT 1000      AT =1 
ARR   OCT 600 
SUB   OCT 200 
VAR   OCT 400 
INT   OCT 10000 
REA   OCT 20000 
DIM   OCT 6000      AT=6=DIMENSION
B20   OCT 20
      SPC 1 
ENDP1 LDA K66 
      JSB WAR.F     PROGRAM/FUNCTION WITHOUT BODY 
      JMP ENDP0     OR BLOCK DATA WITH EXECUTABLE STATEMENTS
      SPC 1 
ENDP5 LDA F.IU
      CPA VAR 
      RSS 
      JMP ENDP2     GO TEST IF DIM ENTRY
* 
      LDA F.AT
      SEZ,RSS       IF NOT REFERENCED OR
      CPA REL       ALREADY DEFINED 
      JMP ENDP4     ALL IS OK  ON TO THE NEXT ONE 
* 
      LDA F.R       IF ALREADY DEFINED
      SZA           SKIP
      JMP ENDP4     REDEFINITION
* 
      JSB OLR.F     OUTPUT L.A.=RPL 
      LDA F.IM      IF F.IM = 0 THEN A DEF
      SZA,RSS       SO
      JMP END05     PROCESS AS SPECIAL
* 
      LDA F.A 
      JSB OTC.F     OUTPUT CONSTANT 
      JMP ENDP4     CONTINUE SYMBOL TABLE SCAN. 
* 
*     ********************************
*     * ROUTINE TO OUTPUT A CONSTANT *
*     ********************************
* 
OTC.F NOP 
      STA F.A       SET THE A.T. ADDRESS
      JSB FA.F      FETCH ASSIGNS 
      LDA F.R       HAS THIS CONSTANT ALREADY 
      SZA,RSS       BEEN ALLOCATED A LOCATION?
      JSB DL.F      NO  SO DO IT NOW
      LDA F.A,I     FLAG IT DONE
      IOR B20       TO PREVENT
      STA F.A,I     UN NEEDED DUPUPS
      LDA F.A       MOVE THE CONSTANT 
      ADA K2        TO
      LDB F.DID     F.DID 
      JSB .MVW      FOR OUTPUT
      DEF F.D0+0    FOR OUTPUT
      NOP 
      JSB OC.F      SEND IT 
      JMP OTC.F,I   RETURN
* 
* 
*     ************************************************* 
*     * ROUTINE TO ESTABLISH A CONSTANT AND OUTPUT IT * 
*     ************************************************* 
* 
* 
*     ENTER E=0 FOR REAL, E=1 FOR INT, A,B= VALUE 
* 
BIC.F NOP           BUILD INTEGER CONSTANT
      DST F.IDI     SET ITS VALUE 
      LDA INT       GET THE TYPE
      SEZ,RSS       IF TO BE REAL 
      LDA REA       GET TYPE
      JSB ESC.F     ESTABLISH CONSTANT
      JSB AI.F      ASSIGN IT 
      LDA F.A       AND 
      JSB OTC.F     OUTPUT IT 
      JMP BIC.F,I   RETURN A=0,E=1
* 
* 
ENDP2 LDA F.AT      IF THIS IS A DIM ENTRY
      CPA DIM       THEN
      SEZ           SKIP
      JMP ENDPE     ELSE CONTINUE SEARCH
* 
      LDB F.AF      SAVE THE ADDRESS OF THE BCOM
ENDPF LDA B,I       HAS THE BCOMI ENTRY BEEN REFORMATED YET?
      AND B20       YES IF NON ZERO 
      CMA,CLE,INA   PUT RESULT IN E (SET IF NEEDS TO BE REFORMATED
      LDA B,I       SET BIT NOW 
      IOR B20       IN
      STA B,I       ANY CASE
      INB           SET UP ADDRESS
      STB DAD       IN ANY CASE 
      SEZ,RSS       WELL? 
      JMP ENDPH     YES DO NOT REARRANGE
* 
      DLD DAD,I     GET THE TWO WORDS 
      SWP           SWITCH THEM 
      DST DAD,I     AND RESTORE 
DAD   EQU *-1 
ENDPH ISZ DAD       POINT ADDRESS AT THE RIGHT WORDS
      LDA F.RPL     REFERENCED DIM ENTRY
      JSB DAF.F     MUST BE EMA- TABLE REFERENCE
      JSB OLR.F     DEFINE LOAD ADDRESS (SETS E)
      LDA F.A       SAVE DIM ADDRESS
      STA T2STF     IN TEMP 
      ADA KM1       COMPUTE ADDRESS 
      ADA F.NW      LAST DIMENSION ADDRESS
      STA T1STF     AND SAVE IT ALSO
      LDA F.IM      GET THE NUMBER
      ALF           OF DIMENSIONS 
      STA T3STF     AND SAVE IT 
      STA T4STF     ALSO AS FLAG. 
      JSB BIC.F     SEND FIRST WORD OF THE TABLE
      LDA T3STF     GET DIMENSION COUNT 
      CMA,INA,SZA,RSS SET NEGATIVE
      JMP ENDPG     IF ZERO DIM CASE GO DO OFFSET 
* 
      STA T3STF     AND SET AS COUNTER
ENDPB CCA,CCE       START LOOP
      JSB BIC.F     BUILD A -1 AND SEND IT
      ISZ T3STF     ONLY ONE DIM.?
      JMP ENDPC     NO GO SEND DIM VALUE. 
* 
      LDA T2STF     GET F.A OF DIM ENTRY
      ADA K2        INDEX TO F.DAY
      STA BIC.F     SAVE THE ADDRESS
      LDA A,I       SHOULD BE #WORDS PER ELEMENT
      LDB DAD       CACULATE ADDRESS OF BCOMI ENDTRY
      ADB KM2       AND 
      STB BIC.F,I   SET IT IN F.DAY FOR SYMBOL TABLE LIST 
* 
* 
*                   NOTE WE ARE LOSING THE NO. WORDS/ELEMENT HERE BUT 
*                   WE MUST KEEP A POINTER TO THE BCOMI ENTRY SO
*                   THAT THE OFFSET MAY BE PRINTED WITH THE SYMBOL TABLE
*                   LIKE WISE THE POINTER TO THE BCOMI ENTRY SLOT IN
*                   THE DIM ENTRY IS NOW THE LOAD ADDRESS OF THE TABLE
*                   EVEN SO THE S.T. PRINT ROUTINE MUST BE CAREFUL IN 
*                   READING THIS INFORMATION AS THE F.AF CAN NOT
*                   BE TRUSTED FOR ARRAYS IN LABELED COMMON.
*                   TO MAKE IT WORST THE ENTRY IS CHANGED ONLY IF 
*                   THE ARRAY WAS REFERENCED AT SOME POINT AND THUS 
*                   REQUIRED A TABLE ENTRY. 
* 
*                   IS THAT CLEAR?
* 
* 
      JSB BIC.F     PUT IT IN THE TABLE 
ENDPG DLD DAD,I     GET THE OFFSET
      SSA           DUMMY ? 
      JMP ENDPK     YES.
      CLE,ERB       PACK THE NUMBER 
      RAL,ERA       TO A DOUBLE INTEGER (CLEARS E)
      JSB BIC.F     SEND THE DOUBLE WORD
ENDPJ LDA T2STF     RESTOR
      STA F.A       F.A AND 
      JMP ENDP4     CONTINUE THE SCAN.
ENDPK LDA T4STF     DUMMY. CHECK IF ZERO-DIM CASE.
      SZA,RSS       AND PICK WHICH TEMP TO GENERATE.
      LDB DAD,I 
      CMB           ASSIGN TEMP.
      STB F.A 
      JSB DL.F      ASSIGN TEMP HERE. 
      CLA 
      JSB OAI.F 
      JSB OAI.F 
      JMP ENDPJ 
* 
BCOMI OCT 7000
* 
ENDPE CPA BCOMI     IF BCOMI ENTRY
      CLA,SEZ       AND REFERENCED
      JMP ENDP4     (NOPE  CONTINUE)
* 
      STA F.IM      SET TO USE ZERO DIM.
      LDB F.A       GET ADDRESS TO B
      JMP ENDPF     AND GO DO IT
* 
* 
ENDPC CCA           CACULATE DIMENSION ADDRESS
      ADA T1STF     AND 
      STA T1STF     SAVE FOR NEXT TIME
      LDA A,I       GET A.T. ADDRESS OF CONSTANT
      LDB A,I       CHECK IF NAMED. 
      SSB,RSS 
      JMP ENDPL     IF SO, IS TEMP FOR VAR DIM. 
      JSB OTC.F     AND PRODUCE IT
      JMP ENDPB     GO CONTINUE LOOP
ENDPL STA F.A       VAR DIM. ALLOCATE TEMP. 
      JSB DL.F      ASSIGN TEMP HERE. 
      CLA 
      JSB OAI.F 
      JMP ENDPB 
* 
* 
END05 JSB PDF.F     PRODUCE A DEF 
      JMP ENDP4     GO GET NEXT ENTRY 
      SPC 1 
ENDP6 LDA F.DP      NOW SCANN FOR THE ASCII STRINGS 
      STA F.A       THEY WILL HAVE F.AF < 0.
ENDX1 JSB GNA.F     AND WILL BE EITHER
      SSA,RSS       F.IM=TWPE,,OR 0 (STATEMENT # FOR FORMAT STMT.)
      JMP ENDX9     END OF TABLE  DONE
* 
      JSB FA.F      FETCH ASSIGNS.
      LDA F.AT      IT WILL HAVE F.AT=
      CPA REL       REL 
      RSS           GOOD
      JMP ENDX1     NOT THIS ONE TRY NEXT 
* 
      LDA F.IM      NOW TEST THE F.IM 
      SZA           ZERO OR 
      CPA TWPE      A TWO WORD ONE
      RSS           GOOD
      JMP ENDX1     NO  TRY NEXT ONE
* 
      LDA F.AF      MUST BE <0 FOR WHAT WE WANT 
      CMA,SSA,INA   SET POS AND TEST
      JMP ENDX1     NOT THIS ONE TRY NEXT 
* 
      ADA F.RPL     UPDATE THE PROGRAM SIZE 
      STA T1FBL     SAVE IT 
      LDA F.RPL     SET 
      JSB DAF.F     THE AF FOR THIS GUY 
      LDA T1FBL     NOW 
      STA F.RPL     PUSH THE LOCATION COUNTER 
      SSA,RSS       IF OVERFLOW SKIP
      JMP ENDX1     TRY NEXT ENTRY
* 
      JMP ENDX2     ABORT THE COMPILE 
* 
T1FBL NOP 
T1STF NOP 
T3STF NOP 
T4STF NOP 
B1000 OCT 1000
.BAD. DEF .TBL+50 
KM1   DEC -1
KM2   DEC -2
* 
ENDX9 LDB .BAD. 
      LDA F.ERF     # OF ERRORS IN COMPILATION
      SZA 
      JSB ODF.F     'JSB .BAD.' 
      CLA 
      JSB SKL.F     YES, SKIP A LINE. 
ENDX3 LDA F.CCW     IS FOUR-WORD DOUBLE IN EFFECT?
      AND B1000 
      SZA,RSS 
      JMP CRSEC     NO, DONE. GO EXIT SEGMENT.
      LDA F..DP     YES.  CHANGE NAMES IN FIX-EXT TBL 
      STA F.A       F.A=BASE LOC OF FIX-EXT-TBL 
SWAP0 JSB GNA.F     GET NEXT F.A
      SSB,RSS       IS IT IN FIX TBL??
      JMP CRSEC     NO. DONE. GO EXIT SEGMENT 
* 
      LDB F.A 
      ADB K2
      LDA B,I       RENAME THE DOUBLE ROUTINES
      CPA "SN"      IF SINGLE 
      LDA ".N"        CHANGE TO '.NGLE' 
      CPA "ID"      IF IDINT, 
      LDA "/T"        CHANGE TO '/TINT' 
      CPA "DD"      IF DDINT, 
      LDA ".Y"        CHANGE TO .YINT 
      STA T2STF     SAVE FIRST TWO CHAR.
      AND C377      ISOLATE HIGH CHAR 
      CPA "D"       IS IT A 'D'?
      LDA "."       YES CHANGE TO '.' 
      XOR T2STF     MUDLE BACK IN 
      AND C377      THE LOW BYTE
      XOR T2STF     THERE I THINK THAT IS RIGHT 
      STA B,I       SET IT BACK IN THE FIX-EXT TABLE
      JMP SWAP0 
* 
C377  BYT 377 
"SN"  ASC 1,SN
"D"   OCT 42000 
"."   OCT 27000 
".N"  ASC 1,.N
"ID"  ASC 1,ID
"/T"  ASC 1,/T
"DD"  ASC 1,DD
".Y"  ASC 1,.Y
TWPE  OCT 40000     F.IM=4 DUMMY TWO WORD ENTRY 
* 
* 
ENDP9 LDA F.AT      CHECK FOR UNDEFINED ITEMS.
      CPA REL 
      JMP ENDP4 
      CPA DUM 
      JMP ENDP4 
      LDA F.A 
      CPA F.SBF 
      JMP ENDPA     SUBROUTINE NAME 
* 
      JSB FID.F     UNPACK THE SYMBOL 
      JSB NTI.F     NOW PACK IT BACK TO F.IDI 
      LDA F.DNI,I   GET FIRST CHAR. 
      CPA K64       STMT # ?
      CLB,INB,RSS   YES.
      JMP ENDP4 
      LDA F.DID 
      ADB ENDK3 
      JSB .MVW      COPY ASCII STMT # 
      DEF K3
      NOP 
      ISZ ER.F      LOG AS AN ERROR 
      LDA K32       INVALID STMT. NO. (UNDEFINED) 
      JSB WAR.F     SEND THE MESSAGE
      LDA K10.. 
      LDB ENDK3     "UNDEFINED" 
      JSB PSL.F     PRINT OUT UNDEFINED MESSAGE 
      ISZ F.ERF     F.ERF=F.ERF+1 
      JMP ENDP4 
      SPC 1 
K32   DEC 32
* 
ENDPA LDA VAR 
      JSB DIU.F     F.IU=VAR. 
      JSB DL.F      DEFINE LOC. 
      LDA F.RPL 
      ADA F.D0
      STA F.RPL     RPL=F.D0+RPL
      SSA,RSS 
      JMP ENDP4     ALL OK
* 
ENDX2 LDA K84       RPL OVER FLOW 
      JMP F.ABT     ABORT 
* 
      SPC 2 
ENDK3 DEF *+1 
      ASC 10,          UNDEFINED
K10.. DEC 10
K3    DEC 3 
K64   DEC 64
K84   DEC 84
DUM   OCT 5000
      SPC 2 
      SPC 1 
*     UPDATE THE FOLLOWING WHEN REVISING THE COMPILER:
* 
ENDK5 DEF CMPID 
CMPID DEC 25        WORDCOUNT OF FOLLOWING TEXT 
      ASC 18,  FTN4 COMPILER: HP92060-16092 REV.
      ASC 7,2026 (800423) 
* 
*        *------------------------* 
*        *     START HERE.        * 
*        *------------------------* 
* 
CRSEC JSB OS.F      OUTPUT THE FINAL SECTOR 
      JSB EOF.C     END FILE  I- FILE 
      DEF C.SC1 
      JMP PASSE     ERROR  SEND 99 ERROR
* 
      LDB ENDK5     PRINT THE COMPILER ID 
      LDA B,I       NOW 
      INB 
      JSB PSL.F 
      CLA 
      JSB SKL.F     SKIP A LINE 
      LDB K5        PASS CONTROL TO SEGMENT 5 TO DO PASS2 
      JMP F.SEG     THERE SHE GOES! 
* 
PASSE LDA K99       ERROR ON EOF
      JMP F.ABT     ABORT THE COMPILE 
* 
K99   DEC 99
      END F4.2
                                                    