*DECK     LEX 
          IDENT  LEX
 LEX      SECT   (LEXICAL SCANNERS),1 
  
          SST    A,B,C,D,Z,EXIT.
          NOREF  A,B,C,D,Z,EXIT.
  
 B=LEX    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  TAB.NX,TAB.STR,TAB.LP,TAB.RP,TAB.DOL,TAB.=,TAB.CO
          ENTRY  S.END,S.PAUSE,S.ERR,S=BIN,S=INP,S=OUT,S=COD,S=CONT,SLT 
          ENTRY  S=STR,S.BUFIO,S.IOCAL,S.ENDFI,S.REWIN,S.BKSP 
          ENTRY  TAB.PD,NAT.TYP,S.Q2NTR,TAB,S.ACGOR,TRV,THC,TSC 
          ENTRY  S.NLST,S.RANDM,TSF,DEC,STY,S=FREE
          ENTRY  BLANK,OCT,TLV
          ENTRY  S.FTNRP
  
*         IN FTN
          EXT    LOP=R
  
*         IN TABLES 
          EXT    CALL,DOORD,FIRSTV,ICONL,LG.LOG,LOGT,MULS,MAPCHAR,REFVAR
          EXT    TS=CON,TS.CON,TS.SYM,TS.STN,ZLPAREN,ZLEQUAL,ZLCOMMA
  
*         IN ERRORS 
          EXT    CLASS,E.DC,E.DC1,E.DC2,E.DC3,E.DC6,E.DC8,E.DC9,E.HC1 
          EXT    E.HC2,E.HC3,E.HC4,E.LP1,E.LP2,E.SU4,E.SU4A,E.TE5,E.US1 
          EXT    E.VA1,E.VA2,E.ZA,FILL.,FILL.2,L.CL 
  
*         IN ALLOC
          EXT    ERT,NEXT,ESY,NCM,SSY 
  
*         IN MAIN 
          EXT    TABX.F 
  
*         IN IO 
          EXT    LGR,FORMAT 
  
*         IN GEN
          EXT    L.FIV,E.FIV
  
*         IN INIT 
          EXT    DECA,HOLLSKL,TRVA
  
 ASN      SPACE  4,8
**        ASN -  ASSEMBLE NUMBER. 
*         ENTRY  B4 _ STARTING ADDRESS FOR ASSEMBLY.
*         EXIT   IF NO NUMBER PRESENT B7 = 0
*                                    (X6)= 0L0
*                IF NUMBER PRESENT    B7 " 0
*                                    (X6)= 0L[NUMBER] 
*                (X1) = NEXT CHARACTER. 
*                (B4) _ NEXT CHARACTER. 
*         USES   A1  X2,X6  B2,B4,B5,B7 
  
  
  
 ASN      SUBR   0
          SA1    B4 
          SB7    10*CHAR
          SB2    LG.VAR 
          SA2    ="NUM09" 
          UX1    X1 
          SX6    B0 
  
 ASN1     SB5    X1 
          LX0    X2,B5
          PL     X0,ASN4     IF NOT DIGIT.
          LX6    CHAR 
          SB7    B7-CHAR
          BX6    X1+X6       ADD IN NEW DIGIT.
          SB2    B2-B1       UPDATE NUMBER OF DIGITS. 
          SA1    B4+B1       NEXT 
          SB4    B4+B1       UPDATE POINTER 
          UX1    X1 
          NZ     B2,ASN1     IF NOT *7* DIGITS - LOOP 
          SA1    B4          NEXT CHARACTER.
  
**        HERE WITH 
*         (B7) = SHIFT COUNT
*         (X1) = NEXT CHARACTER.
*         (B4) _ NEXT CHARACTER.
*         (X6) = ASSEMBLED DIGITS (0R FORMAT) 
  
 ASN4     LX6    X6,B7       POSITION RESULTS IN 0L FORMAT. 
          NZ     X6,ASNX     IF NO ZERO RESULT
          SX6    1R0
          SB7    B0          INDICATE NO NUMBER.
          LX6    9*CHAR 
          EQ     ASNX        EXIT.. 
 ASV      SPACE  4,12 
**        ASV -  ASSEMBLE NEXT *7* ALPHANUMERIC CHARACTERS. 
*         ENTRY  (B4) _ STARTING ADDRESS FOR ASSEMBLY.
*                (X1) = FIRST CHARACTER.
*         EXIT   (X6) = ASSEMBLED CHARACTERS IN 0L FORMAT.
*                (X1) = NEXT CHARACTER. 
*                (B4) _ NEXT CHARACTER. 
* 
*         USES   A1,A4  X0,X3,X7  B2,B4,B5,B7 
  
  
 ASV20    SB7    B7-LG.VAR
          SB3    X7          RESTORE *B3* 
          SB4    B4-B7       UPDATE *STRING* POINTER. 
  
 ASV      SUBR               ENTRY/EXIT...
          SA4    B4+B1       NEXT CHARACTER.
          SB7    LG.VAR 
          MX3    -1R. 
          SB5    60-CHAR
          SX7    B3          SAVE *B3*
          BX6    0           CLEAR ASSEMBLE REGISTER. 
          SB3    7777B+1R+   1ST NON-ALPHANUMERIC CHARACTER.
          SX1    X1 
 ASV1     ZR     B7,ASV20    IF 7 CHARACTERS ASSEMBLED. 
          LX1    X1,B5
          SB7    B7-B1
          SB5    B5-CHAR
          BX6    X6+X1
          SB2    X4+7777B 
          AX0    B2,X3
          SX1    X4 
          ZR     X0,ASVE     IF POSSIBLE *ILLEGAL CHARACTER*
          SA4    A4+B1
          LT     B2,B3,ASV1  LOOP IN NOT END. 
  
          SB7    B7-LG.VAR
          SB4    B4-B7       UPDATE *STRING* POINTER. 
          SB3    X7          RESTORE *B3* 
          EQ     EXIT.
  
 **       HERE IF POSSIBLE ILLEGAL CHARACTER. 
  
 ASVE     MI     X4,ASV20    IF *EOS* 
          SB2    X1-1R" 
          ZR     B2,ASV20    IF *"* 
          SB2    X1-1R# 
          ZR     B2,ASV20     IF *#*
          BX6    X1 
          SB3    X7          RESTORE RIGHTFULL (B3) 
          LX6    9*CHAR 
          SB2    B7-LG.VAR   REMEMBER (B7)
          SA6    FILL.
          EQ     E.US1
 DEC      SPACE  4,15 
**        DEC -  CONVERT SOURCE CONSTANT TO INTERNAL BINARY 
*         ENTRY  B4 POINTS TO START OF CONSTANT.
*         EXIT   B4 POINTS TO END OF CONSTANT.
*                X1 = MODE OF CONSTANT
*                X2 = 0 (OR LOWER PART OF DOUBLE WORD)
*                X6 = TRANSLATED CONSTANT 
*         USES   A1,A2,A3,A4,A5  X0  B2,B7
*                (X4,X5 ARE NOT DESTROYED)
*         NOTE
*         NO-ONE SHOULD ATTEMPT TO CHANGE THE ALGORITHM OR FOR THAT 
*         MATTER ANY CODE WITHIN THIS ROUTINE WITHOUT FIRST CHECKING
*         ROUTINES --- KODER,KRAKER,RUN2.3,FTN,COMPASS AND
*         ANY OTHER COMPILER/ASSEMBLER THAT TRANSLATES CONSTANTS INTO 
*         BINARY FORM.
*         CALLS  OCT
  
  
**        RESTORE REGISTERS AND EXIT. 
*                (X7) = LOWER HALF OF WORD (IF DOUBLE)
*                (X6) = UPPER HALF
*                (X1) = MODE
  
 DECX     SA1    DECA        HERE IF EVERYTHING OK
          SA2    A1+B1
          SA0    X1          RESTORE *A0* 
          SB3    X2          RESTORE *B3* 
          SA4    A2+B1       RESTORE *X4* 
          SA5    A4+B1       RESTORE *X5* 
          SA1    A5+B1
          BX2    X7          LOWER PART OF RESULTS
          SA3    A1+B1
          LX7    X1          RESTORE *X7* 
          SX1    B6          MODE 
          SB6    X3          RESTORE *B6* 
          SA3    A3+B1
          SB5    X3          RESTORE *B5* 
          SB4    B4-B1       RESET TO LAST PART OF CONSTANT.
  
 DEC      SUBR   -           ENTRY/EXIT 
          SA1    B4 
          =A2    B4+1 
          =B7    X1-O.PERIOD
          NZ     B7,DEC3     IF 1ST NOT *.* 
          =B2    X2-O.CONS
          ZR     B2,DEC7     IF NUMBER FOLLOWS PERIOD.
          =B4    B4+1        ADVANCE TO NEXT. 
          EQ     DECEX1      ERROR IN CONSTANT. 
  
**        HERE IF 1ST NOT NUMBER. 
*                CHECK IF OCTAL CONSTANT FORM.
  
  
 DEC3     =A3    B4-1 
          RJ     OCT         ATTEMPT OCTAL CONVERSION 
          NZ     B2,DEC7     IF NO EXPLICIT *B* SUFFIX
  
          ANSI   E.DC1       ** OCTAL TYPE NOT DEFINED BY ANSI ** 
          SB4    A3          POINT PAST OCTAL CONSTANT
          =X1    M.UNIV 
          EQ     DEC         EXIT.. (WITHOUT RELOAD OF REGISTERS.)
  
 **       HERE IF CONSTANT INTEGER OR DECIMAL.
  
 DEC7     SX6    A0 
          SA6    DECA        SAVE *A0*
          SX6    B3 
          SA6    A6+B1       SAVE *B3*
          BX6    X4 
          SA6    A6+B1       SAVE *X4*
          BX6    X5 
          SA6    A6+B1       SAVE *X5*
          BX6    X7 
          SA6    A6+B1       SAVE *X7*
          SX6    B6 
          SA6    A6+B1       SAVE *B6*
          SX6    B5 
          SA6    A6+B1       SAVE *B5*
          SB5    B0          CLEAR B5 
  
*         PROCESS DECIMAL CONSTANT
  
 DEC10    BX2    0           CLEAR
          MX0    CHAR 
          =B6    M.INT
          SX3    0
          MX7    -CHAR
          =B3    1           CLEAR OVERFLOW COUNT (TO 1)
  
**        GET NEXT ELEMENT TO PROCESS FOR NUMBER. 
  
 DEC11    SA4    B4          LOAD NEXT WORD.
          NO
          =B7    X4-O.VAR 
          SB2    X4-O.PERIOD
          ZR     X4,DEC40    IF *EOS* 
          LE     B7,B0,DEC16 IF ALPHANUMERIC
          NZ     B2,DEC40    IF NO DECIMAL POINT
          MI     B6,DECEX1   IF PREVIOUS DECIMAL POINT - ERROR
          =B6    -1       INDICATE IN FRACTIONAL PART.
          =B4    B4+1 
          EQ     DEC11       LOOP 
  
**        BUILD INTEGER NUMBER IN *X3*
  
 DEC13    IX6    X6+X5       2*LOW PART + DIGIT 
          PL     B6,DEC14    IF NOT IN FRACTIONAL FIELD 
          =B6    B6-1 
 DEC14    LX5    X3,B1       2*HIGH PART
          =B3    B3+1        INCREMENT OVERFLOW COUNT.
          NZ     X1,DEC16    IF OVERFLOW OF 108 BITS
          LX2    3           8*LOW PART 
          =B3    1           RESET OVERFLOW COUNT 
          IX6    X6+X2       10*LOW PART + DIGIT
          LX3    3           8*HIGH PART
          BX2    -X0*X6      CLEAR CARRY FROM LOW PART
          IX5    X3+X5       10*HIGH PART 
          AX6    54          POSITION CARRY 
          IX3    X5+X6       10*HIGH PART + CARRY 
 DEC16    LX4    CHAR        NEXT CHARACTER 
          BX5    -X7*X4 
          SB2    X5+         SAVE CURRENT ELEMENT 
          SX6    X5-1R0 
          LX5    X2,B1       2*LOW PART 
          BX1    X0*X3       PICK OFF ANY CARRY PAST 108 BITS 
          PL     X6,DEC13    IF DIGIT 
          NZ     B2,DEC19    IF NOT END OF WORD 
          =B4    B4+1 
          EQ     DEC11       LOOP 
  
 DEC19    ZR     X1,DEC20    IF NO OVERFLOW 
          SB5    1           SET FLAG TO INDICATE ERROR PROCESSED 
          WARN   E.DC8
  
 DEC20    SX5    B2-1RE 
          ZR     X5,DEC21    IF *E* 
          =X6    X5+1 
          NZ     X6,DEC41    IF NOT *D* 
          =X5    1
 DEC21    MI     B6,DEC22    IF PREVIOUS DECIMAL POINT
          =B6    -1 
 DEC22    SB3    B6+B3       OVERFLOW-FRACTIONAL DIGIT COUNT. 
          SA1    B4 
          SB6    X5          SET FLAG (D=1,E=0) 
          MX0    CHAR 
          LX1    CHAR 
          BX6    X0*X1
          MX5    0
          ZR     X6,DEC30    IF NO EMBEDDED EXPONENT
          =B4    B4+1 
          BX6    0
          SB2    E.DC3
          EQ     DEC26       PROCESS EXPONENT.
  
**        HERE IF EMBEDDED EXPONENT 
*         FORM   CONSTANT EXXX OR CONSTANT DXXX 
  
 DEC24    SA1    B4 
          SB7    X1-O.CONS
          SB2    E.DC3
          BX6    0           CLEAR ASSEMBLY REGISTER. 
          ZR     X1,DECEX    IF *EOS* - ERROR 
          NZ     B7,DECEX    IF SEPARATOR - ERROR 
          =B4    B4+1 
  
**        BUILD INTEGER EXPONENT IN *X6*
  
 DEC26    LX1    CHAR        NEXT DIGIT 
          BX4    -X7*X1 
          SB7    X4-1R9-1 
          ZR     X4,DEC50    IF END OF EXPONENT 
          SX4    B7+1R9-1R0+1 
          PL     B7,DECEX    IF NON-NUMERIC (DELIMITER) 
          MI     X4,DECEX    IF NON-NUMERIC (ALPHA) 
          LX0    X6,B1       2*EXPONENT 
          BX4    X4-X5       SIGN DIGIT 
          LX6    3           8*EXPONENT 
          IX0    X4+X0       2*EXPONENT+DIGIT 
          IX6    X6+X0       10*EXPONENT+ (OR -) DIGIT
          EQ     DEC26       LOOP 
  
**        HERE IF NO EMBEDDED EXPONENT
*         CHECK IF OF THE FORM
*                CONSTANT E+XXX   CONSTANT D+XXX
*         OR     CONSTANT E-XXX   CONSTANT D-XXX
* 
*         (X5) = SIGN OF EXPONENT 
  
 DEC30    SA1    B4+B1       NEXT WORD
          SB4    B4+2 
          =B7    X1-O.PL
          ZR     B7,DEC24    IF *+* 
          =B7    B7-1 
          MX5    60          SET SIGN NEGATIVE
          ZR     B7,DEC24    IF *-* 
          =B4    B4-1 
          BX5    0           SET SIGN POSITIVE
  
**        HERE IF NO EXPONENT SPECIFIED 
*         SET NULL EXPONENT AND SEND *NOTE* ERROR TO OUTPUT.
  
          NOTE   E.DC6
          EQ     DEC52       CONTINUE.
  
 DEC40    ZR     X1,DEC41    IF NO OVERFLOW 
          SB5    1           SET FLAG TO INDICATE ERROR PROCESSED 
          WARN   E.DC8
  
 DEC41    SB3    B6+B3       OVERFLOW-FRACTIONAL DIGIT COUNT
          MI     B6,DEC45    IF DECIMAL POINT IN NUMBER 
          LX3    54          CONSTRUCT INTEGER
          IX6    X2+X3
          LX3    6
          AX3    5
          ZR     X3,DECX     IF NO OVERFLOW OF 59 BITS
          EQ     DECEX1      ERROR
  
 DEC45    SB6    B0          SET FLAG (E=0) 
          EQ     DEC52
  
 DEC50    SB3    X6+B3       ADD EXPONENT TO SCALING
          AX6    9
          SB2    E.DC2
          NZ     X6,DECEX    IF EXPONENT .GT. 512 - ERROR 
  
*         FLOATING CONVERSION BY FSCALE.
*         MODIFY DOUBLE WORD INTEGER INPUT FOR
*         FSCALE WHICH REQUIRES...
*         LOW ORDER INTEGER INTEGER PART, X1, BITS 54-00. 
*         HIGH ORDER INTEGER PART, X2, BITS 58-00.
  
 DEC52    SB5    B5+B6
          NO
          NZ     B5,DEC53    IF DOUBLE PRECISION OR ERROR FLAG SET
          SB2    48 
          NO
          AX1    B2,X2
          ZR     X1,DEC53    IF NO SINGLE PRECISION OVERFLOW
          WARN   E.DC8
  
 DEC53    MX5    1
          LX3    -1          POSITION HIGH PART 
          BX4    X5*X3       GET CARRY BIT
          BX0    -X5*X3      SET HIGH PART FOR FSCALE 
          LX4    -5          POSITION CARRY BIT 
          BX1    X4+X2       SET LOW PART FOR FSCALE
          SA0    B4 
          SB4    B6 
          SB6    B6+M.REAL   SET MODE 
 -        RJ     FSCALE 
          BX6    X1 
          BX7    X2 
          SB2    B4 
          SB4    A0 
          ZR     B2,DECX     IF CONVERSION SUCCESSFUL 
  
 DECEX1   SB2    E.DC        CONVERSION ERROR 
 DECEX    FATAL  B2 
          EQ     =XPSN       EXIT TO NEXT STATEMENT 
*CALL FSCALE
          SPACE  4,6
          TITLE 
 OCT      SPACE  4,12 
**        OCT -  CONVERT OCTAL CONSTANT TO BINARY.
* 
*         ENTRY  (A3+1) _ FWA SUSPECTED OCTAL CONSTANT. 
* 
*         EXIT   (X6) = OCTAL CONVERSION OF CONSTANT (=0 IF ERROR)
*                (A3) _ NEXT CHARACTER PAST CONSTANT
*                (B4) PRESERVED 
*                (B2) = ZERO IF *B* SUFFIX APPEARED 
* 
*         USES   A3  X0,X1,X2,X6  B2,B7 
  
 OCT90    AX3    8*CHAR 
          SB2    X3-2RB +1R 
          =A3    A3-1 
          NZ     B2,OCTX     IF NOT TERMINATED BY A *B* 
  
          =A3    A3+1 
          PL     B7,OCT94    IF NOT MORE THAN 20 DIGITS 
          WARN   E.DC8       ** OCTAL CONSTANT MORE THAN 20 DIGITS ** 
  
 OCT94    PL     X2,OCT96    IF NO EIGHT/NINE 
          BX6    0
          WARN   E.DC9       ** NON-OCTAL DIGIT IN OCTAL CONSTANT **
  
 OCT96    BSS    0           EXIT.. 
  
 OCT      SUBR   0
          BX6    0
          SX2    B0          INDICATE NO EIGHT/NINE 
          SB7    20          INITIALIZE DIGIT COUNT 
          MX0    -CHAR
  
 OCT20    =A3    A3+1        FETCH NEXT WORD
          =B2    X3-O.CONS
          NZ     B2,OCT90    IF NON-NUMERIC 
  
 OCT40    LX3    CHAR 
          BX1    -X0*X3 
          SB2    X1-1R8 
          ZR     X1,OCT20    IF WORD PROCESSED
          SX1    X1-1R0 
          PL     B2,OCT80    IF NON-OCTAL DIGIT 
          SB7    B7-B1
          MI     X1,OCT80    IF NOT DIGIT 
          MI     B7,OCT40    IF EXCESS DIGITS 
          LX6    3
          BX6    X1+X6       ADD DIGIT
          EQ     OCT40       LOOP.. 
  
 OCT80    MX2    -1          REMEMBER NON-OCTAL DIGIT 
          EQ     OCT40
 STY      SPACE  4,8
**        STY  - SET NATURAL (IMPLICIT) TYPE
*         ENTRY- NAME IN X6 (LEFT JUST, ZERO FILL)
*         EXIT   (X1) = MODE. 
*                (X2) = LOG (BASE 2) OF TYPE. 
*                (X6) = PRESERVED.
*                (B7) = 1ST CHARACTER OF NAME.
*         DESTROYS  A1. 
  
  
 STY1     AX1    X1,B7       RE-POSITION
          SX2    X2+B1
          LX6    -6          RESTORE X6 
          SX1    X1          ISOLATE MODE 
  
 STY      SUBR   0
          LX6    CHAR 
          =X2    L.TYPE-1 
          MX1    -CHAR
          BX1    -X1*X6      ISOLATE FIRST CHARACTER
          SB7    X1 
 STY2     SA1    X2+NAT.TYP 
          SX2    X2-1 
          LX1    X1,B7
          MI     X1,STY1     IF HIT 
          PL     X2,STY2     IF NO TABLE EXHAUSTION 
          TRUBL  E.ZA 
 NAT.TYPE SPACE  4,8
**        NAT.TYPE - TABLE OF NATURAL (IMPLICIT) TYPES
  
  
 NAT.TYP  BSS    0
  
 NAT.LOG  VFD    27/000000000B,15/0,18/M.LOG
 NAT.INT  VFD    27/000770000B,15/0,18/M.INT
 NAT.REAL VFD    27/377007777B,15/0,18/M.REAL 
 NAT.DBL  VFD    27/000000000B,15/0,18/M.DBL
 NAT.CPLX VFD    27/000000000B,15/0,18/M.CPLX 
 TAB      EJECT  4,40 
**        TAB - NORMALIZE STATEMENT.
* 
*         CONVERT *SB* INTO TABBED FORM.
*         TABBED FORM, SIMILAR TO OLD RUN 2.3, MEANING
* 
*         A. FOR A CHARACTER STRING STARTING WITH A DIGIT 
*                42/0LDIGITS,18/O.CONS
*                (LEADING ZEROS SUPPRESSED) 
* 
*         B. FOR A CHARACTER STRING STARTING WITH AN LETTER.
*                42/0LALPHANUMERIC,18/O.VAR 
* 
*         C. FOR A CHARACTER STRING STARTING WITH A QUOTE MARK. 
*         18/CONSTANT TAG,18/CHAR LENGTH,6/WORD LENGTH,18/O.HOLL
* 
*         D. FOR A CHARACTER STRING STARTING WITH A DIGIT AND SUFFIX
*            BY EITHER --     H   L   OR   R. 
*         18/CONSTANT TAG,18/0,6/WORD LENGTH,18/O.HOLL
* 
*         E. FOR A CHARACTER STRING DEFINED BY FORTRAN, TABBED FORM 
*            IS THE STRING OR CHARACTER CONVERTED TO INTERNAL 
*            MAPPED FORM
*                42/0,18/O.XX 
*            IE. *   =  42/0,18/O.STAR
*                .OR.=  42/0,18/O.OR
* 
*         TAB IS CALLED FROM THE COMPILERS MASTER LOOP AFTER A CARD HAS 
*         BEEN PROCESSED BY *AFS* OR *MULS* IS SET INDICATING A MULTIPLE
*         STATEMENT CARD.  THUS TAB WILL TRANSLATE KEYWORDS TO RUN
*         TABBED FORM.  THE EXCEPTION IS THE AMBIGUIOUS FORTRAN KEYWORD 
*         ,AND TO RUN, A RESERVED SEQUENCE -- 
* 
*         COLUMN =             1 1 1 1 1 1
*                    6   7 8 9 0 1 2 3 4 5
*                        F O R M A T (
*         IF THIS SEQUENCE IS FOUND *TAB* EXITS TO THE   F O R M A T
*         PROCESSOR LEAVING THE *SB* UNTABBED.
* 
*         TABS PROCESS LENDS ITSELF TO CONFUSION ONLY IN 2 ILL-DEFINED
*         STATEMENTS.  THE PROBLEM IS THAT *ANSI* UNLIKE THE REST OF THE
*         WORLD DIDNOT CONSIDER THE POOR SYNTAX FOR THE FOLLOWING 
*         STATEMENTS
* 
*         IE.    DO SN VA=1,10     THE PROBLEM IS THAT BETWEEN THE
*                                  STATMENT NUMBER FIELD (SN) AND THE 
*                                  VARIABLE FIELD (VA) THERE IS NO
*                                  DELIMITER. THIS NOT ONLY CAUSES
*                                  COMPILERS TO SPECIAL CASE *DO* SYNTAX
*                                  BUT HAS CAUSED MANY A PROGRAMMER TO
*                                  MIS-PLACE A VARIABLE THINGING IT IS A
*                                  *DO* DEFINITION STATEMENT. 
*         IE.   DO 1 I=1.0         IS A VARIABLE, NOT A *DO* DEFINITION.
* 
*         (WHY DIDNT *ANSI* TAKE THE 3600 FORM OF *DO*. 
*                DO 1, I= 1,10  ELIMINATES THE PROBLEM.)
* 
*                ASSIGN SN TO VA   HOPEFULLY I DO NOT NEED TO EXPLAIN 
*                                  THIS COMPLETELY DUMB STATEMENTS
*                                  POOR - POOR SYNTAX.
* 
*         TAB, DEFINED AS PART OF THE MASTER LOOP. ALSO SETS
*         UP CELLS FOR CLASSIFYING A STATEMENT. TAB WILL SET
* 
*                FIRSTV      EQUAL TO THE 1ST VARIABLE FOUND. 
* 
*                ZLEQUAL     ADDRESS OF THE LAST ZERO LEVEL = FOUND 
* 
*                ZLCOMMA     ADDRESS OF THE LAST ZERO LEVEL , FOUND 
* 
*                ZLPAREN     ADDRESS IN *SB* WHERE THE CLOSING *)* FOR
*                            ZERO LEVEL WAS FOUND.
* 
* 
*         ENTRY  B3 _ FWA TO STORE NORMALIZED STATEMENT INTO. 
*                B4 _ FWA OF FIRST ELEMENT TO BE PROCESSED. 
* 
*         EXIT   B3 _ END OF TABBED FILE. 
*                B4 _ LAST ENTITY PROCESSED BY TAB. 
* 
* 
*         --------------- L O C K  -  R E G I S T E R S --------------
*         (B3) _ NEXT PLACE TO STORE. 
*         (B4) _ NEXT ELEMENT TO BE PROCESSED.
*         (B6) = PARENTHESIS LEVEL. 
*         NO ROUTINE CALLED BY *TAB* MAY DESTROY ANY OF THE ABOVE REGS. 
*         ------------------------------------------------------------
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  ASN - TO TRANSLATE ANY NUMBER. 
*                ASV - TRANSLATE VARIABLE.
*                MANAGE - ENTER HOLLERITH CONSTANT. 
  
  
 TABE2    SB5    E.HC2       PREMATURE *EOS* IN TRANSLATING HOLL CON. 
 TABEX    WARN   B5          OUTPUT ERROR.
          BX6    0
          SA6    B3          MAKE SURE STATEMENT IS TERMINATED. 
          EQ     TABX        EXIT.. 
  
  
 TAB      SUBR   0           ** ENTRY/EXIT ** 
          BX6    0
          SA6    FIRSTV      CLEAR FIRST VARIABLE CELL. 
          SA6    A6+B1         -   ZERO LEVEL *=* INDICATOR.
          SA6    A6+B1         -   ZERO LEVEL *,* INDICATOR.
          SA6    A6+B1         -   ZERO LEVEL *)* INDICATOR.
          SA6    MULS        CLEAR MULTIPLE STATEMENT INDICATOR.
          SA6    BLANK       INDICATE BLANK LINE (NO SYMBOLS ENCOUNTERED
*                                  SO FAR)
          SA1    TS=CON 
          BX6    X1 
          SB6    B0            -   PARENTHESIS COUNT. 
          SA6    ICONL       SET INITIAL *CONSTANT* TABLE LENGTH. 
          EQ     TAB1        START
  
**        HERE IF CHARACTER IS *(*
  
 TAB.LP   SB6    B6+1 
  
**        HERE TO STORE CHARACTER INTO *SB* 
  
 TAB.NX   BX6    X1 
          SB4    B4+B1
          SA6    B3          CHARACTER TO *SB*
          SB3    B3+B1       UPDATE POINTER.
  
**        *T A B*  -  M A S T E R   L O O P.
  
 TAB1     SA1    B4          LOAD NEXT ELEMENT. 
          MX0    -1R. 
          MI     X1,TAB.EOS  IF *EOS* 
          SX7    X1-1R$ 
          ZR     X7,TAB.DOL  IF *$* 
          SA7    BLANK       INDICATE NOT A BLANK CARD
          SX2    X1-1R+ 
          MI     X2,TAB.VA   IF NOT SEPARATOR (LETTER/NUMBER) 
          SB2    X1+7777B 
          SA3    X1+MAPCHAR-1R+ 
          AX4    B2,X0
          NO
          NZ     X4,TAB5     IF CHARACTER OK. 
          SB2    X1-1R" 
          ZR     B2,TAB.QT   IF *"* 
          SB2    X1-1R# 
          ZR     B2,TAB.QT   IF *#* 
          LX1    9*CHAR 
          MX0    CHAR 
          BX6    X1*X0
 TAB4     SA6    FILL.
          EQ     E.US1       ILLEGAL CHARACTER
  
**        MAP SEPARATOR CHARACTER/ JUMP TO APPROPIATE PROCESSOR.
  
 TAB5     SX1    X3          MAPPING FOR CHARACTER. 
          AX3    18 
          SB2    X3 
          NO
          JP     B2          JUMP TO PROCESS SEPARATOR. 
          SPACE  4,8
  
**        HERE IF CHARACTER IS *. 
  
 TAB.STR  SX2    X6-O.STAR
          NZ     X2,TAB.NX   IF NOT STAR
          SX6    O.EXP
          SA6    B3-B1       INDICATE **
          SB4    B4+B1
          EQ     TAB1        CONTINUE 
  
**        HERE IF CHARACTER IS *)*. 
  
 TAB.RP   SB6    B6-B1
          NZ     B6,TAB.NX   IF NOT ZERO LEVEL. 
          SA3    ZLPAREN
          NZ     X3,TAB.NX   IF 1ST ZERO LEVEL FOUND. 
          SX6    B3+B1
          SA6    A3          SET ADDRESS. 
          EQ     TAB.NX      CONTINUE.
  
**        HERE IF CHARACTER IS *$*. 
  
 TAB.DOL  SX6    B4+B1
          NO
          SA6    MULS        RESET MULTIPLY STATEMENT INDICATOR.
          EQ     TAB.EOS     EXIT.. 
  
  
**        HERE IF CHARACTER IS *=*. 
  
 TAB.=    NZ     B6,TAB.NX   IF NOT IN ZERO LEVEL 
          SA2    ZLEQUAL
          SX6    B3 
          LX2    P.SYM
          SA6    A2          RESET *ZLEQUAL*
          IX1    X2+X1       POINTER TO LAST *=* FOUND. 
          EQ     TAB.NX      CONTINUE.
  
**        HERE IF CHARACTER IS *,*. 
  
 TAB.CO   NZ     B6,TAB.NX   IF NOT IN ZERO LEVEL 
          SX6    B3 
          SA6    ZLCOMMA     SET ZERO LEVEL *,* 
          EQ     TAB.NX      CONTINUE.
  
**        HERE IF CHARACTER IS *"*. 
  
 TAB.QT   MX0    -CHAR
          BX6    -X0*X1 
          LX6    9*CHAR 
          MX7    0
          SA6    FILL.       DELIMITER. 
          SA7    INR         INDICATE CHAR STRING 
          ANSI   =XE.HC5
          SA6    HOLLSKL
          SB5    10 
          BX6    0
          MX5    0           FLAG TO INDICATE CALLER NOT *FMT*
          RJ     TSC         TRANSLATE STRING DELIMITED CONSTANT. 
          ZR     X1,TAB.EOS  IF ERROR IN TRANSLATION. 
  
**        NOTE - TSC RETURNS B7 WITH VALUE 6*(9-NO. OF CHARS IN WORD).
* 
          SX1    B7-54
          ZR     X1,TAB.QT5  IF COMPLETE WORD 
          SB7    B7-53
          MX1    1
          EQ     TAB82       IF PARTIAL WORD, BLANK PAD 
  
**        NOTE - ALL HOLLERITH (STRING) CONSTANTS WITH PARTIALLY FILLED 
*                BUILD WORDS REJOIN HERE. 
  
 TAB.QT3  =A6    A6+1        STORE PARTIAL WORD 
          BX6    0
  
**        NOTE - ALL HOLLERITH (STRING) CONSTANTS ENDING WITH COMPLETE
*                BUILD WORDS REJOIN HERE. 
  
 TAB.QT5  =B7    A6+1        LWA+1 OF CONSTANT
          =A6    A6+1        STORE  ZERO WORD APPENDED
          SB5    99 
          SX6    B5-B2       CHAR LENGTH OF STRING
          SB2    HOLLSKL+1   FWA
          SX5    B7-B2       WORD LENGTH
          SA1    TS.CON 
          SA2    INR
          NZ     X2,TAB.QT6  IF NOT CHAR STRING 
          LX6    P.CLCON-P.LCON 
          BX5    X6+X5
 TAB.QT6  SB5    B3          SAVE *B3*
          =B3    A6+1        LWA+1 (ACTUAL LENGTH)
          RJ     NCM         SCAN/ENTRY INTO TS.CON TABLE.
          SB3    B5          RESET *B3* 
          SX0    B7+C.CON 
          =X1    O.HOLL 
          LX0    P.TAG
          IX6    X0+X1       TAG + O.HOLL 
          LX5    P.LCON 
          BX1    X6+X5       TAG + LENGTH + O.HOLL
          EQ     TAB.NX      CONTINUE.
  
**        HERE IF *EOS* 
  
 TAB.EOS  BX6    0
          SA6    B3          MARK *EOS* 
          ZR     B6,TABX     IF PROPER PARENTHESIS COUNT. 
          SB5    E.LP1       ERROR = TOO FEW *)*
          PL     B6,TABEX    IF TOO FEW *)* 
          SB5    E.LP2       ERROR = TOO FEW *(*
          EQ     TABEX       ERR EXIT.. 
  
  
**        HERE IF CHARACTER IS *ALPHANUMERIC* 
  
 TAB.VA   SX2    X2+1R+-1R0 
          PL     X2,TAB.NU   IF NO LETTERS
          SB2    X1 
          NZ     B2,TAB.VA1  IF CHARACTER *A-Z* 
          SX6    2R:         COLON IS ILLEGAL 
          LX6    8*CHAR 
          EQ     TAB4        REPORT ERROR 
  
  
**        HERE IF CHARACTER IS *A-Z*. 
  
 TAB.VA1  SA5    FIRSTV 
          RJ     ASV         ASSEMBLE NEXT *7* ALPHANUMERIC CHARACTERS. 
          =X3    O.VAR
          NZ     X5,TAB.VA20 IF NOT FIRST VARIABLE
          SA2    =0LFORMAT
          IX0    X2-X6
          SA6    A5          SAVE FIRST VARIABLE. 
          NZ     X0,TAB.VA20 IF NOT *FORMAT*
          SX2    X1-1R( 
          NZ     X2,TAB.VA20 IF NOT *FORMAT(* 
          SA4    =XSB.STNR
          ZR     X4,TAB.VA20 IF NO ASSOCIATED STMT NUMBER 
          SB5    FORMAT 
          SA5    B5+LGR 
          EQ     TABX.F      EXIT.. *FORMAT(* 
  
  
 TAB.VA20 IX6    X6+X3
          SA6    B3 
          SB3    B3+B1
          SX2    X1-1R+ 
          PL     X2,TAB1     CONTINUE IF NEXT NOT *A - 9*.
          PL     X1,TAB.VA1  IF NOT *EOS* 
          EQ     TAB.EOS
  
**        HERE IF CHARACTER IS *.*. 
  
 TAB.PD   SA2    B4+B1
          MI     X2,TAB.NX   IF *EOS* 
          SB2    X2-1R+ 
          PL     B2,TAB.NX   IF SEPARATOR.
          BX6    X1 
          SB4    B4+B1
          SA6    B3          TO *SB*
          SB2    X2-1R0 
          SA1    B4          NEXT 
          SB3    B3+B1
          UX1    X1 
          PL     B2,TAB.NU5  IF DIGIT, ASSEMBLE NUMBER. 
  
**        CHECK IF PROCESSING PERIOD DELIMITED OPERATOR.
  
 TAB.LG   RJ     ASV         ASSEMBLE VARIABLE
          SX2    X1-1R. 
          =X3    O.VAR
          NZ     X2,TAB.VA20 IF NOT *.* 
  
**        CHECK IF OPERATOR IS DEFINED BY FORTRAN.
  
          SB7    LG.LOG 
          SB4    B4+1 
 TAB.LG5  SA1    B7+LOGT
          BX2    X6-X1
          AX2    18 
          ZR     X2,TAB.LG10 IF HIT 
          SB7    B7-1 
          PL     B7,TAB.LG5  LOOP THRU TABLE
          =B4    B4-2 
          IX1    X6+X3       BUILD VARIABLE TOKEN 
          EQ     TAB.NX 
  
**        HERE IF IN TABLE. 
  
 TAB.LG10 SX6    X1 
          MX0    CHAR+L.SBPR
          LX0    L.SBPR 
          BX1    -X0*X1 
          SA6    B3-B1       SET TO APPROPIATE INDICATOR
          NZ     X1,TAB1     IF NOT ONE CHARACTER FORM
  
          ANSI   E.VA2       SPECIAL LOGICAL OPERATOR NON ANSI. 
          EQ     TAB1        CONTINUE.
  
**        HERE IF CHARACTER IS *0-9*. 
*         CHECK FOR POSSIBLE *HOLLERITH* CONSTANT FORM. 
  
 TAB.NU   SB2    X1-1R0 
          NZ     B2,TAB.NU5  IF NO LEADING *0*. 
          SA1    B4+B1
          SA5    ="NUM09" 
          SB4    B4+B1
 TAB.NU1  SB2    X1-1R0 
          NZ     B2,TAB.NU2  IF NOT *0*.
          SA1    A1+B1       NEXT 
          SB4    B4+B1       B4=A1
          EQ     TAB.NU1     CONTINUE DELETING *0*S.
  
 TAB.NU2  SB2    X1 
          LX0    B2,X5
          MI     X0,TAB.NU5  IF NUMBER
          SB4    B4-B1       RESET TO LAST *0*. 
 TAB.NU5  SA5    ="LETHLR"
          RJ     ASN         ASSEMBLE NUMBER. 
          SX4    O.CONS 
          SB2    X1 
          BX6    X4+X6
          LX3    B2,X5
          SA6    B3          NUMBER TO *SB* 
          SB3    B3+B1
          MI     X3,TAB.NU7  IF *H* *L* OR *R*
          SA5    ="NUM09" 
          LX3    B2,X5
          PL     X3,TAB1     IF NEXT NOT NUMBER.
          EQ     TAB.NU5     CONTINUE ASSEMBLYING NUMBER. 
  
**        PROCESS *HOLLERITH* CONSTANT INTO TS.CON TABLE. 
*         PROCESS *H*, *L*, OR *R*  DATA
  
 TAB.NU7  UX6,B7 X1 
          SA6    INR         STORE *H*,*L* OR *R* INDICATOR.
          SX6    X6-1RH 
          ZR     X6,TAB.NU8  IF *H* 
          ANSI   =XE.HC5
 TAB.NU8  MX0    -CHAR
          SX2    B0 
          SA4    B3-B1       NUMBER IN *DPC*
          BX5    0
          =B4    B4+1        1ST CHARACTER. 
  
**        CONVERT CHARACTER COUNT TO *INTERNAL BINARY*
  
 TAB76    LX4    CHAR 
          BX3    -X0*X4      NEXT DIGIT 
          SX6    X3-1R0 
          LX5    B1,X2       LAST *2
          ZR     X3,TAB77    IF END OF CONSTANT.
          IX6    X5+X6
          LX2    3           LAST *8
          IX2    X6+X2
          EQ     TAB76       LOOP 
  
 TAB77    BX6    0
          SX0    X2          CHARACTER COUNT. 
          SB5    10 
          SA6    HOLLSKL     DUMMY STORE FOR *THC*
          RJ     THC         TRANSLATE HOLLERITH CONSTANT.
          ZR     X1,TAB.EOS  IF ERROR IN TRANSLATION. 
          SA3    INR         *H* *L* OR *R* 
          =B3    B3-1 
          SB2    X3-1RL 
          ZR     B2,TAB101   IF *L* 
          SB2    X3-1RH 
          NZ     B2,TAB100   IF NOT *H* 
          MI     B7,TAB82    IF PARTIAL WORD. 
          EQ     TAB.QT5     CONTINUE 
  
**        BLANK PAD INCOMPLETE *H* OR *" "* WORD. 
  
 TAB82    SA3    =1H
          LX0    B7,X1
          BX2    -X0*X3 
          BX6    X2+X6
          EQ     TAB.QT3     CONTINUE 
  
 TAB100   BX6    X2          *R*
 TAB101   NZ     X6,TAB.QT3  ENTER PARTIAL WORD 
          SB7    HOLLSKL
          SB7    A6-B7
          ZR     B7,TAB.QT3  IF SPECIAL FORM (NL: OR NR:) 
          EQ     TAB.QT5
  
 INR      DATA   0
 THC      SPACE  4,12 
**        THC -  TRANSLATE HOLLERITH CONSTANT.
* 
*                ROUTINE USED BY
*                            A. TAB - NORMALIZE STATEMENT.
*                                     FOR PROCESSING EITHER -- H, L OR R
*                            B. FMT - FORMAT TRANSLATION. 
*                                     FOR PROCESSING -- H ONLY. 
* 
 BLANK    DATA   0           SET TO ZERO IF A BLANK CARD IS ENCOUNTERED 
*         ENTRY  (B4) _ 1ST CHARACTER.
*                (B5) = 10-(NUMBER OF CHARACTERS IN CURRENT WORD) 
*                (X0) = CHARACTER COUNT.
*                 A6 _ FWA -1 OF WHERE TO STORE DATA. 
*                (X6) = BUILDING WORD.
*                (FILL.) = HOLLERITH CHARACTER CODE CURRENTLY PROCESSING
* 
*         EXIT   (X1)  0 IF ERROR ENCOUNTERED IN TRANSLATION. 
*                (X2) = LAST ENTRY IN 0R FORMAT.
*                (X6) = LAST ENTRY IN 0L FORMAT.
*                (B4) _ LAST WORD IN HOLL CONSTANT
*                (B5) = 10 - NUMBER OF CHARS IN (X2)
*                (B7) = B5*CHAR-59
* 
*         USES   A1,A6  X0,X1,X2,X3,X7  B2,B4,B5,B7 
  
  
 THCZEX   SA3    A6 
          LX2    X6 
          FATAL  E.HC1       IF ZERO CHAR COUNT 
          EQ     THCE 
  
 THCEX    =B4    A1-1 
          SA3    A6 
          LX2    X6 
          FATAL  E.HC2       PREMATURE *EOS*
  
 THCE     BX6    X3 
          MX1    0
          SA6    A3 
  
 THC      SUBR   0
          ZR     X0,THCZEX   IF COUNT IS ZERO.
          SA1    B4 
          UX3    B7,X1       FIRST CHARACTER. 
          SB4    -1777B 
          SX2    1R          FOR BLANK PADDING. 
  
 THC5     ZR     X0,THC25    IF COUNT EXHAUSTED.
          =B7    B7-1        BLANK COUNT-1
          =B5    B5-1 
          LX6    CHAR 
          SX0    X0-1 
          EQ     B7,B4,THC10 IF NO IMBEDDED BLANKS
          BX6    X6+X2       ADD IN BLANK 
          NZ     B5,THC5     IF NO END OF WORK
          =A6    A6+1 
          BX6    0
          SB5    10 
          EQ     THC5        CONTINUE.
  
 THC10    MI     X1,THCEX    IF PREMATURE *EOS* 
          =A1    A1+1 
          BX6    X6+X3       HERE IF NO IMBEDDED BLANKS.
          UX3    B7,X1
          NZ     B5,THC5     IF NO END OF WORK
          =A6    A6+1        ADD WORD TO TABLE. 
          BX6    0           CLEAR ASSEMBLY REGISTER
          SB5    10 
          EQ     THC5 
  
**        HERE IF COUNT EXHAUSTED 
  
 THC25    SX1    B5+B5       *2 
          LX2    X6 
          IX0    X1+X1       *4 
          =B4    A1-1        LAST WORD IN CONSTANT
          IX0    X1+X0       *6 
          SB7    X0 
          MX1    1
          LX6    B7,X2       0L FORMAT. 
          SB7    B7-59
          EQ     THCX        EXIT.. 
  
  
  
  
**        TLV - TRUNCATE LONG VARIABLE
*         WHEN A VARIABLE NAME (TYPE O.VAR) OCCUPIES MORE THAN ONE
*         TOKEN, B4 IS RESET TO POINT TO THE LAST TOKEN IN THE
*         STRING AND THE VALUE OF THIS TOKEN IS CHANGED TO THE SAME 
*         AS THE FIRST TOKEN. THIS EVIDENTLY FOOLS PAR INTO THINKING
*         THE NAME DOES NOT EXCEED 7 CHARACTERS.
* 
*         CALLED BY - PAR,CST,TRV,ETC,ETC 
* 
*         ENTRY  (B4)_FIRST TOKEN IN VARIABLE - 
*         IT IS KNOWN THAT THE NEXT TOKEN IS OF TYPE O.VAR
* 
*         EXIT   (B4)_LAST TOKEN IN VARIABLE
*                CONTENTS OF LAST TOKEN = CONTENTS OF FIRST TOKEN 
* 
*         USES   A2,A7   X0,X2,X7   B4,B7 
* 
*         CALLS  NONE 
* 
  
 TLV      SUBR 0
          SA2    B4 
          BX7    X2          SAVE FIRST TOKEN OF NAME 
          MX0    L.SYM
 TLV5     =B4    B4+1 
          =A2    B4+1 
          SB7    X2-O.VAR 
          ZR     B7,TLV5           IF MORE CHARACTERS IN NAME 
          SA7    B4          SET LAST TOKEN=FIRST TOKEN 
          BX7    X0*X7
          SA7    FILL.
          WARN   =XE.TE7     NAME TRUNCATED TO FIRST 7
          EQ     TLV
 TSC      SPACE  4,12 
**        TSC -  TRANSLATE STRING DELIMITED CONSTANT OF THE FORM -- 
*                * --- * , " ---" OR # --- # TO INTERNAL PACKED FORM. 
* 
*                ROUTINE USED BY
*                            A. TAB - NORMALIZE STATEMENT. (ALL FORMS)
*                            B. FMT - FORMAT TRANSLATION. (ALL FORMS) 
* 
*         ENTRY  (B4) _ FIRST DELIMITER 
*                (B5) = 10-(NUMBER OF CHARACTERS IN CURRENT WORD) 
*                (X5) = 0 IF NOT CALLED BY *FMT*
*                 A6 _ FWA -1 OF WHERE TO STORE DATA. 
*                (X6) = BUILDING WORD.
*                (FILL.) = DELIMITER CHARACTER. 
* 
*         EXIT   (X1)  0 IF ERROR ENCOUNTERED IN TRANSLATION. 
*                (X2) = LAST ENTRY IN 0R FORMAT.
*                (X6) = LAST ENTRY IN 0L FORMAT.
*                (B2) = 99 - LENGTH OF STRING 
*                (B4) _ ENDING *DELIMITER* OR 99TH CHAR (FOR *FMT*) 
*                (B5) = 9-NUMBER OF CHARS IN (X6) 
*                (B7) = B5*CHAR 
*         USES   A1,A3,A7  X0-X3,X5,X7  B2,B4,B5,B7 
  
  
 TSCZEX   SA3    A6 
          LX2    X6 
          FATAL  E.HC4       ZERO LENGTH HOLL STRING
          EQ     TSCE 
  
 TSCEX    =B4    A1-1 
          LX2    X6 
          SA3    A6 
          FATAL  E.HC3       PREMATURE *EOS*
  
 TSCE     BX6    X3 
          SA6    A3 
          MX1    0           INDICATE ERROR 
  
 TSC      SUBR   0
          SA1    B4 
          UX7    B0,X1       DELIMITER. 
          =A1    A1+1 
          UX3    B7,X1       FIRST CHARACTER. 
          SX2    1R          FOR BLANK PADDING. 
          SB2    99          MAX CHAR COUNT (FOR *FMT*) 
          SB4    -1777B 
  
 TSC5     =B5    B5-1 
          LX6    CHAR 
          ZR     B2,TSC15    IF 99 CHAR PROCESSED 
 TSC5A    =B2    B2-1 
          =B7    B7-1        BLANK COUNT - 1
          MI     X1,TSCEX    IF PREMATURE *EOS* 
          IX0    X3-X7
          EQ     B7,B4,TSC10 IF NO IMBEDDED BLANKS
          BX6    X6+X2       ADD IN BLANK 
          NZ     B5,TSC5     IF NO END OF WORK
          =A6    A6+1 
          BX6    0
          SB5    10 
          EQ     TSC5        CONTINUE.
  
 TSC10    ZR     X0,TSC50    IF DELIMITER FOUND.
          =A1    A1+1 
          BX6    X6+X3       HERE IF NO IMBEDDED BLANKS.
          UX3    B7,X1
          NZ     B5,TSC5     IF NO END OF WORK
          =A6    A6+1        ADD WORD TO TABLE. 
          SB5    10 
          BX6    0           CLEAR ASSEMBLY REGISTER. 
          EQ     TSC5 
  
 TSC15    ZR     X5,TSC5A    IF NOT CALLED BY *FMT* 
          PX7    B7,X3
          MX0    1
          SA7    A1 
          BX5    X0+X5       FLAG TO INDICATE MAX OF 99 REACHED 
          =A1    A1-1        SET TO POINT TO 99TH CHAR
          NZ     X6,TSC25    IF NOT EMPTY WORD
          BX6    X3          99 CHARS AND FULL WORD, PICK UP NEXT CHAR
  
**        SET-UP EXIT CONDITIONS FOR EXTERNAL PROCESSOR.
*         (X6) = LAST WORD
*         (A1) _ *DELIM*
*         (B5) = LAST CHAR COUNT
  
 TSC25    SX1    B5+B5       *2 
          SB7    99 
          IX0    X1+X1
          =B2    B2+1        LENGTH CORRECTED BECAUSE OF *DELIM*
          SB4    A1          SET TO POINT TO DELIMITER
          EQ     B7,B2,TSCZEX      IF STRING LENGTH IS ZERO 
  
          IX0    X1+X0       *6 
          LX2    X6 
          SB7    X0 
          MX1    -1 
          LX6    B7,X2       0L FORMAT. 
          EQ     TSCX        EXIT.. 
  
**        HERE IF FOUND DELIMITER CHECK IF ENDING DELIMITER 
  
 TSC50    =A3    A1+1 
          SX0    X7-1R" 
          UX3,B7 X3 
          NZ     X0,TSC25    IF NOT PROCESSING QUOTE DELIMITED STRING 
          SB7    B7-B4
          IX0    X3-X7
          NZ     X0,TSC25    IF NOT DOUBLE QUOTE AS CHAR
          GT1    B7,TSC25    IF BLANKS BETWEEN THE QUOTE MARKS
          =A1    A1+1        BY-PASS SECOND QUOTE MARK. 
          MX0    -1 
          EQ     TSC10       CONTINUE 
  
 TRV      SPACE  4,15 
**        TRV -  TRANSLATE VARIABLE.
* 
*         ENTRY  B4 _ TO VARIABLE TO BE TRANSLATED. 
* 
*         EXIT   (X1) = MODE BITS OF TAG. 
*                (X2) = PASS *2* TAG FOR SYMBOL TRANSLATED. 
*                (X6) = TAG FROM SYMBOL TABLE.
*                (B7) = ORDINAL OF TAG. 
*                (X0)  = 0 IF NO ERROR DETECTED, -1 OTHERWISE 
*         NOTE   *TRV* VALIDATES THE *ENTRY* BEFORE EXIT TO MAKE SURE 
*                NO USAGE CONFLICT EXIST. 
*         USES   A1,A2,A3,A6  X0  B2,B7 
*                (TRVA, TRVA+1) 
  
  
*         HERE IF ERROR 
  
 TRVEX    BX6    X3 
          SA6    FILL.2      CLASS CONFLICT (IF ANY)
          FATAL  B7          OUTPUT ERROR.
          SX6    C.VAR
          SB7    B2          RESTORE ORDINAL OF TAG 
          SX6    X6+B7
          LX6    P.TAG
          =X1    M.UNIV 
          BX2    X6 
          MX0    -1          INDICATE ERROR 
  
 TRV      SUBR   0
          SA1    B4 
          MX0    L.SYM
          BX6    X0*X1       SYMBOL ONLY
          SB2    X1-O.VAR 
          SA6    FILL.
          ZR     B2,TRV4     IF *VARIABLE*. 
          MX0    L.CDPC 
          SA2    X1+=XCHARMAP 
          NZ     X2,TRV1     IF NOT CONSTANT
          BX2    X1 
 TRV1     BX6    X0*X2
          SA6    FILL.       SET FILL. WITH BAD CHARACTER 
          EQ     E.TE5       SYNTAX ERROR 
  
  
 TRV4     =A2    B4+1 
          SB7    X2-O.VAR 
          NZ     B7,TRV5     IF NAME LESS THAN 8 CHAR 
          RJ     TLV
 TRV5     SCAN   TS.SYM,SSY 
          PL     B7,TRV10    IF FOUND IN TABLE
  
          RJ     STY         SET MODE 
          SX7    X1+M.VAR 
          ADSYM  TS.SYM      ADD SYMBOL + TAG TO TABLE. 
          EQ     TRV12
  
 TRV10    BX0    X6 
          IFBIT  X0,-NVAR,TRV12    IF NOT *NOT VARIABLE*
          CLAS=  X2,(EXT=,FUN,BEF,SUB,ASF)
          BX0    X2*X6
          NZ     X0,TRV10B   IF CLASS2 CONFLICT 
          CLAS=  X2,(RP)
          BX0    X2*X6
          NZ     X0,TRV10A   IF RETURNS PARAMETER 
          CLAS=  X2,(ENT=)
          BX0    X2*X6
          ZR     X0,TRV10D   IF NOT ENTRY 
          SA2    =XENTRY. 
          SB2    X2 
          SB2    B2-B7
          NE1    B2,TRV10B   IF NOT FUNCTION NAME 
          SA1    TRV
          AX1    30 
          SX1    X1          WHERE THIS CALL ORIGINATED 
          SX2    =XNAM20
          IX2    X2-X1
          ZR     X2,TRV12    NAMELIST LIST ITEM OK
          SX2    =XPTN3 
          IX2    X2-X1
          ZR     X2,TRV12    VARIABLE FORMAT OK 
          EQ     TRV10B 
 TRV10D   SA3    CLASS+P.NVAR-P.DEF 
          EQ     TRV10C 
  
 TRV10A   SA3    CLASS+P.RP-P.DEF 
          EQ     TRV10C 
  
 TRV10B   NX2,B2 X0 
          SB2    -B2
          SX2    B2+CLASS-P.CLASS2+47 
          SA3    X2+L.CL
 TRV10C   =B2    B7+1        ORDINAL OF TAG 
          SB7    E.VA1       USAGE CONFLICT ERROR 
          EQ     TRVEX       OUTPUT CONFLICT MESSAGE. 
  
**        (X6) = TAG
*         (B7) = SYMBOL ORDINAL OF ENTRY. 
  
 TRV12    SA1    LOP=R
          =B7    B7+1        ORDINAL OF TAG.
          PL     X1,TRV20    IF NO CROSS-REFERENCE SELECTED.
          LX2    X6 
          SA6    TRVA        SAVE TAG.
          SX6    B7 
          =A6    A6+1        SAVE ORDINAL 
          SA1    REFVAR      TYPE OF REFERENCE
          LX6    X2 
          ADDREF X6,X1
          SA1    TRVA 
          =A2    A1+1 
          BX6    X1          TAG. 
          SB7    X2          ORDINAL. 
  
**        SET-UP EXIT CONDITIONS. 
  
 TRV20    BX1    X6 
          MX0    -L.FPNO
          AX1    P.FPNO 
          MX3    L.TAG+L.MODE 
          BX2    -X0*X1      EXTRACT SYMBOL TABLE *PARM* FIELD
          LX3    L.MODE 
          LX2    P.2FPNO
          MX0    -L.MODE
          BX1    X3*X6       TAG + MODE 
          IX2    X1+X2       TAG + PARM + MODE
          BX1    -X0*X6      MODE BITS ONLY 
          =X0    0           INDICATE NO ERROR FOUND
          SA6    TRVA 
          EQ     TRVX        EXIT.. 
  
 EXTS.    EJECT 
**        THE FOLLOWING IS A LIST OF
*                   EXTERNAL ROUTINES THAT ARE USED BY GENERATED OBJECT 
*                   CODE TO PROCESS *FORTRAN* STATEMENTS.  INORDER TO 
*                   ELIMINATE *RESERVED WORDS* THESE ROUTINES MUST
*                   ALWAYS BE CALLED BY *NAME*_EXT. 
  
  
 =XLIB    MACRO  NAME,SUFFIX
          VFD    42/0L_NAME"EXT"SUFFIX,18/O.VAR 
 =XLIB    ENDM
 S.IOCALL SPACE  4,8
**        S.IOCALL - LIST OF ROUTINES USED BY OBJECT TIME INPUT/OUTPUT. 
*                MUST ALWAYS BE KEPT IN ORDER, AS THE PROPER NAME IS
*                SELECTED BY INDEXING INTO THIS TABLE.
  
  
 S.IOCAL  BSS    0           BASE OF *I/O* ROUTINE NAMES
  
          LOC    0
 S=COD    BSS    0                 *CODED* MODE 
 S=INIT   BSS    0                 *INITIAL* CALL 
 S=INP    =XLIB  INPCI             *INPUT* DIRECTION
 S=CONT   =XLIB  INPCR
 S=OUT    =XLIB  OUTCI             *OUTPUT* DIRECTION 
          =XLIB  OUTCR
 S=FREE   =XLIB  INPFI             *LIST-DIRECTED* (FREE FIELD) 
          =XLIB  INPFR
          =XLIB  OUTFI
          =XLIB  OUTFR
 S=BIN    =XLIB  INPBI             *BINARY* MODE
          =XLIB  INPBR
          =XLIB  OUTBI
          =XLIB  OUTBR
 S=STR    =XLIB  DECODI            *STRING* MODE
          =XLIB  DECODR 
          =XLIB  ENCODI 
          =XLIB  ENCODR 
          LOC    *O 
  
 S.NLST   =XLIB  NAMIN
          =XLIB  NAMOUT 
 S.ERR    =XLIB  FTNERR 
* .Q8NTRY CON    Q8NTRY      PROGRAM INITIALIZATION 
 S.Q2NTR  =XLIB  Q2NTRY      PROGRAM INITIALIZATION 
 S.VARDIM =XLIB  VARDIM      VARIABLE DIMENSION INITIALIZER 
 S.ACGOR  =XLIB  GOTOER 
 S.BKSP   =XLIB  BACKSP 
 S.ENDFI  =XLIB  ENDFIL 
 S.EOF    =XLIB  EOF         IMPLICIT E-O-F TEST
 S.RANDM  =XLIB  RANDOM 
 S.REWIN  =XLIB  REWIND 
          =XLIB  BUFOUT 
 S.BUFIO  =XLIB  BUFIN
  
 S.END    =XLIB  END         ORDER OF END - STOP CAN NOT BE CHANGED SEE 
 S.PAUSE  =XLIB  PAUSE       ROUTINE *SPR*. 
 S.STOPE  =XLIB  STOP 
 S.FTNRP  =XLIB  FTNRP2      OBJECT TIME REPRIEVE 
 #FID     IFNE   .FID,0 
          ENTRY  S.FID
 S.FID    =XLIB  DBUG,LN
 #FID     ENDIF 
 INLINE   EJECT  4,8
**        TSF -  TAG SPECIAL FUNCTION.
* 
**        COMMENT ABOUT THE TAGGING OF A SPECIAL FUNCTION BY *TSF*
* 
*         *TSF*  RETURNS A TAG FOR ALL FUNCTIONS/SUBROUTINE USAGE.
*         IT NEVER SETS THE DEFINE BIT IN THE TAG RETURNED, BECAUSE 
*         THE PROCESSOR CALLING *TSF* DOES NOT YET KNOW WHETHER THE 
*         TAG IS BEING USED WITH ARGUMENTS OR NOT.  THE PROBLEM IS THAT 
*         THE ARGUMENT COUNT FIELD, (L.PARM) IS ONLY 6 BITS IN LENGTH 
*         ALLOWING ONLY 63 ARGUMENTS TO BE ASSOCIATED WITH ANY ONE
*         FUNCTION/SUBROUTINE REFERENCE.  THUS WHEN A REFERENCE TO A
*         FUNCTION TAG IS USED IN ORDER TO CHECK ARGUMENT COUNT WE MUST 
*         KNOW WHETHER THIS IS THE FIRST REFERENCE OR NOT.  IF WE SET 
*         THE DEFINE BIT, LIKE ANSI DICTATES, THEN WE HAVE NO IDEA
*         IF THE CURRENT REFERENCE IS THE 1ST OR NOT. 
*         (A SUBROUTINE CAN BE REFERENCED WITH A NULL ARGUMENT LIST.) 
* 
*         THUS THE ONLY PROCESSOR THAT SETS THE DEFINE BIT FOR A TAG
*         THAT CONTAINS THE *NVAR* BIT SET IS *TAL* - TERMINATE ARGUMENT
*         LIST, AND ALSO BY THE CALL PROCESSOR, WHEN REFERENCE TO A 
*         SUBROUTINE WITH A NULL ARGUMENT LIST. 
* 
*         THE EXCEPTION TO THE ABOVE IS THE DEFINED *CDC/ANSI*
*         INTRINSICS AND BEFS.  SINCE BOTH OF THESE CLASSES HAVE DEFINED
*         ARGUMENT LISTS THE DEFINE BIT IS SET BY *TSF* WHEN TAGGING
*         A FUNCTION BELONGING TO THIS CLASS....
* 
*         (FURTHER COMMENT...OBVIOUSLY IT WOULD BEHOOVE US TO EXPAND THE
*         L.PARM FIELD, AND WE COULD FOR ALL TAGS GENERATED BY *TSF* BUT
*         THE PROBLEM IS NOT SPECIAL TAGS BUT THE FORMAL PARAMETER
*         ARGUMENT POSITION FIELDS LOCATED WITHIN A SYMBOL DEFINITION.
*         IN THE SYMBOL TAG WE DO NOT HAVE ENOUGH BITS TO EXPAND THE
*         PARAMETER FIELD.  ACTUALLY THERE SHOULD BE NO LIMIT ON THE
*         ARGUMENT LIST TO A FUNCTION OR SUBROUTINE BUT WE ONLY HAVE A
*         60 BIT WORD..)
* 
*         ENTRY  B4 _ TO VARIABLE TO BE TRANSLATED. 
*         (X6) = CLASSIFICATION FOR FUNCTION. 
* 
*         EXIT   (X1) = MODE BITS ONLY OF TAG.
*                (X6) = TAG ENTRY. (FROM *TS.SYM*)
*                (B7) = ORDINAL OF TAG. 
* 
*         PRESERVES A4,A5  X4,X5  B4,B5,B6
* 
*         CALLS  ADF, BTT, SCT, STY 
  
  
 TSF      SUBR               ENTRY/EXIT...
          SA1    B4          LOAD ELEMENT.
          MX0    L.SYM
          SA6    CALL 
          =X6    0
          SB7    X1-O.VAR 
          SA6    NEXT        INDICATE SYMBOL FOUND. 
          BX6    X0*X1       SYMBOL ONLY
          SA6    FILL.       SAVE NAME (IN CASE OF ERROR) 
          ZR     B7,TSF2     IF SYMBOL
          SB7    X1+0 
  
**        SCAN SYMBOL TABLE TO SEE IF SPECIAL FUNCTION HAS ALREADY
*         BEEN ENCOUNTERED. 
  
 TSF2     SCAN   TS.SYM,SSY 
          =X1                MODE BITS (IF SYSEXT)
          MI     B7,TSF30    IF *NIT* 
          SA3    CALL 
          =B7    B7+1        POINT TO TAG 
          BX6    X3+X6       DEFINE ACCORDING TO CALL 
          EQ     TSF60       CONTINUE 
  
**        SCAN DEFINED LIBRARY TABLE. 
  
 TSF30    SA3    CALL 
          NZ     X3,TSF40    IF TYPE OF FUNCTION DEFINED. 
          BX1    X6 
          RJ     SLT         SCAN LIBRARY TABLE.
          =X1                CLEAR CLASS BITS, ALREADY ADDED. 
          PL     B7,TSF50    IF INLINE OR BEF.
          =X3    M.FUN+M.EXT+M.NVAR 
  
*         PROCESS NATURAL TYPE
*         (X3) = CLASS BITS 
*         (X6) = 0L_NAME OF FUNCTION. 
  
 TSF40    SB2    X3-M.SYSEXT
          ZR     B2,TSF50    IF SYSTEM EXTERNAL.
          RJ     STY         SET MODE 
  
**        ADD EXTERNAL TO SYMBOL TABLE. 
  
 TSF50    BX7    X1+X3       CLASS + MODE BITS. 
          ADSYM  TS.SYM 
          SB7    B7+B1       TAG ENTRY ORDINAL
  
*         TRANSFER FUNCTION/SUBROUTINE TAG FOR COMPILE
**        (X6) = TAG
*         (B7) = ORDINAL OF TAG 
  
 TSF60    SA2    LOP=R
          MX0    -L.MODE
          PL     X2,TSF62    IF NO CROSS REFERENCE SELECTED 
          LX2    X6 
          SA6    TRVA        SAVE TAG.
          SX6    B7 
          =A6    A6+1        SAVE ORDINAL OF TAG. 
          SA1    REFVAR      TYPE OF REFERENCE
          LX6    X2 
          ADDREF X6,X1
          SA1    TRVA 
          =A2    A1+1 
          BX6    X1          TAG. 
          MX0    -L.MODE
          SB7    X2 
 TSF62    SA3    DOORD
          =X7    M.EXT
          BX1    -X0*X6      MODE ONLY
          ZR     X3,EXIT.    IF NOT INSIDE *DO* 
          BX2    X7*X6
          ZR     X2,EXIT.    IF NOT REFERENCE TO *EXTERNAL* 
          SA1    TS.STN 
          SB2    X3 
          SA3    B2+X1       LOAD *DO* STATMENT TAG FROM *TS.STN* 
          =X2    M.SNEX 
          BX7    X2+X3       INDICATE *DO* HAS AN EXTERNAL REFERENCE
          SA7    A3          RESET IN STATEMENT NUMBER TABLE
 TSF65    BX1    -X0*X6      MODE BITS ONLY OF TAG
          EQ     EXIT.
 SLT      SPACE  4,20 
**        SLT -  SCAN DEFINED LIBRARY TABLE.
* 
*         ENTRY  (X1) = SYMBOL TO CHECK.
* 
*         EXIT   (B7) < 0 = ENTITY NOT FOUND. 
*                   (X3) = N/A
* 
*                (B7) = PAR.FUN = *BEF* 
*            OR  (B7) = PAR.FUN = *INLINE*
*                (X3) = TAG FOR FUNCTION MINUS ACTUAL TAG.
* 
*                (X6) = PRESERVED.
*         USES   CANNOT DESTROY A2,A4,A5,A7  X4,X5,X6  B4,B5,B6 
  
  
**        HERE IF FUNCTION IS EITHER A  *BEF*  OR  *INTRINSIC*. 
*         (X1) = *FIV* TABLE ENTRY. 
*         (X6) = ENTRY NAME.
  
 SLT10    LX7    X1 
          MX0    -L.MODE
          BX2    -X0*X1      FUNCTION MODE. 
          AX1    L.MODE 
          MX0    -L.FARGC-L.FARGM-L.FJPAD 
          BX3    -X0*X1 
          LX3    P.ARGC 
          BX3    X3+X2
          IFBIT  X7,FBEF,SLT20     IF *BEF* 
          =X0    M.INLF      INDICATE *INTRINSIC* 
          =B7    1
          BX3    X3+X0
          IFBIT  X7,FANSI/FBEF,SLTX     IF DEFINED BY ANSI
          ANSI   E.SU4       CDC DEFINED INTRINSIC
          =B7    1
          EQ     SLTX        EXIT.. 
  
  
**        HERE WHEN FUNCTION IS *BEF* 
*         SET UP SHIFT COUNT IF IN CALL BY VALUE. 
  
 SLT20    IFBIT  X7,FANSI/FBEF,SLT22
          NOTE   E.SU4A      NOTE - CDC DEFINES FUNCTION AS BEF.
 SLT22    =X0    M.BEFF      INDICATE *BEF* 
          SB7    0           INDICATE *BEF* 
          BX3    X3+X0       ARGUMENT COUNT + CLASS + MODE
  
**        SCAN TABLE OF DEFINED *ANSI*/*CDC* SUPPLIED INTRINSICS, 
*         *BEFS* .
  
 SLT      SUBR   0
          BX2    X1 
          SB7    L.FIV
          SA1    E.FIV
          MX0    L.SYM-CHAR 
 SLT32    BX3    X0*X1       NAME ONLY. 
          IX3    X3-X2
          ZR     X3,SLT10    IF HIT 
          =B7    B7-1 
          =A1    A1-1 
          NZ     B7,SLT32    IF NOT END OF TABLE. 
          =X3    M.NVAR+M.FUN+M.EXT 
          =B7    -1          INDICATE NO SUCCESS. 
          EQ     SLTX        EXIT.. (NOT BEF, OR INLINE)
          LIST   D
          END 
