*DECK LEX 
          IDENT  LEX
 LEX      SECT   (LEXICAL SCANNER.) 
 LEX      SPACE  4,10 
*         IN ALLOC
          EXT    ALC
  
*         IN CDDIR
          EXT    K$=BEGC,K$=COLL,K$=DO,K$=ELSE,K$=ENDC,K$=ENDI,K$=IF
          EXT    K$=LIST
  
*         IN DATA 
          EXT    KW=DATA
  
*         IN DECL 
          EXT    KW=COMM,KW=DIME,KW=EQUI,KW=EXTE,KW=INTR,KW=LEVE,KW=PARA
          EXT    KW=SAVE
  
*         IN FEC
          EXT    CARDS,FEC=DAT,FEC=DEC,FEC=END,FEC=ENT,FEC=EXU,FEC=FMT
          EXT    FEC=IMP,FEC=OK,FEC=PRM,FEC=STF,FEC=TYP,FEC=1ST,L.CARD
          EXT    NCM,SSY,TLV,ZLCOLON,ZLCOMMA,ZLEQUAL,ZLPAREN,STAGE
          EXT    FEC=BY,IFLEVEL 
  
*         IN FERRS
          EXT    E.HC1,E.HC2,E.HC3,E.INI,E.MCA,E.ME,E.TLBL,FILL.
  
*         IN FMT
          EXT    KW=FORM
  
*         IN FSNAP
          EXT    LTB=,TOK=IDP 
  
*         IN FTN
          EXT    CO.DS,CO.IDP,CO.PW,CO.SEQ,CO.SNAP,CO.WPL,CO.WPE
          EXT    CP.CARD,CP.FLIN,CP.IFMT,CP.PW,F.IN 
  
*         IN HEADER 
          EXT    KW=BLOC,KW=FUNC,KW=OVCA,KW=OVER,KW=PROG,KW=SUBR
  
*         IN IDP
          EXT    IDP= 
  
*         IN IO 
          EXT    KW=BACK,KW=BUFF,KW=CLOS,KW=DECO,KW=ENCO,KW=ENDF,KW=INQU
          EXT    KW=OPEN,KW=PRIN,KW=PUNC,KW=READ,KW=REWI,KW=WRIT
  
*         IN KEY
          EXT    IFS,KW=ASSI,KW=BREA,KW=CALL,KW=CONT,KW=ELSE,KW=END 
          EXT    KW=ENDI,KW=ENTR,KW=GOTO,KW=NAME,KW=PATC,KW=PAUS,KW=RETU
          EXT    KW=STOP
  
*         IN LABEL
          EXT    CUL,KW=DO
  
*         IN PAR
          EXT    CNF
  
*         IN PEM
          EXT    PDM
  
*         IN PUC
          EXT    PWBUF,T=STMT,T=TB,T.CON,T.STMT,T.TB,WOF,WOF=ERR,WO.LOS 
  
*         IN STMTF
          EXT    SFD
  
*         IN TYPE 
          EXT    KW=BOOL,KW=CHAR,KW=COMP,KW=DOUB,KW=IMPL,KW=INTE,KW=LOGI
          EXT    KW=REAL
  
*         IN UTILITY
          EXT    CDD,DXB,MVE=,RDC=,SFN,ZTB
 LEX      SPACE  4,10 
***       LEX - LEXICAL SCANNER.
* 
* 
*         THIS DECK CONTAINS THE LEXICAL SCANNER.  IT IS DIVIDED INTO 
*         THE FOLLOWING MAJOR SECTIONS -- 
* 
*           1. MACRO DEFINITIONS. 
* 
*              CONTAINS ALL MACRO DEFINITIONS THAT ARE LOCAL TO THIS
*              DECK.
* 
*           2. DATA STRUCTURES. 
* 
*              CONTAINS THE DEFINITIONS OF DATA CELLS AND SYMBOLS 
*              PERTINENT TO *LEX*.  ALSO CONTAINS *COMADEF* STRUCTURE 
*              DEFINITIONS LOCAL TO THIS DECK.
* 
*              NOTE THAT COMPILER GLOBAL *COMADEF* STRUCTURE DEFINITIONS
*              USED BY *LEX* ARE DEFINED IN *FTN5TXT*.
* 
*           3. MAIN EXECUTIVE.
* 
*              CONTAINS THE LEXICAL SCANNER MAIN EXECUTIVE THAT 
*              OVERSEES/CONTROLS THE LEXICAL SCAN FOR A SINGLE SOURCE 
*              STATEMENT (INITIAL LINE PLUS CONTINUATION LINES).
* 
*              THIS MAIN EXECUTIVE IS ALSO NAMED *LEX* AND IS CALLED
*              BY *FEC* (FRONT END CONTROLLER) TO PROCESS A SINGLE
*              SOURCE STMT. 
* 
*           4. THE EXECUTIVES.
* 
*              CONTAINS THE EXECUTIVES THAT ARE INVOKED BY *LEX*
*              (THE LEXICAL SCANNER MAIN EXECUTIVE) TO PERFORM ITS
*              MAJOR FUNCTIONAL TASKS.
* 
*           5. SUPPORTING SUBROUTINES.
* 
*              CONTAINS MISCELLANEOUS SUPPORT ROUTINES THAT ARE INVOKED 
*              WHEN NECESSARY.  NOTE THAT SOME OF THESE ARE INVOKED 
*              BY PROCESSORS EXTERNAL TO THIS DECK. 
* 
* 
*         IN THE INTEREST OF FINDABILITY, EACH OF THE ABOVE SECTIONS
*         CAUSES A NEW MAIN TITLE OF THE FORM --
* 
*                LEX - LEXICAL SCANNER/SECTION NAME 
* 
*         TO BE GENERATED.
 CODING   SPACE  4,10 
***       COMMENTING/CODING CONVENTIONS.
* 
* 
*         A NUMBER OF COMMENTING AND CODING CONVENTIONS HAVE BEEN 
*         ADOPTED IN THIS PIECE OF CODE WHICH SHOULD MAKE IT EASIER 
*         TO READ AND UNDERSTAND.  THIS AUTHOR BELIEVES VERY STRONGLY 
*         THAT THE **NOTATION** USED TO DESCRIBE A PARTICULAR DESIGN
*         IMPLEMENTATION IS AS IMPORTANT AS THE DESIGN ITSELF.  AND 
*         INSTEAD OF REQUIRING THAT YOU DECIPHER **MY** NOTATION ON 
*         THE FLY, I WILL TELL YOU HERE AND NOW HOW IT WORKS... 
* 
*         THIS DISCUSSION CAN BE DIVIDED INTO 3 PARTS: CODE FORM, 
*         SYMBOL NAMING, AND A GLOSSARY OF ABBREVIATIONS. 
* 
************************************************************************
* 
*         CODE FORM 
* 
*         THIS IS A DESCRIPTION OF HOW ONE CAN EXPECT CODE TO LOOK
*         ON A PAGE.  THE *MACE/KRONOS* CONVENTION IS THE MODEL.
*         *MACE* IS A VERY STYLIZED CODING CONVENTION WHICH IS AIMED
*         PRIMARILY AT FORMALIZING SUBROUTINE STRUCTURE.
* 
*         *MACE*, BRIEFLY --
* 
*           1. SUBROUTINES ARE USED THAT ENTER AND EXIT AT A COMMON 
*              POINT, I.E. ARE INVOKED BY AN *RJ* INSTRUCTION.
* 
*           2. ALL SUBROUTINES HAVE 3 CHARACTER MNEMONIC NAMES
*              THAT DESCRIBE THEIR FUNCTION.
* 
*           3. ALL SUBROUTINES BEGIN WITH AN EXTREMELY STYLIZED 
*              PREAMBLE WHICH GIVES THE NAME OF THE SUBROUTINE, ITS 
*              FUNCTION, ITS ENTRY AND EXIT CONDITIONS, THE REGISTERS 
*              IT USES/DESTROYS, AND A LIST OF ALL THE SUBROUTINES
*              AND/OR MACROS THAT IT CALLS/REFERENCES.
* 
*              A DETAILED DESCRIPTION OF THE PREAMBLE IS BASICALLY
*              A WASTE OF TIME.  THEY ARE ALL EXACTLY ALIKE...JUST GO 
*              LOOK AT ONE. 
* 
*           4. ALL SUBROUTINE EXECUTABLE CODE LABELS CONSIST OF THE 
*              SUBROUTINE 3 CHARACTER MNEMONIC FOLLOWED BY A DIGIT
*              OR DIGITS IN ASCENDING ORDER.
* 
*           5. SUBROUTINE LOCAL-ONLY SCRATCH CELLS HAVE LABELS THAT 
*              CONSIST OF THE SUBROUTINE 3 CHARACTER MNEMONIC FOLLOWED
*              BY A SINGLE LETTER (BEGINNING AT -A-) IN ASCENDING 
*              ORDER. 
* 
*           6. THE *COMPASS* 2,11,18,30 TABBING CONVENTION IS STRICTLY
*              FOLLOWED.  I.E. LABEL FIELD IN COL 2, OPERATION FIELD
*              IN COL 11, ADDRESS FIELD IN COL 18, AND COMMENT FIELD
*              IN COL 30. 
* 
*           7. COMMENTS THAT DESCRIBE HARDWARE FUNCTION ARE AVOIDED.
*              E.G.  SA1  ZIP    LOAD FLAG
*                    LX1  4      LEFT-SHIFT (X1)
* 
*           8. **ALL** CONDITIONAL BRANCH INSTRUCTIONS CONTAIN A COMMENT
*              IN COLS 30-72 THAT BEGINS WITH THE WORD *IF* AND 
*              DESCRIBES THE *BRANCH TAKEN* CONDITION.  E.G.
* 
*                    ZR   X1,EXIT. IF AT END OF TABLE 
* 
*         FOR ME, *MACE*S PRIMARY VIRTUE IS THAT IS MAKES FOREIGN CODE
*         LOOK NOT-SO-FOREIGN.  SIMPLE. 
* 
*         IN ADDITION, THIS CODE USES A FEW EXTENSIONS TO THE *MACE*
*         WAY... THEY ARE --
* 
*           1. THE COMMENT FIELD FOR A LINE CONTAINING A MACHINE
*              MNEMONIC INSTRUCTIONS (I.E. COLS 30-72) IS GENERALLY 
*              RESERVED FOR A DESCRIPTION OF THE DATA STRUCTURE 
*              RESULTING FROM THE HARDWARE INSTRUCTION ON THAT LINE.
* 
*              USUALLY, THIS IS NOTATED VERY FORMALLY, WITH THE EXPLICIT
*              RESULT REGISTER SPECIFIED.  E.G. --
* 
*                BX4  -X0*X5    (X4) = NEXT CHAR TO PACK, -R- FORMAT
* 
*              WHEN SETTING A LOGICAL FLAG, IT DIFFERS -- 
* 
*                SA6  TF=SQZ    SET TO *INDICATE NO BLANK SQUEEZE*
* 
*              OR WHEN MANIPULATING A *COMADEF* STRUCTURE --
* 
*                BX6  X6+X1     MERGE *LEN* 
* 
*              IN ITS MOST COMMON FORM, THE RESULT REGISTER IS
*              EXPLICITLY SPECIFIED SO THAT THE READER KNOWS
*              **ABSOLUTELY** WHAT IS MEANT.
* 
*              IN ANY CASE, RESERVING COLS 30-72 FOR DATA STRUCTURE 
*              DESCRIPTIONS MAKES DEBUGGING EASIER BECAUSE ONE CAN
*              CONSTANTLY COMPARE WHAT **IS** WITH WHAT **SHOULD BE**.
* 
*           2. FUNCTIONAL COMMENTS (I.E. WHAT IS GOING ON, OR HOW IT
*              IS DONE, OR MORE IMPORTANTLY, WHY ARE WE DOING IT) ARE 
*              USUALLY PLACED ON A SEPARATE COMMENT LINE THAT PRECEDES
*              PARAGRAPH OF CODE THAT IT PERTAINS TO. 
* 
*              THIS TENDS TO MAKE CODE OCCUR IN FUNCTIONAL BLOCKS...GOOD
*              FOR A QUICK ONCE-OVER EYE SCAN.
* 
*           3. A FLAG CELL DEFINITION WILL CONTAIN (AT A MINIMUM) 
*              A COMMENT THAT SPECIFIED/DESCRIBES **ALL** POSSIBLE
*              VALUES THAT THIS FLAG MAY TAKE, AND IDEALLY, UNDER 
*              WHAT CONDITIONS THE FLAG WILL TAKE THOSE VALUES. 
* 
*              THIS IS DONE BECAUSE OFTENTIMES, THE FLAG CELL DEFINITION
*              IS THE ONLYPLACE WHERE THE INTRICACIES AND PATHOLOGIES 
*              ASSOCIATED WITH THE USE OF THE FLAG CAN BE INTEGRATED. 
* 
************************************************************************
* 
*         SYMBOL NAMING 
* 
*         THIS IS A DESCRIPTION OF THE CONVENTIONS USED IN SYMBOL 
*         NAMING.  THE INTENT OF THSE CONVENTIONS IS TO TRANSMIT TO 
*         THE READER AS MUCH INFORMATION AS POSSIBLE BY MERELY SEEING 
*         A SYMBOL NAME ITSELF.  OFTEN, THIS INFORMATION IMPLIES HOW
*         ONE CAN **EXPECT** A SYMBOL TO BE USED. 
* 
*         TWO BASIC SYMBOL NAME-FORMING RULES ARE USED: FIRST, SYMBOL 
*         PREFIXES ARE USED HEAVILY.  AND SECOND, THE CHARACTER THAT
*         SEPARATES A SYMBOL PREFIX FROM THE REST OF THE SYMBOL NAME
*         IS GIVEN SEMANTIC MEAING.  CURRENTLY, THERE ARE ONLY 2 SUCH 
*         CHARACTERS: -.- IMPLIES THAT THE VALUE OF THE SYMBOL IS 
*         AVAILABLE AT ASSEMBLY-TIME.  E.G. --
* 
*                SX1    L.KEYW  (X1) = LEN (IN WORDS) OF *KEYW* TABLE 
* 
*         AN -=- CHARACTER IMPLIES THAT THE VALUE OF THE SYMBOL IS
*         AVAILABLE ONLY AT EXECUTION-TIME (I.E. IT IS ONLY THE ADDRESS 
*         OF A CELL AT ASSEMBLY-TIME).  E.G. -- 
* 
*                SA1    L=KEYW  (X1) = LEN (IN WORDS) OF *KEYW* TABLE 
* 
*         THESE SYMBOLS ARE, THEREFORE, INDIRECT. 
* 
*         NOTE THE USE OF THE WORD *VALUE* IN THE ABOVE PARAGRAPH.
*         OBVIOUSLY, *COMPASS* MUST BE ABLE TO ASSOCIATE SOME BINARY
*         NUMBER WITH BOTH TYPES OF SYMBOLS AT ASSEMBLY-TIME.  IN A 
*         HUMAN SENSE, THOUGH, THE SYMBOL NAMES IN THE ABOVE EXAMPLES 
*         TELL WHETHER THE *VALUE* OF THE SYMBOL WILL BE USED IN
*         A DIRECT, OR AN INDIRECT MANNER.  A SUBTLE DIFFERENCE THAT
*         CAN BE HANDY WHEN READING CODE. 
* 
*         SYMBOL NAMES CAN BE DIVIDED INTO THE FOLLOWING GENERAL
*         TYPES --
* 
*           1. SYMBOLS THAT DESCRIBE COMMON COMPUTER OR CDC CONCEPTS, 
*              SUCH AS: LENGTH, FIRST WORD ADDRESS, ETC...  THESE 
*              SYMBOL NAMES ARE STRUCTURED SO THAT THE PREFIX DESCRIBES 
*              THE COMMON IDEA.  I.E. - 
* 
*                L.XXX  - LENGTH OF XXX.
*                FW.XXX - FWA OF XXX. 
*                F.XXX  - FWA OF A FET/FIT FOR FILE XXX.
* 
*           2. *COMADEF* STRUCTURES.  *COMADEF* IS A COMDECK THAT 
*              CONTAINS MACROS FOR DESCRIBE/DEFINING SOFTWARE DATA
*              STRUCTURES.  CONCEPTUALLY, IT WORKS MUCH LIKE THE *COBOL*
*              *PICTURE*.  VIA THE *COMADEF* MACROS, ONE CAN DRAW 
*              A PICTURE OF WHAT A DATA STRUCTURE ELEMENT WILL LOOK 
*              LIKE.
* 
*              NOW WHEN ONE WISHES TO BUILD OR ACCESS SOME PART OF THE
*              DATA STRUCTURE, YOU CAN DO IT **SYMBOLICALLY** VIA 
*              SYMBOLS THAT THE *COMADEF* MACROS DEFINED IN RESPONSE
*              TO THE PICTURE THAT WAS DRAWN VIA THOSE MACROS.
* 
*              *COMADEF* SYMBOLS TAKE THE FORM -- 
* 
*                  DD.XXXP  AND DD.XXXL 
* 
*              WHERE *DD* IS A COMMON PREFIX FOR THIS DATA STRUCTURE, 
*              *XXX* IS A UNIQUE NAME FOR A FIELD WITHIN THE DATA 
*              STRUCTURE *DD*, *P* IS A SUFFIX THAT DENOTES THE RIGHT-
*              MOST BIT POSITION OF FIELD *XXX* WITHIN *DD*, AND *L*
*              IS A SUFFIX THAT DENOTES THE LENGTH (IN BITS) OF FIELD 
*              *XXX*. 
* 
*              FOR EXAMPLE -- 
* 
*                  SA1  A1+B1    (X1) = NEXT ELEMENT IN STRUCTURE *BB.* 
*                  MX2  -BB.TOTL (X2) = MASK FOR EXTRACTING *TOT* FIELD 
*                  LX1  0-BB.TOTP RIGHT-JUSTIFY *TOT* FIELD 
*                  BX6  -X2*X1   (X6) = CONTENTS OF *TOT* FIELD 
* 
*              ONCE ONE BECOMES FAMILIAR WITH THE *COMADEF* NOTATION, 
*              MOST OF THE ABOVE COMMENTS ARE UNNECESSARY.  THE 
*              ACCESSING OF A *COMADEF* STRUCTURE IS SO STYLIZED THAT 
*              ONE CAN PRETTY MUCH RECOGNIZE IT ANYWHERE, BY ANYONE,
*              AND IN AN INFINITY OF CIRCUMSTANCES. 
* 
*           3. SYMBOLS THAT ONE WISHES TO ASSOCIATE VIA A COMMON PREFIX.
*              THESE ARE SYMBOLS THAT THE PROGRAMMER FEELS HAVE AN
*              INTERRELATIONSHIP WITHIN THE CONTEXT OF A SPECIFIC 
*              PIECE OF CODE.  FOR EXAMPLE, ALL LINE TYPES (INITIAL,
*              CONTINUATION, ETC) ARE DEFINED VIA SYMBOLS THAT HAVE 
*              THE COMMON PREFIX *LT.*, E.G. *LT.INIT*, *LT.CONT*, ETC. 
* 
*              CERTAIN GROUPS OF DATA CELLS ARE ALSO ASSOCIATED VIA 
*              A COMMON PREFIX: E.G. ALL THE CELLS THAT CONTAIN 
*              INFORMATION THAT *LEX* HAS GATHERED ABOUT A SINGLE 
*              SOURCE LINE HAVE THE COMMON PREFIX *LN=*.
* 
*           4. SYMBOLS WITHIN MACRO DEFINITIONS.  THE CONVENTION
*              USED FOR NAMING SYMBOLS WITHIN A MACRO DEFINITION IS 
*              AS FOLLOWS.  SYMBOLS ARE OF THE FORM --
* 
*                '?PPTXXX 
* 
*              WHERE '?  = COMMON *MACRO SYMBOL* PREFIX.
*                    PP  = A COMMON PREFIX FOR SYMBOLS WITHIN THIS
*                          MACRO DEFINITION, OR WITHIN A GROUP OF 
*                          RELATED MACRO DEFINITIONS. 
*                    T   = SYMBOL TYPE.  SEE BELOW. 
*                    XXX = UNIQUE NAME FOR THIS SYMBOL. 
* 
*              SYMBOL TYPES, *T*, ARE USED TO SIMPLIFY THE READING
*              OF MACRO CODE A LITTLE BIT.  EACH SYMBOL TYPE DENOTES
*              HOW THE SYMBOL WILL BE USED WITHIN THE MACRO.
* 
*              SYMBOL TYPES ARE --
* 
*                S = *SET* SYMBOL, I.E. ANY SYMBOL THAT IS ASSIGNED AN
*                    ABSOLUTE VALUE.  E.G. '?PPSXXX SET 1 
* 
*                C = *MICRO* NAME.  E.G. '?PPCXXX MICRO 1,,/HARPIES/
* 
*                R = *RMT* BLOCK NAME.  E.G. '?PPRXXX RMT 
* 
*                M = *MACRO* NAME.  I.E. USED FOR INTERNAL MACROS WHICH 
*                    THE PROGRAMMER WISHES TO BE **INVISIBLE** TO THE 
*                    REST OF THE WORLD. 
* 
*           5. NONE OF THE ABOVE.  THERE WILL ALWAYS BE EXCEPTIONS... 
*              SOME OF THESE ARE BECAUSE THERE IS NO CONVENTION, SOME 
*              ARE BECAUSE THE CONVENTION DIDNT SEEM RIGHT FOR THIS 
*              PARTICULAR CASE, ETC, ETC, ETC...
* 
************************************************************************
* 
*         GLOSSARY
* 
*         THE FOLLOWING IS A GLOSSARY OF COMMON ABBREVIATIONS,
*         NOTATIONS, AND SYMBOL PREFIXES THAT ARE NOT IN PARTICULAR 
*         *LEX*, OR EVEN *FTN* DEPENDENT. 
* 
*         A+C    ADDRESS AND CONTENTS.  USED PRIMARILY IN CONJUNCTION 
*                WITH A LOAD INSTRUCTION WHERE BOTH THE ADDRESS AND 
*                THE CONTENTS OF THE ADDRESS ARE MEANINGFUL, AS IN -- 
* 
*                    SA1   A1+B1   (A1,X1) = A+C OF NEXT TABLE ENTRY
* 
*                AS OPPOSED TO -- 
* 
*                    SA1   LN=TYPE (X1) = LINE TYPE 
* 
*         ADDR   ADDRESS. 
* 
*         FWA    FIRST WORD ADDRESS.
* 
*         FW.XXX A SYMBOL WHOSE VALUE SPECIFIES A FWA.
 LEX      TTL    LEX - LEXICAL SCANNER/MACRO DEFINITIONS. 
          EJECT 
 MACROS   SPACE  4,10 
***       MACRO DEFINITIONS.
* 
* 
*         THE FOLLOWING SECTION CONTAINS THE MACRO DEFINITIONS THAT ARE 
*         LOCAL TO THE DECK *LEX*.
* 
*         ADDITIONAL GLOBAL COMPILER MACROS USED BY *LEX* CAN BE FOUND
*         IN *FTN5TXT* AND *CPUTEXT*. 
 KEYW     SPACE  4,10 
**        KEYW - DEFINE FTN KEYWORD TABLE ENTRY.
* 
* 
*         THIS MACRO IS USED TO DEFINE ENTRIES IN THE FTN KEYWORD 
*         TABLE.
* 
*         KEYW   KEY,STAJ,ATTR
* 
*         ENTRY  KEY  = FTN KEYWORD IF CHARACTER STRING IS NOT PREFIXED 
*                       WITH *=*, ELSE
*                     = ADDR OF STMT PROCESSOR THAT IS TO PROCESS 
*                       THIS STMT IF PREFIXED WITH *=* (NOTE THAT THE 
*                       *=* WILL BE REMOVED VIA MICRO MANIPULATION).
*                       THIS NOTATION IS FOR THE SPECIAL SYNTACTICALLY
*                       DEFINED *KEYW* ENTRIES. 
*                STAJ = *FEC* STAGE THAT THIS STMT CAN OCCUR IN.
*                ATTR = ATTRIBUTES OF THIS STMT.
* 
*                SEE *KEYW* TABLE (FWA AT *FW.KEYW*) AND *KW.* SYMBOL 
*                DEFINITIONS (IN *FTN5TXT*) FOR A MORE COMPLETE 
*                DESCRIPTION OF THESE PARAMETERS. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  BSSENT,LITKEY
  
          PURGMAC KEYW
  
          MACRO  KEYW,LOC,KEY,STAJ,ATTR 
          LOCAL  '?KW#002 
* 
 '?KWCKEY MICRO  1,, KEY
 '?KWSKEY MICCNT '?KWCKEY 
 '?KWCS01 MICRO  1,1, KEY 
* 
 '?KW#001 IFC    NE,/"'?KWCS01"/=/
 '?KWCJMP MICRO  1,4, KEY 
 '?KWCJMP MICRO  1,, KW="'?KWCJMP"
* 
 '?KW#001 ELSE
 '?KWCJMP MICRO  2,, KEY
 '?KW#001 ENDIF 
* 
 LOC      BSS    0
          VFD    KW.JMPL/=X"'?KWCJMP" 
* 
 '?KW#001 IRP    ATTR 
          POS    KW.ATTR_P+1
          VFD    1/1         (ATTR) 
 '?KW#001 IRP 
          POS    KW.ATTRP 
* 
          VFD    KW.FECL/=XFEC=STAJ 
          VFD    KW.LENL/'?KWSKEY*CHAR
* 
 '?KW#001 IFC    NE,/"'?KWCS01"/=/
          VFD    KW.KEYL/'?KW#002 
* 
 '?KW#002 LITKEY
 '?KW#001 ELSE
          VFD    KW.KEYL/-1 
 '?KW#001 ENDIF 
* 
 KEYW     ENDM
 KEY$     SPACE  4,10 
**        KEY$ - DEFINE FTN C$ KEYWORD TABLE ENTRY. 
* 
* 
*         THIS MACRO IS USED TO DEFINE ENTRIES IN THE FTN C$ KEYWORD
*         TABLE.
* 
*         KEY$   KEY,STAJ,ATTR
* 
*         ENTRY  KEY  = C$ KEYWORD
*                STAJ = *FEC* STAGE THAT THIS STMT CAN OCCUR IN.
*                ATTR = ATTRIBUTES OF THIS STMT.
* 
*                SEE *KEY$* TABLE (FWA AT *FW.KEY$*) AND *KW.* SYMBOL 
*                DEFINITIONS (IN *FTN5TXT*) FOR A MORE COMPLETE 
*                DESCRIPTION OF THESE PARAMETERS. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  BSSENT,LITKEY
  
          PURGMAC KEY$
  
          MACRO  KEY$,LOC,KEY,STAJ,ATTR 
          LOCAL  '?KW#002 
* 
 '?KWCKEY MICRO  1,, KEY
 '?KWSKEY MICCNT '?KWCKEY 
* 
 '?KWCJMP MICRO  1,4, KEY 
 '?KWCJMP MICRO  1,, K$="'?KWCJMP"
* 
 LOC      BSS    0
          VFD    KW.JMPL/=X"'?KWCJMP" 
* 
 '?KW#001 IRP    ATTR 
          POS    KW.ATTR_P+1
          VFD    1/1         (ATTR) 
 '?KW#001 IRP 
          POS    KW.ATTRP 
* 
          VFD    KW.FECL/=XFEC=STAJ 
          VFD    KW.LENL/'?KWSKEY*CHAR
* 
          VFD    KW.KEYL/'?KW#002 
* 
 '?KW#002 LITKEY
* 
 KEY$     ENDM
 LNJP     SPACE  4,10 
**        LNJP - LINE TYPE JUMP TABLE.
* 
* 
*         THIS MACRO IS USED TO DEFINE ENTRIES IN A JUMP TABLE
*         THAT IS USED TO SPLIT UP THE FLOW OF PROCESSING WITHIN
*         *LEX* BASED UPON THE LINE TYPE OF THE LINE AT (CP.CARD).
* 
*         SEE FTN 5 IMS FOR DECK *LEX* --  5.1 APPENDICES/MAIN LOOP 
*         FLOW CHART. 
  
  
          PURGMAC LNJP
  
          MACRO  LNJP,LNTYP,JPAD
* 
          NOREF  .LN
 .LN      SET    *
          IFNE   LT.LNTYP,.LN,1 
 P        ERR    *LNJP* ORD AND *LT.TYPE* DO NOT AGREE.       "SEQUENCE"
* 
          CON    JPAD *O+4S15 
* 
 LNJP     ENDM
*CALL     COMATOK            THE *TOGEL* MACROS 
*CALL     COMSTOK            COMMON TOKEN GENERATOR INTERFACE TEXT. 
 DATA     TTL    LEX - LEXICAL SCANNER/DATA STRUCTURES. 
          EJECT 
***       DATA STRUCTURES.
* 
* 
*         THE FOLLOWING SECTION CONTAINS THE DESCRIPTIONS AND 
*         DEFINITIONS OF MOST OF THE DATA STRUCTURES USED BY *LEX*. 
* 
*         ADDITIONAL GLOBAL COMPILER/LEX DATA STRUCTURE INFORMATION 
*         CAN BE FOUND IN *FTN5TXT*.
 BB.      SPACE  4,10 
**        BB. - *BUB* SYMBOL DEFINITIONS. 
* 
  
  
          DESCRIBE BB.
 TOC      DEFINE TB.TOCL
 TOT      DEFINE TB.TOTL
  
 BN.      SPACE  4,10 
**        BN. - *BUN* GROUP FORMAT. 
  
  
          DESCRIBE BN.
 TOC      DEFINE 60 
 TOT      DEFINE 0
 CH=      SPACE  4,10 
***       CH= - CHARACTER STRING INFORMATION. 
* 
* 
*         SYMBOLS OF THE FORM *CH=XXX* CONTAIN INFORMATION ABOUT
*         A CHARACTER STRING DURING TOKEN GENERATION.  THERE IS 
*         A CONSIDERABLE AMOUNT OF SPECIAL-CASE CODE FOR ENTOKENING 
*         THE VARIOUS CHARACTER STRINGS, AND DURING THIS PROCESS IT 
*         IS NECESSARY TO SAVE CERTAIN INFORMATION WHILE *TOK* IS 
*         ACTUALLY DOING ITS THING. 
* 
************************************************************************
 CH=CNT   SPACE  4,10 
**        CH=CNT - CHARACTER STRING CHARACTER COUNT.
* 
* 
*         *CH=CNT* CONTAINS A CHARACTER STRING CHARACTER COUNT, AND IS
*         USED FOR CHARACTER STRINGS THAT SPAN CARD/LINE BOUNDARIES 
*         (I.E. CHARACTER STRINGS THAT ARE CONTINUED).
* 
*         UPON ENCOUNTERING AN EOL MARK DURING CHARACTER STRING 
*         GENERATION/ASSEMBLY, THE CURRENT CHARACTER STRING COUNT IS
*         SAVED IN (CH=CNT) SO THAT *TOK* CAN RESTART ASSEMBLY OF THIS
*         CHARACTER STRING WHEN *LEX*S MAIN LOOP PROVIDES THE NEXT
*         LINE. 
* 
*         (CH=CNT) DIFFER ACCORDING TO WHETHER WE ARE GENERATING
*         AN *HLR* COUNT-CONTROLLED STRING, OR A QUOTE-TYPE DELIMITED 
*         STRING -- 
* 
*           1. FOR COUNT-CONTROLLED *HLR* STRINGS, *CH=CNT* CONTAINS
*              THE NR OF CHARACTERS REMAINING TO BE ASSEMBLED INTO THE
*              CURRENT CHARACTER STRING.
* 
*              E.G. -- COL 65     72
*                           .      .
*                        20HBOB-TAIL
* 
*              AT EOL, COL 72, (CH=CNT) = 12 TO INDICATE THAT THERE ARE 
*              12 CHARACTERS REMAINING TO BE ASSEMBLED/GROUPED INTO THIS
*              CHARACTER STRING.
* 
*           2. FOR QUOTE-TYPE DELIMITED STRINGS, *CH=CNT* CONTAINS
* 
*                  -(CHARACTER COUNT + 1) 
* 
*              E.G. -- COL 65     72
*                           .      .
*                          "BOB-TAIL
* 
*              AT EOL, COL 72, (CH=CNT) = -9 TO INDICATE THAT WE HAVE 
*              ASSEMBLED/GROUPED 8 CHARACTERS INTO THIS CHARACTER 
*              STRING.
* 
*         THE ORIGIN OF THE CONTENTS OF *CH=CNT* IS THE ENTOKENING
*         REGISTER (B5).  SEE *COMCBUN*.
* 
*         NOTE ALSO THAT *CH=CNT* CONTAINS A FUNNY NUMBER FOR 
*         QUOTE-TYPE STRINGS, I.E. -(CHAR COUNT + 1), BECAUSE 
*         OF THE WAY *COMCBUN* WORKS.  ON ENTRY TO *BUN* (BURST/BUILD 
*         CHARACTERS WITH NO BLANK SQUEEZE), (B5) CONTAINS A *MAXIMUM 
*         NR OF CHARACTERS TO BURST/BUILD* COUNT.  *BUN* DECREMENTS 
*         (B5) FOR EACH CHARACTER HE BURST/BUILDS, AND EXITS IF 
*         (B5) EVER GOES .ZR. 
* 
*         FOR QUOTE-TYPE STRINGS, THERE IS NO *CHARACTER COUNT* FOR 
*         (B5), BUT IF WE ARE CAREFUL, *BUN* WILL COUNT THE NR
*         OF CHARACTERS HE GROUPS INTO THE ''/"" STRING VIA (B5). 
* 
*         IT WORKS LIKE THIS: IF WE SET (B5) = -1 AT THE BEGINNING
*         OF ''/"" STRING PROCESSING, THEN (B5) WILL NEVER BE .ZR.
*         IN *BUN* BECAUSE *BUN* STARTS DECREMENTING AT (B5) = -1 
*         (I.E. -2, -3, -4, ETC).  IT CAN NOW BE SEEN THAT FOR
*         QUOTE-TYPE STRINGS, (B5) ON EXIT FROM *BUN* WILL CONTAIN
*         -(CHAR COUNT + 1).  I.E. 0 IS IMPOSSIBLE, -1 = 0 CHARS
*         IN STRING, -2 = 1 CHAR IN STRING, ETC.
  
  
 CH=CNT   BSSZ   1
 CH=SB3   SPACE  4,10 
**        CH=SB3 - SAVED (B3) FOR "S""S" AND 'S''S' PROCESSING. 
* 
* 
*         *CH=SB3* IS USED TO SAVE (B3), WHICH CONTAINS THE NEXT- 
*         AVAILABLE-CHARACTER BIT COUNT FOR (X6), DURING A CERTAIN
*         PART OF "" AND '' STRING PROCESSING.
* 
*         THIS IS A ROYAL KLUDGE, AND IS NECESSARY ONLY BECAUSE 
*         OF A WEIRDNESS THAT CAN HAPPEN DURING THE PROCESSING
*         OF THE IMBEDDED QUOTE-WITHIN-A-QUOTE-STRING SYNTAX. 
*         THAT IS, WHEN 2 CONSECUTIVE QUOTES ARE TO BE TREATED
*         AS A SINGLE CHARACTER.
* 
*         FOR EXAMPLE, IN --
* 
*         'SSS''SSS'  OR  "SSS""SSS"
* 
*         IF YOU WOULD BE SO KIND AS TO REFER TO THE *TOGEL PROC* 
*         CALLED *DQT* (PROCESS " DELIMITED STRING), WHICH IS THE 
*         *EXECUTIVE* FOR THE ENTOKENING OF "" STRINGS.  SINGLE 
*         QUOTE (') DELIMITED STRINGS ARE HANDLED BY *SQT* (PROCESS 
*         ' DELIMITED STRING)...THE PROCESSING IS ALMOST IDENTICAL. 
* 
*         BACK TO *DQT*.  *DQT* IS INVOKED AFTER THE " IS DETECTED VIA
*         THE STANDARD *CASEOF* PROCESSING FOR FTN NON-ALPHAMERICS. 
*         YOU CAN SEE THAT AFTER A LITTLE BIT OF BULLSHIT, *DQT*
*         GETS AROUND TO *GROUP*ING THE "" DELIMITED STRING.  AFTER 
*         WHICH, HE *CALT*S *TOK=ITQ* (IGNORE TERMINATING QUOTE) TO 
*         SET ENTOKENING REGISTER (X4) SO AS TO EFFECTIVELY CAUSE 
*         *TOK* (TOKEN GENERATOR) TO IGNORE THE " WHICH TERMINATES
*         THE CHARACTER STRING. 
* 
*         THE NEXT *TOGEL* INSTRUCTION IS THE *IFT (")*, WHICH
*         IS GOING TO TEST FOR A " IMMEDIATELY FOLLOWING THE
*         TERMINATING ".  IF ONE EXISTS, THEN *DQT* INVOKES *TOK=QOQ* 
*         (PROCESS QUOTE WITHIN QUOTE STRING) TO DO HIS THING.
* 
*         THE PROBLEM LIES IN THE *IFT*.  BEFORE THIS *IFT* CAN BE
*         EXECUTED/INTERPRETED BY *TOK*, HE HAS TO ASSURE THAT THERE
*         IS A CHARACTER IN (X4) FOR THE *IFT* PROCESSOR TO LOOK AT.
*         NOW, BECAUSE WE HAVE JUST SET (X4) *EMPTY* VIA *TOK=ITQ*, 
*         *TOK* WILL PERFORM A *BUN* (BURST/BUILD CHARACTERS W/ NO
*         BLANK SQUEEZE) CALL TO GET A CHARACTER INTO (X4). 
* 
*         THIS *BUN* CALL CAUSES (B3) TO BE RESET (TO AVOID AUTO- 
*         MATICALLY GENERATING A TOKEN).  BECAUSE (B3) IS RESET,
*         WHEN WE TRY TO PICK UP WHERE WE LEFT OFF FOR THE "" STRING, 
*         WE HAVE THE **WRONG** VALUE FOR (B3). 
* 
*         THEREFORE, WE SAVE (B3) IN (CH=SB3) BEFORE THE *IFT* IS 
*         INVOKED, AND RESTORE IT IN *TOK=QOQ* AFTER THE *IFT*
*         HAS BEEN EXECUTED.  NOTE THAT WE ONLY RESTORE (B3) IF 
*         THE *IFT* INDICATES *TRUE*, I.E. WHEN WE HAVE A QUOTE-
*         WITHIN-A-QUOTE-STRING.  WE DO NOT CARE ABOUT THE *FALSE*
*         CASE BECAUSE WE ARE STARTING WITH A NEW TOKEN, AND
*         THEREFORE A NEW (B3). 
  
  
 CH=SB3   BSSZ   1
 CH=TAD   SPACE  4,10 
**        CH=TAD - SAVED ADDR OF *O.HOLL* TOKEN.
* 
* 
*         *CH=TAD* CONTAINS THE ADDR IN *T.TB* OF THE *O.HOLL* OR 
*         *O.CHAR* TOKEN THAT IS CURRENTLY BEING GENERATED.  THIS IS
*         NECESSARY BECAUSE UPON ENCOUNTERING A CHARACTER/HOLLERITH 
*         TYPE STRING, WE FIRST GENERATE AN INCOMPLETE *O.HOLL/O.CHAR*
*         TOKEN TO *T.TB* AND THEN USE THE REST OF THE TOKEN BUFFER 
*         IMMEDIATLEY FOLLOWING OUR INVENTED *O.HOLL/O.CHAR* TOKEN
*         AS A SCRATCH AREA FOR ASSEMBLING THE CHARACTER/HOLLERITH
*         CONSTANT. 
* 
*         AFTER *TOK* (TOKEN GENERATOR) HAS FINISHED GROUPING THE 
*         CHARACTER/HOLLERITH STRING INTO THE SCRATCH AREA, *TOK=EOQ* 
*         (END OF QUOTE STRING) OR *TOK=EOC* (END OF CHARACTER
*         STRING) WILL ENTER THE STRING INTO *T.CHAR/T.CONS* FOR
*         THE REST OF THE COMPILER TO GET AT.  THESE END-OF-STRING
*         PROCESSORS NOW NEED TO GO BACK AND FILL IN SOME MISSING 
*         INFORMATION INTO THE INCOMPLETE *O.HOLL/O.CHAR* TOKEN.
* 
*         NOW WE GET TO THE POINT: (CH=TAD) TELLS US WHERE THE
*         INCOMPLETE TOKEN IS.
* 
*         *CH=TAD* IS ALSO USED AS A FLAG FOR DETERMINING WHETHER 
*         OR NOT WE HAVE AN INCOMPLETE *O.CHAR/O.HOLL* TOKEN
*         IN THE TOKEN BUFFER DURING ''/"" STRING PROCESSING. 
* 
*         THIS SITUATION (I.E. INCOMPLETE *O.CHAR/O.HOLL*) CAN
*         ARISE DUE TO 2 PATHOLOGIES ASSOCIATED WITH ""/'' STRING 
*         PROCESSING.  THEY ARE --
* 
*           A. WHEN ENCOUNTERING EOL DURING ''/"" STRING PROCESSING,
*              WE DO NOT KNOW WHETHER THERE EXISTS A CONTINUATION 
*              LINE (WE ASSUME THERE IS BECAUSE WE ASSUME THAT THE
*              FTN PROGRAMMER IS WRITING CORRECT PROGRAMS). 
* 
*              CONSIDER THE FOLLOWING EXAMPLES -- 
* 
*                  COL 7
*                      .
*                      STRING = 'ME 
*                     + ALONG'
* 
*                      STRING = 'ME UP
*                      NEW = STMT 
* 
*              EXAMPLE 1 IS OK, WHILE EXAMPLE 2 IS IN ERROR.  THE 
*              PROBLEM IS THAT WE DON'T KNOW THAT EXAMPLE 2 IS IN 
*              ERROR UNTIL WE READ THE NEXT LINE AND DETERMINE THAT 
*              IT IS **NOT** A CONTINUATION LINE. 
* 
*           B. THE SYNTAX THAT INSISTS THAT 2 QUOTES WITHIN 
*              A QUOTE STRING ARE TO BE TREATED AS A SINGLE 
*              QUOTE. 
* 
*              CONSIDER THE FOLLOWING EXAMPLES -- 
* 
*                  COL 7                                           72 
*                      .                                            . 
*                      STRING = 'TWO''ARE ONE'
* 
*                      STRING = 'THESE TWO__________________________' 
*                     +'ARE ONE TOO'
* 
*              THIS TWO-ARE-ONE SYNTAX HAS AN IMPORTANT IMPLICATION.
*              WE **CANNOT** BIND OFF ''/"" STRING PROCESSING AND, FOR
*              EXAMPLE, FILL IN THE MISSING INFORMATION INTO THE
*              INCOMPLETE *O.CHAR/O.HOLL* TOKEN UNTIL WE HAVE SEEN THE
*              CHARACTER IMMEDIATELY FOLLOWING THE '/" THAT WE **THINK**
*              IS THE TERMINATING '/".  BECAUSE IF THE IMMEDIATELY
*              FOLLOWING CHARACTER IS ANOTHER '/", THEN WE HAVE THE 
*              TWO-ARE-ONE SYNTAX.
* 
*              IN THE CASE OF A *MAYBE* TERMINATING '/" IN COL 72 
*              (EXAMPLE 2, ABOVE), WE CANNOT SEE THE CHARACTER
*              IMMEDIATELY FOLLOWING UNTIL WE READ THE NEXT LINE. 
* 
*              IF THIS *NEXT LINE* HAPPENS NOT TO BE A CONTINUATION 
*              LINE, THEN WE MUST BIND OFF THE INCOMPLETE STRING
*              IN *LEX*S MAIN LOOP... 
* 
*                ** IMPORTANT **
* 
*         BECAUSE *CH=TAD* IS AN ADDRESS AND NOT AN ORDINAL,
*         THIS SCHEME ONLY WORKS AS LONG AS *T.TB* (TOKEN BUFFER) 
*         NEVER MOVES DUE TO TABLE MANAGER SHENANIGANS. 
* 
*                     * * * 
  
  
 CH=TAD   BSSZ   1
 CH=TYPE  SPACE  4,10 
**        CH=TYPE - CHARACTER STRING TYPE CODE. 
* 
* 
*         *CH=TYPE* CONTAINS THE TYPE CODE OF AN -H-, -L-, -R-, 
*         "", OR '' CHARACTER STRING, AND IS USED BECAUSE WE NEED 
*         TO KNOW WHETHER TO RIGHT OR LEFT JUSTIFY AND/OR TO SPACE-FILL 
*         THE FINAL/LAST WORD OF THE CHARACTER STRING.
* 
*         CHARACTER STRING TYPE CODES ARE DEFINED VIA SYMBOLS 
*         OF THE FORM *CT.XXX* -- 
* 
*         CT.H  = HOLLERITH, I.E. LEFT-JUSTIFIED, SPACE FILLED. 
*         CT.L  = LEFT-JUSTIFIED, ZERO FILLED.
*         CT.R  = RIGHT-JUSTIFIED, ZERO FILLED. 
* 
*         CT.DQT = DOUBLE QUOTE "" DELIMITED STRING.
*         CT.SQT = SINGLE QUOTE '' DELIMITED STRING.
  
  
 CH=TYPE  BSSZ   1
  
 CT.H     =      1
 CT.L     =      2
 CT.R     =      3
  
 CT.DQT   =      4
 CT.SQT   =      5
 CT.OCT   =      6
 CT.HEX   =      7
 LEXFLG   SPACE  4,10 
**        LEXFLG - *LEX* MASTER CONTROL FLAG. 
* 
* 
*         *LEXFLG* CONTAINS MISCELLANEOUS CONTROL INFORMATION 
*         NEEDED DURING THE LEXICAL SCAN.  CONTROL FLAGS ARE
*         NOT NICE, BUT IT IS HOPED THAT BY KEEPING MOST CONTROL
*         INFORMATION AS BIT FIELDS IN A SINGLE FLAG THAT ITS 
*         USE WILL BE EASIER TO UNDERSTAND/MANAGE.
* 
*         FIELDS WITHIN *LEXFLG* ARE DESCRIBE/DEFINED IN *FTN5TXT*
*         VIA SYMBOLS OF THE FORM --
* 
*                LF.XXXP  AND  LF.XXXL
* 
*         WHERE FIELDS *XXX* ARE -- 
* 
*         CHR = 1  IF 'CHARACTER *' OCCURRED DURING TOKEN GENERATION, 
*                  ELSE 0.
* 
*                  *CHR* IS USED AS A COMMUNICATION FLAG BETWEEN
*                  TWO DIFFERENT PARTS OF THE TOKEN GENERATOR.
*                  THIS IS NECESSARY BECAUSE THERE IS AN AMBIGUITY
*                  INVOLVING ONE OF CDC'S EXTENSIONS TO THE FORTRAN 
*                  LANGUAGE --
* 
*                      CHARACTER * 3RATS
* 
*                  TO ANSI, THE ABOVE STATEMENT IS A LEGAL DECLARATION
*                  THAT THE VARIABLE *RATS* IS A CHARACTER VARIABLE 
*                  OF LENGTH 3.  TO FTN, WERE IT NOT FOR *CHR*, THIS
*                  STATEMENT CONTAINS A HOLLERITH CONSTANT 3RATS. 
*                  PROBLEM... 
* 
*                  THEREFORE, *CHR* IS A FLAG THAT INDICATES TO THE 
*                  *HLR* CONSTANT PROCESSOR (IN THE TOKEN GENERATOR)
*                  THAT WE ARE **NOT** GOING TO HONOUR *HLR* CONSTANTS
*                  ON THIS 'CHARACTER *' STATEMENT.  SUPER KLUDGE...
* 
*                  *HLR* (I.E. COUNT-CONTROLLED) CHARACTER STRINGS
*                  SHOULD NEVER HAVE BEEN PUT IN THE FTN SPEC...
*                  THEY ARE ALSO THE REASON THAT THE *FORMAT* STMT
*                  IS DIFFICULT TO ENTOKEN VIA THE STANDARD FTN 
*                  ENTOKENING RULES.
* 
*                  KLUDGE.  KLUDGE.  KLUDGE.
* 
*         INI = 1  IF AN INITIAL LINE HAS OCCURRED FOR THE STMT *LEX* 
*                  IS PROCESSING, ELSE 0.  *INI* IS CLEARED UPON ENTRY
*                  TO *LEX*, AND IS SET WHEN AN INITIAL LINE OCCURS 
*                  (I.E. WHEN (LN=TYPE)=LT.INIT).  IT IS USED SOLELY
*                  FOR THE PURPOSE OF DETERMINING WHETHER TO ISSUE THE
*                  *THIS STMT HAS NO INITIAL* WARNING ERR MSG.
* 
*         HDR = 1  IF IN *HEADER DELAY* MODE, ELSE 0. 
* 
*                  *HEADER DELAY* MODE IS AN ATTEMPT BY THE COMPILER TO 
*                  GET THE PROGRAM UNIT NAME INTO THE TITLE LINE OF THE 
*                  SOURCE LISTING BY DEFERRING ALL LISTING UNTIL THE
*                  HEADER STMT PROCESSOR HAS DETERMINED THE PROGRAM UNIT
*                  NAME AND STUFFED IT INTO THE TITLE LINE PRINT LINE 
*                  IMAGE. 
* 
*                  THIS IS ACCOMPLISHED BY SAVING **ALL** LINES (EVEN 
*                  COMMENT LINES) IN *T.STMT* (STMT/DEFERRED LIST 
*                  BUFFER) UNTIL AFTER THE APPROPRIATE HEADER STMT
*                  PROCESSOR HAS DONE ITS JOB.  WHEN THE TITLE LINE 
*                  IMAGE IS ALL SET UP, *FEC* (FRONT-END CONTROLLER)
*                  LISTS THE CONTENTS OF *T.STMT* VIA *LDB* (LIST 
*                  DEFERRED BUFFER).  THIS AUTOMATICALLY FORCES OUT 
*                  A NICE, PRETTY, PRECEDING TITLE LINE WITH A PROGRAM
*                  UNIT NAME. 
* 
*                  FOR EXAMPLE -- 
* 
*                    C  COMMENT         ..
*                    C  COMMENT          .
*                        .               .. SAVED UNTIL WE GET
*                        .               .  *PETRETR* FROM *PROGRAM*
*                       PROGRAM PETRETR ..  STMT PROCESSOR
* 
* 
*         LAC = 1  IF *LEX* IS ACTIVE, ELSE 0.  *LAC* IS A FLAG THAT
*                  IS USED AS A FORM OF DIRECT COMMUNICATION BETWEEN
*                  *LEX* AND *LDB* (LIST DEFERRED BUFFER), AND PERFORMS 
*                  THE IMPORTANT TASK OF KEEPING STRAIGHT A CERTAIN 
*                  PATHOLOGY CONCERNING THE MANAGEMENT OF *T.STMT* (STMT
*                  BUFFER).  *LAC* IS SET UPON ENTRY TO *LEX* AND IS
*                  CLEARED RIGHT BEFORE *LEX* EXITS BACK TO *FEC*.
* 
*                  THE NEED FOR *LAC* ARISES AS FOLLOWS: THE NORMAL 
*                  (I.E. NON-LEX) *LDB* CALLER CALLS *LDB* WITH THE 
*                  INTENT OF HAVING *T.STMT* APPROPRIATELY LISTED AND 
*                  THEN *SHRINK*D TO INDICATE THAT WE ARE FINISHED
*                  WITH IT.  THE MOST COMMON OCCURENCE OF THIS IS WHEN
*                  THE COMPILER DETECTS AN ERROR IN A SOURCE STMT IN
*                  *NO LIST* (E.G.  L=0) MODE.  ONCE *LDB* HAS BEEN 
*                  CALLED BY THE ERROR PROCESSOR, THE SPACE OCCUPIED
*                  BY *T.STMT* IS FREED UP FOR ALTENATE USE BY THE TABLE
*                  MANAGER. 
* 
*                  A PROBLEM ARISES, HOWEVER, IF *LEX* HAPPENS TO CALL
*                  *LDB* (IF FOR EXAMPLE, *LEX* DETECTS AN ERROR): *LEX*
*                  IS PUTTING LINES **INTO** *T.STMT* AND IS NOT YET
*                  FINISHED WITH IT, SO THAT IF *LDB* *SHRINK*S *T.STMT*
*                  TO ZERO...CONFLICT.
* 
*                  DUE TO THE UGLINESS AND INTERTWINEDNESS OF THE 
*                  LISTING LOGIC, *LDB* IS THE ONLY ONE WHO CAN REALLY
*                  KNOW WHEN TO *SHRINK* *T.STMT*...THEREFORE, *LAC*
*                  INFORMS *LDB* THAT *LEX* IS THE CALLER SO **NOT** TO 
*                  SHRINK *T.STMT*. 
* 
* 
*         QAC = 1  IF QUOTE STRING IS ACTIVE, ELSE 0.  *QAC* IS A FLAG
*                  THAT IS USED TO DETERMINE WHETHER OR NOT A QUOTE 
*                  DELIMITED STRING ('' OR "") HAS ITS TERMINATING
*                  QUOTE.  FOR EXAMPLE -- 
* 
*                      'ABCD' 
* 
*                  DOES, BUT -- 
* 
*                      'ABCD
* 
*                  DOES NOT.
* 
*                  *QAC* IS SET DURING TOKEN GENERATION WHEN THE
*                  INITIAL QUOTE OF A QUOTE DELIMITED STRING IS 
*                  ENCOUNTERED, AND IS CLEARED WHEN THE TERMINATING 
*                  QUOTE IS ENCOUNTERED.
* 
*                  *QAC* IS USED BY *LEX*S MAIN LOOP IN PUTTING OUT 
*                  AN ERROR MESSAGE FOR *MISSING TERMINATING QUOTE* 
*                  STRINGS.  CONSIDER THE FOLLOWING EXAMPLES -- 
* 
*                      COL 7
*                          .
*                          STRING = 'REAL 
*                         + BIG'
* 
*                          STRING = 'MISSING QUOTE
*                          NEW = STMT 
* 
*                  THE 1ST EXAMPLE CONTAINS A '' STRING THAT SPANS LINE 
*                  BOUNDARIES, WHEREAS THE 2ND EXAMPLE CONTAINS A ''
*                  STRING WITH A MISSING TERMINATING QUOTE.  A PROBLEM
*                  ARISES IN THE DETECTION OF THE ERROR IN OUR 2ND
*                  EXAMPLE BECAUSE *LEX* IS DRIVEN ON A LINE-BY-LINE
*                  BASIS.  THEREFORE, WHEN *LEX* SEES THE INITIAL LINE
*                  FOLLOWING THE LINE WITH THE MISSING QUOTE, 
*                  HE DOES NOT REINVOKE THE TOKEN GENERATOR TO
*                  CLEAN UP.  THIS MEANS THAT THERE IS AN INCOMPLETE
*                  *O.CHAR* TOKEN IN THE TOKEN BUFFER (I.E. THE 
*                  TOKEN GENERATOR WAS **EXPECTING** TO BE CALLED 
*                  AGAIN BECAUSE LEGAL STRINGS ARE PROPERLY DELIMITED). 
* 
*                  THEREFORE, WHEN *LEX* DETECTS AN INITIAL LINE
*                  (I.E. END OF CURRENT STMT), HE CHECKS *QAC* TO 
*                  SEE IF THE CURRENT STMT HAS AN IMPROPERLY TERMINATED 
*                  QUOTE DELIMITED STRING.
* 
*                      ** IMPORTANT **
* 
*                  IT IS VERY IMPORTANT TO REALIZE THAT *QAC* IS
*                  **SUBORDINATE** TO *CH=TAD*.  THAT IS, *QAC* 
*                  CAN TELL US WHETHER OR NOT A QUOTE STRING HAS
*                  ITS TERMINATING QUOTE, BUT IT CANNOT TELL US 
*                  WHETHER OR NOT THE QUOTE STRING IS COMPLETE/ 
*                  FINISHED.
* 
*                  THIS IS DUE TO THE ""/'' SYNTAX WHERE 2 QUOTES 
*                  IMBEDDED WITHIN A QUOTE STRING ARE TO BE TREATED 
*                  AS A SINGLE QUOTE.  THE PROBLEM IS THAT EVEN THOUGH
*                  WE SEE WHAT WE **THINK** IS THE TERMINAL "/',
*                  WE CAN NOT TIE THINGS OFF UNTIL WE HAVE LOOKED 
*                  AT THE CHARACTER IMMEDIATELY FOLLOWING TO SEE
*                  IF IT IS ANOTHER "/' (I.E. 2 QUOTES AS 1). 
* 
*                  CONSIDER ALSO THAT THIS *NEXT CHARACTER* MIGHT 
*                  BE ON THE NEXT LINE (I.E. THIS STATEMENT IS
*                  CONTINUED).
* 
*                  SEE *CH=TAD* FOR MORE INFORMATION. 
* 
*                           * * * 
  
  
 LEXFLG   BSSZ   1
          ENTRY  LEXFLG 
 LEXMODE  SPACE  4,10 
**        LEXMODE - *LEX* MASTER SCANNING MODE CONTROL CELL.
* 
* 
*         *LEXMODE* IS A CELL THAT IS USED BY *LEX* IN DETERMINING
*         WHICH MODE IT IS SCANNING IN.  THE CONTENTS OF *LEXMODE*
*         AT ANY TIME WILL CONTAIN A VALUE THAT INDICATES THE CURRENT 
*         LEXICAL SCANNING MODE.
* 
*         THE USE OF *LEXMODE* IS AN ATTEMPT TO INTEGRATE THE VARIOUS 
*         SPECIAL-CASE THINGS THE SCANNER MUST DO THAT TEND TO MUDDY
*         ITS CONTROL LOGIC.  FOR EXAMPLE, SPECIAL PROCESSING FLOWS 
*         ARE REQUIRED THE 1ST TIME THE SCANNER IS CRANKED UP, ETC... 
* 
*         *LEX* MODES ARE DEFINED VIA SYMBOLS OF THE FORM *LM.XXX*, 
*         WHERE *LM.* IS A COMMON PREFIX, AND *XXX* IS A UNIQUE LEXICAL 
*         SCANNING MODE.
* 
*         *LM.XXX* VALUES ARE --
* 
*           LM.NORM = NORMAL.  THIS IS *LEX*S NORMAL MODE WHERE THE 
*                     LIST/ENTOKEN/READ/CLASSIFY CYCLE IS PROCEEDING
*                     UNFETTERED BY WEIRDNESS...HA HA HEE HEE HO HO.
* 
*           LM.NTR  = NEED TO READ.  THIS *LEXMODE* IS SET WHEN THERE 
*                     IS NO SOURCE LINE AT *CP.CARD* ET SEQ FOR *LEX* 
*                     TO PROCESS.  IN THIS CASE, *LEX* MUST CALL *RNC*
*                     (READ NEXT CARD) **BEFORE** DOING ANYTHING ELSE.
* 
*           LM.1ST  = 1ST CARD OF PROGRAM UNIT.  SPECIAL START UP 
*                     REQUIRED. 
  
  
 LEXMODE  BSZENT 1
 LN=      SPACE  4,10 
***       LN= - LINE INFORMATION. 
* 
* 
*         SYMBOLS OF THE FORM *LN=XXX* (WHERE *XXX* IS A UNIQUE NAME) 
*         CONTAIN INFORMATION ABOUT THE CURRENT LINE AT (CP.CARD).
*         THEY ARE SET UP BY *CLN* (CLASSIFY LINE) AND ARE QUERIED
*         AND USED THROUGHOUT *LEX* WHEN INFORMATION ABOUT THE CURRENT
*         LINE AT (CP.CARD) IS NEEDED.
* 
*         THE FOLLOWING PARAGRAPHS DESCRIBE THE FORMAT AND USE OF EACH
*         OF THE *LN=* CELLS. 
* 
*                           ** WARNING ** 
* 
*         THESE *LN=* CELLS ARE LOCAL INFORMATION CELLS ONLY.  THEY 
*         EXIST TO MAKE A CLEAR DISTINCTION BETWEEN THE FUNCTIONS OF
*         DETECTION (CLN) AND CONTROL (LEX).  THE GLOBAL COMPILER 
*         SHOULD KNOW **NOTHING** OF THEIR EXISTENCE. 
* 
*                              * * *
* 
************************************************************************
 LN=FEN   SPACE  4,10 
**        LN=FEN - FIRST ENTOKENABLE CHARACTER POSITION.
* 
* 
*         *LN=FEN* CONTAINS INFORMATION ABOUT WHERE THE 1ST 
*         ENTOKENABLE CHARACTER IS IN A SOURCE LINE.  FOR NON-SEQ 
*         MODE INPUT LINES, THIS IS MERELY AN INDICATION OF COL 7.
*         FOR SEQ MODE INPUT LINES, *LN=FEN* INDICATES THE POSITION 
*         OF THE THE 1ST CHARACTER AFTER THE SEQ LINE NUMBER
*         (OR STMT LABEL, IF PRESENT).
* 
*         FOR EXAMPLE, NON-SEQ -- 
* 
*           COL 1     7 
*                 100     A = B 
*                     . 
*                     ............ LN=FEN 
* 
*         OR SEQ -- 
* 
*           COL 1    6  9 
*               00110 9    FORMAT(" MOMMY") 
*                       . 
*                       .......... LN=FEN 
* 
*         *LN=FEN* IS USED BY THE TOKEN GENERATOR WHEN PROCESSING 
*         CHARACTER/HOLLERITH CONSTANTS, AND IS BEST DESCRIBED VIA
*         AN EXAMPLE -- 
* 
*           COL 1     7   1         1 
*                 999 FORMAT(" THIS IS
*                    +    A REAL LONG MESSAGE") 
* 
*         WHEN GENERATING THE ABOVE CHARACTER CONSTANT STRING, *TOK*
*         MUST INVENT BLANK (55B) CHARACTERS FOR COLS 23-72 (THRU 
*         COL 80 IN SEQ MODE) OF THE INITIAL LINE AND FOR COLS 7-10 
*         OF THE CONTINUATION LINE.  THIS IS NECESSARY BECAUSE IN 
*         THE 1ST INSTANCE, THE OPERATING SYSTEM HAS STRIPPED THE 
*         TRAILING BLANKS, AND SECONDLY, *CLN* (CLASSIFY LINE)
*         STRIPPED THE BLANKS PRECEDING THE 1ST NON-BLANK ENTOKENABLE 
*         CHARACTER ON EACH LINE. 
* 
*         THEREFORE, *CLN* SAVES THE POSITION OF THE 1ST ENTOKENABLE
*         CHARACTER ON EACH LINE IN *LN=FEN* SO THAT THE CORRECT
*         NUMBER OF PRECEDING CHARACTER CONSTANT BLANKS CAN BE
*         GENERATED IF NECESSARY. 
* 
*         NOTE THAT (LN=FEN), (LN=FENB), AND (LN=FENL) ARE
*         TRANSFERED TO THE LINE INFORMATION HEADER THAT PRECEDES 
*         EVERY LINE IN *T.STMT* WHEN *PLR* (PROCESS LISTING
*         REQUEST) MOVES THE CURRENT LINE FROM *CP.FLIN* ET SEQ 
*         TO *T.STMT*.  SEE *PLR*.
* 
*         (LN=FEN)   = ORD, RELATIVE TO *CP.FLIN*, OF WORD CONTAINING 
*                      THE 1ST ENTOKENABLE CHARACTER IN THE CURRENT 
*                      LINE.
* 
*         (LN=FENB)  = BIT POSITION OF 1ST ENTOKENABLE CHAR IN (LN=FEN).
*                      (I.E. *TOK/BUB/BUN* REGISTER B6) 
* 
*         (LN=FENL)  = LEN (IN BITS) OF LINE.  I.E. RELATIVE TO 
*                      *LN=FEN/LN=FENB*.  (*TOK/BUB/BUN* REGISTER B7).
  
  
 LN=FEN   BSSZ   1
  
 LN=FENB  BSSZ   1
  
 LN=FENL  BSSZ   1
 LN=LABL  SPACE  4,10 
**        LN=LABL - LINE LABEL. 
* 
* 
*         *LN=LABL* CONTAINS THE LABEL FOR THE SOURCE LINE AT *CP.CARD*,
*         IN -L- FORMAT.
* 
*                            ** WARNING **
* 
*         *LN=LABL* CONTAINS THE **LINE** LABEL, **NOT** THE
*         **STATEMENT** LABEL.
* 
*                                * * *
  
  
 LN=LABL  BSSZ   1
 LN=NUM   SPACE  4,10 
**        LN=NUML/LN=NUMR - LINE NUMBER.
* 
* 
*         *LN=NUML* AND *LN=NUMR* CONTAIN THE LINE NUMBER OF THE
*         SOURCE LINE AT *CP.CARD*, IN -L- AND -R- FORMATS RESPECTIVELY.
* 
*         FOR NORMAL (I.E. NON-SEQ) LINES, THIS IS A *CDD* CONVERTED
*         COPY OF THE VALUE OF THE CELL *CARDS* WHICH CONTAINS THE
*         CURRENT NR OF CARDS/LINES THAT HAVE BEEN READ IN THIS 
*         PROGRAM UNIT (IN BINARY). 
* 
*         FOR *SEQ* LINES, THIS IS THE DISPLAY CODE CHARACTERS
*         THAT OCCURRED IN THE PROGRAMMER-SPECIFIED LINE NUMBER FIELD.
*         ELSE, .ZR. IF NO LINE NUMBER WAS SPECIFIED (*WARNING* ERROR --
*         LINE TREATED AS COMMENT). 
* 
*         (LN=NUML) = LINE NR IN -L- FORMAT.
*         (LN=NUMR) = LINE NR IN -R- FORMAT.
  
  
 LN=NUML  BSSZ   1
 LN=NUMR  BSSZ   1
 LN=TYPE  SPACE  4,10 
**        LN=TYPE - LINE TYPE.
* 
* 
*         *LN=TYPE* CONTAINS THE LINE TYPE OF THE SOURCE LINE 
*         AT (CP.CARD) ET SEQ.  *LN=TYPE* IS SET UP BY *CLN*
*         (CLASSIFY LINE) AND IS QUERIED THROUGHOUT *LEX* WHEN
*         THE LINE TYPE IS NEEDED.
* 
*         LINE TYPES ARE DEFINED BY *LT.* SYMBOLS --
* 
*           LT.UNTYP = LINE IS UNTYPED. 
*           LT.INIT  = LINE IS INITIAL LINE OF STMT.
*           LT.CONT  = LINE IS CONTINUATION LINE. 
*           LT.CMNT  = LINE IS COMMENT LINE.
*           LT.NULL  = LINE IS NULL (ALL BLANK).
*           LT.C$    = LINE IS *C$* LINE (COMPILER DIRECTIVE).
*           LT.EOR   = EOR/EOF/EOI ENCOUNTERED. 
  
  
 LN=TYPE  BSSZ   1
  
  
 LT.UNTYP =      0
 LT.INIT  =      1
 LT.CONT  =      2
 LT.CMNT  =      3
 LT.NULL  =      4
 LT.C$    =      5
 LT.EOR   =      6
 MX=      SPACE  4,10 
**        MX= - CHARACTER SHIFT MASKS.
* 
* 
*         CHARACTER SHIFT MASKS ARE OF THE FORM *MX=AAA*, WHERE *AAA* 
*         IS A UNIQUE MASK NAME.
  
  
 A        CHMIC  (0,1,2,3,4,5,6,7,8,9),BICH 
 MX=0..9  DATA   "A"
  
 B        CHMIC  (*,C)
 MX=CMNT  DATA   "B"
 SB./SB=  SPACE  4,10 
***       SB./SB= - *T.STMT* (STMT BUFFER) INFORMATION CELLS. 
* 
* 
*         SYMBOLS WITH THE PREFIX *SB.* OR *SB=* DESCRIBE OR CONTAIN
*         INFORMATION ABOUT *T.STMT*, THE STMT BUFFER.
 SB.      SPACE  4,10 
**        SB. - *T.STMT* (STMT BUFFER) STRUCTURE DEFINITIONS. 
* 
* 
*         SYMBOLS OF THE FORM *SB.XXXP* AND *SB.XXXL* DESCRIBE/DEFINE 
*         THE *LINE INFORMATION* HEADER WORD THAT PRECEDES EVERY
*         SOURCE LINE IN *T.STMT*.
* 
*         FIELDS, *XXX*, WITHIN *SB.* STRUCTURE REFER TO A SINGLE 
*         LINE INFORMATION HEADER WORD, AND ARE --
* 
*         LEN  = NR OF WORDS IN THIS *T.STMT* LINE ENTRY.  I.E. LEN 
*                OF ENTIRE LISTABLE SOURCE LINE (INCLUDING FULL WORD EOL
*                MARK) BEGINNING AT *CP.FLIN*, + 1 FOR LINE INFORMATION 
*                HEADER WORD ITSELF.
* 
*         LIST = 1  IF THIS LINE WAS LISTED VIA *PLR*, ELSE 0.
* 
*                USED AS COMMUNICATION BETWEEN *PLR* (PROCESS LISTING 
*                REQUEST) AND *LDB* (LIST DEFERRED BUFFER).  THIS FLAG
*                IS NECESSARY SO THAT *LDB* CAN KNOW WHETHER *PLR*
*                ACTUALLY LISTED A PARTICULAR SOURCE LINE IN *T.STMT*.
* 
*                I.E. THIS BIT PREVENTS A LINE FROM POSSIBLY GETTING
*                LISTED TWICE: ONCE BY *PLR* AND AGAIN BY *LDB*.
* 
*         LNT  = LINE TYPE. THIS IS A COPY OF (LN=TYPE), AND IS 
*                CARRIED ALONG WITH EACH SOURCE LINE SO THAT ANY
*                INTERESTED PARTIES CAN KNOW THE LINE TYPE OF THE 
*                FOLLOWING LINE IN *T.STMT*.
* 
*                NOTE: CURRENTLY, THIS FIELD IS SET UP BUT **UNUSED**.
  
  
          DESCRIBE SB.
 LOUT     DEFINE 1
 LERR     DEFINE 1
 LIST     DEFINE 1
 FEN      DEFINE 18 
 FENB     DEFINE 6
 FENL     DEFINE 9
 LNT      DEFINE 6
 LEN      DEFINE 18 
 SB=CONT  SPACE  4,10 
**        SB=CONT - CONTINUATION LINE COUNT.
* 
* 
*         *SB=CONT* CONTAINS THE NR OF CONTINUATION LINES FOR 
*         THE CURRENT STMT IN *T.STMT*, AND IS USED IN THE FOLLOWING
*         WAYS -- 
* 
*           1. (SB=CONT) IS USED BY *LEX*S MAIN LOOP IN DETERMINING 
*              IF AND WHEN TO ISSUE THE *THIS STMT HAS TOO MANY 
*              CONTINUATION LINES* ERROR MSG. 
* 
*              THIS ERROR MSG IS ISSUED IF THE NR OF CONTINUATION LINES 
*              EVER EXCEDES *ANS.CONT* (MAXIMUM ANSI CONTINUATION LINE
*              COUNT).
* 
*           2. (SB=CONT) IS ALSO USED BY *LCC* (PROCESS LOADER
*              DIRECTIVES) IN DECK *KEY* IN DETERMINING WHETHER 
*              OR NOT TO ISSUE AN ERROR MSG IF A LOADER DIRECTIVE 
*              IS CONTINUED (THEY MAY NOT BE).
  
  
 SB=CONT  BSZENT 1
 SB=LINC  SPACE  4,10 
**        SB=LINC - *T.SMT* LINE COUNT. 
* 
* 
*         *SB=LINC* CONTAINS THE NR OF LINES CURRENTLY IN *T.STMT*, 
  
 SB=LINC  BSZENT 1
 SB=LORD  SPACE  4,10 
**        SB=LORD - ORD OF LAST/LATEST LINE IN *T.STMT*.
* 
* 
*         *SB=LORD* CONTAINS THE ORDINAL INTO *T.STMT* OF THE LAST
*         LINE THAT WAS MOVED TO *T.STMT*.  *SB=LORD* IS SET UP 
*         BY *PLR* (PROCESS LISTING REQUEST) WHEN IT MOVES A LINE 
*         FROM *CP.FLIN/CP.CARD* ET SEQ TO *T.STMT*, AND IS USED
*         FOR 2 PURPOSES -- 
* 
*           1. *PLR* ITSELF USES (SB=LORD) IN SETTING THE *SB.LOUTP*
*              BIT IN THE *LINE INFORMATION* WORD OF THE LINE IT IS 
*              PROCESSING.  THIS OCCURS BECAUSE THE PROCESSING THAT 
*              ACTUALLY MOVES A SOURCE LINE TO *T.STMT* AND THE 
*              PROCESSING THAT SETS THE *SB.LOUTP* BIT WITHIN *PLR*,
*              ARE SUFFICIENTLY FAR APART THAT THE ORDINAL OF THE 
*              LINE WE ARE PROCESSING **MUST** BE SAVED IN *SB=LORD*. 
* 
*           2. (SB=LORD) ARE ALSO USED IN THE MAIN LOOP OF *LEX*, 
*              RIGHT BEFORE INVOKING *TOK* (TOKEN GENERATOR), FOR 
*              THE RELOCATION OF (TC=SOA) AND (LN=FEN). 
* 
*              THAT IS, (TC=SOA) AND (LN=FEN) ARE CONVERTED FROM
*              ORDINALS RELATIVE TO *CP.FLIN* INTO HARD ADDRESSES 
*              VIA (SB=LORD). 
  
 SB=LORD  BSZENT 1
 TB=      SPACE  4,10 
***       TB= - TOKEN BUFFER/STATEMENT INFORMATION. 
* 
* 
*         SYMBOLS OF THE FORM *TB=XXX* (WHERE *XXX* IS A UNIQUE NAME) 
*         CONTAIN INFORMATION ABOUT THE CURRENT STATEMENT AT *T.TB*.
*         THESE CELLS ARE SET UP BY *LEX* AND ARE QUERIED THROUGHOUT
*         THE COMPILER WHEN INFORMATION ABOUT THE STMT AT *T.TB* IS 
*         DESIRED.  THESE *TB=* CELLS ARE, THEREFORE, GLOBAL COMPILER 
*         INFORMATION CELLS.
* 
*         IT CAN BE SEEN THAT THESE *TB=* CELLS HAVE A LOGICAL
*         RELATIONSHIP TO THE *LN=* LINE INFORMATION CELLS.  ??MORE?? 
 TB=1ST   SPACE  4,10 
**        TB=1ST - ADDR OF 1ST NON-KEYWORD TOKEN IN *T.TB*. 
* 
* 
*         *TB=1ST* CONTAINS THE ADDR OF THE 1ST NON-KEYWORD TOKEN 
*         IN THE TOKEN BUFFER, *T.TB*.  (TB=1ST) CONTAINS, THEREFORE, 
*         THE ADDR OF THE 1ST TOKEN THAT A STMT PROCESSOR IS TO BEGIN 
*         SCANNING. 
* 
*         *TB=1ST* IS ONLY NECESSARY BECAUSE THE TOKEN BUFFER, *T.TB*,
*         IS ONLY A QUASI-MANAGED TABLE.  THAT IS, IT IS DEFINED TO 
*         BE A MANAGED TABLE BUT IT CAN ONLY GROW OR SHRINK.  IT
*         **CAN NOT** AND **MUST NOT** MOVE BECAUSE ALL REFS INTO IT
*         ARE VIA HARD ADDRESSES (I.E. NOT ORDINALS). 
* 
*         THE ABOVE IMPLIES THAT *T.TB* (THE CELL CONTAINING THE FWA
*         OF THE TOKEN BUFFER) MUST NOT CHANGE, I.E. ITS VALUE IS 
*         FIXED AT MANAGED TABLE SET-UP-TIME AND THEREAFTER REMAINS 
*         CONSTANT. 
* 
*         *TB=1ST* IS ESSENTIALLY A COMPANION CELL TO *T.TB*.  IT IS
*         USED WHEN WE WOULD LIKE TO SHORTEN THE TOKEN BUFFER FROM
*         ITS FRONT-END (I.E. RESET *T.TB*), BUT CANNOT FOR FEAR THAT 
*         IF WE DO, THE TABLE MANAGER MIGHT MOVE THE TOKEN BUFFER.
  
  
 TB=1ST   CONENT 0
 TB=CDF   SPACE  4,10 
**        TB=CDF - C$ FLAG. 
* 
* 
*         *TB=CDF* IS A FLAG THAT INDICATES WHETHER OR NOT THE STATEMENT
*         IN *T.TB* IS ON A *C$* LINE OR NOT AND IS USED BY *CST* TO
*         DETERMINE WHETHER OR NOT THIS STATEMENT **BELONGS** ON A *C$* 
*         LINE. 
* 
*         FOR EXAMPLE --
* 
*                C$    LIST(S=0)         DOES, BUT... 
* 
*                C$    A = B             DOES NOT.
* 
*         (TB=CDF) = 1 IF STATEMENT IN *T.TB* IS ON A *C$* LINE, ELSE 0.
  
  
 TB=CDF   BSSZ   1
 TB=LAB   SPACE  4,10 
**        TB=LABL/TB=LABR - STATEMENT LABEL.
* 
* 
*         *TB=LABL* AND *TB=LABR* CONTAIN THE LABEL OF THE
*         1ST (I.E. THE INITIAL) LINE OF STMT AT *T.TB* IN -L-
*         AND -R- FORMATS RESPECTIVELY. 
* 
*         (TB=LABL) = STMT LABEL IN -L- FORMAT. 
*         (TB=LABR) = STMT LABEL IN -R- FORMAT. 
  
 TB=LABL  BSZENT 1
 TB=LABR  BSZENT 1
 TB=LLP   SPACE  4,10 
**        TB=LLP - LAST LEFT PAREN. 
* 
* 
*         *TB=LLP* CONTAINS THE ADDR IN *T.TB* OF THE LAST LEFT 
*         PAREN (O.LP) TOKEN GENERATED AT A PAREN LEVEL **GREATER** 
*         THAN 0. 
* 
*         (TB=LLP) IS SET EVERYTIME *TOK* GENERATES AN *O.LP* TOKEN,
*         AND IS CLEARED WHEN AN *O.RP* TOKEN CAUSES THE PAREN LEVEL
*         TO GO TO ZERO.
* 
*         *TB=LLP* IS USED SO THAT *LEX* CAN LINK INTERESTING LEFT
*         PARENS TO ONE ANOTHER AND ALSO TO THEIR MATCHING RIGHT
*         PAREN.
* 
*         THIS *LINKED PAREN* INFORMATION WILL BE USED BY THE PARSER
*         AND BY THE DECK *IO* TO SIMPLIFY THEIR SYNTACTIC HANDLING 
*         OF LEFT/RIGHT PAREN PAIRS.
* 
*         CONSIDER THE FOLLOWING EXAMPLE: A STATEMENT IN WHICH ONLY THE 
*         LEFT AND RIGHT PARENS ARE SHOWN.  *O.LP* TOKENS WILL BE LINKED
*         DURING TOKEN GENERATION IN THE FOLLOWING MANNER (PLUS SIGN +
*         IS USED IN LIEU OF AN ARROW-HEAD) --
* 
*                ...... ............
*           LLP  .    . .          .
*                +    . +          .
*                (     (     )     (     )     )     (     )
*                .     .     +     .     +     +     .     +
*           IOCP .     .     .     .     .     .     .     .
*                .     .......     .......     .     .......
*                .                             .
*                ...............................
* 
*         IT CAN BE SEEN THAT LEFT-PARENS ARE LINKED **BACKWARDS** TO 
*         A PREVIOUS LEFT PAREN IN THE SAME PAREN NEST, AND THAT LEFT 
*         PARENS ARE ALSO LINKED **FORWARD** TO THEIR MATCHING RIGHT
*         PAREN.
* 
*         NOTE THAT THE RIGHT-MOST LEFT PAREN IS NOT LINKED BACK TO 
*         ANOTHER LEFT PAREN BECAUSE IT CONSTITUTES THE BEGINNING OF
*         ANOTHER PAREN NEST (I.E. IT OCCURS AT PAREN LEVEL 0). 
* 
*         NOTE ALSO THAT **ALL** LINKING INFORMATION RESIDES IN THE 
*         *TB.LLP* AND *TB.IOCP* FIELDS IN THE *O.LP* TOKEN(S)...THE
*         *O.RP* TOKENS ARE UNTOUCHED.
* 
*         SEE *TOK=LP* (TOKEN GENERATOR/LEFT PAREN PROCESSOR) AND 
*         *TOK=RP* (TOKEN GENERATOR/RIGHT PAREN PROCESSOR) FOR MORE 
*         INFORMATION.
  
  
 TB=LLP   BSSZ   1
 TB=NUM   SPACE  4,10 
**        TB=NUML/TB=NUMR - STATEMENT LINE NUMBER.
* 
* 
*         *TB=NUML* AND *TB=NUMR* CONTAIN THE LINE NUMBER OF THE
*         1ST (I.E. THE INITIAL) LINE OF THE STMT AT *T.TB* IN -L-
*         AND -R- FORMATS RESPECTIVELY. 
* 
*         THIS LINE NUMBER IS USED BY THE COMPILER FOR -- 
* 
*           1. SETTING UP THE REFERENCE MAP REFERENCES FOR SYMBOLS
*              THAT OCCUR IN THIS STMT. 
* 
*           2. SETTING UP TRACEBACK INFORMATION THAT IS TO BE PASSED
*              TO THE FTN LIBRARY (USED FOR DIAGNOSING ERRORS AT
*              EXECUTION TIME). 
* 
*         NOTE THAT *TB=NUML/TB=NUMR* ARE BOTH DERIVED FROM 
*         *LN=NUML/LN=NUMR*.
* 
*         (TB=NUML) = STMT LINE NR IN -L- FORMAT. 
*         (TB=NUMR) = STMT LINE NR IN -R- FORMAT. 
  
  
 TB=NUML  BSZENT 1
 TB=NUMR  BSZENT 1
 TB=PLVL  SPACE  4,10 
**        TB=PLVL - PARENTHESIS LEVEL.
* 
* 
*         *TB=PLVL* CONTAINS THE CURRENT PAREN LEVEL DURING TOKEN 
*         GENERATION.  DURING THE LEFT-TO-RIGHT ENTOKENING PASS 
*         MADE BY *TOK* ACROSS EACH SOURCE STMT, (TB=PLVL) ARE
*         INCREMENTED FOR EACH LEFT-PAREN *(*, AND DECREMENTED
*         FOR EACH RIGHT-PAREN *)* ENCOUNTERED. 
* 
*         *TB=PLVL* IS USED PRIMARILY FOR DETERMINING WHEN TO SET 
*         THE *ZL* (ZERO LEVEL) CELLS.
  
  
 TB=PLVL  CONENT 0
 TB=TYPE  SPACE  4,10 
**        TB=TYPE - STATEMENT TYPE. 
* 
* 
*         *TB=TYPE* CONTAINS THE ADDR OF THE STATEMENT PROCESSOR
*         THAT IS TO PROCESS THE STMT AT *T.TB*.  THIS CELL IS
*         SET UP VIA *CST* (CLASSIFY STATEMENT) AND IS USED BY
*         THE FRONT END CONTROLLER (FEC) TO TRANSFER CONTROL TO 
*         THE APPROPRIATE STMT PROCESSOR. 
  
  
 TB=TYPE  CONENT 0
 TOKCOM   SPACE  4,10 
**        TOKCOM - USER/TOK COMMUNICATIONS AREA.
* 
* 
*         *TOKCOM* CONTAINS INFORMATION THAT IS TO BE PASSED BETWEEN
*         *LEX* AND *TOK*.  LOCATIONS WITHIN *TOKCOM* ARE DEFINED VIA 
*         ORDINALS INTO *TOKCOM*.  THESE ORDINALS ARE DEFINED VIA 
*         SYMBOLS OF THE FORM --
* 
*                TC.XXX 
* 
*         WHERE *TC.* IS A COMMON PREFIX, AND *XXX* IS A *TOKCOM* 
*         LOCATION ORDINAL NAME  (*TC.XXX* SYMBOLS ARE DEFINED
*         IN *COMSTOK*).  **ALL** REFERENCES INTO *TOKCOM* SHOULD BE VIA
*         *TC.XXX* SYMBOLS. 
  
  
 FW.TCOM  BSSZ   L.TCOM 
  
  
          LOC    FW.TCOM
 TC=P     =      *+TC.P 
 TC=SOA   =      *+TC.SOA 
 TC=SOX   =      *+TC.SOX 
 TC=SOL   =      *+TC.SOL 
 TC=SOB   =      *+TC.SOB 
 TC=SOC   =      *+TC.SOC 
 TC=TBA   =      *+TC.TBA 
 TC=TBB   =      *+TC.TBB 
 TC=RSF   =      *+TC.RSF 
 TC=BOL   =      *+TC.BOL 
 TC=EOL   =      *+TC.EOL 
 TC=REST  =      *+TC.REST
          LOC    *O 
 KEYW     TITLE  KEYW - FTN KEYWORD TABLE.
***       KEYW - FTN KEYWORD TABLE. 
* 
* 
*         THIS SECTION CONTAINS THE FTN KEYWORD TABLE (FWA AT 
*         *FW.KEYW*).  THIS *KEYW* TABLE CONTAINS ONE ENTRY 
*         (DEFINED VIA *KEYW* MACRO) FOR EACH POSSIBLE FTN
*         STMT.  THIS *KEYW* TABLE CONTAINS INFORMATION THAT IS 
*         USED IN 2 DIFFERENT WAYS -- 
* 
*           1. IN DETERMINING THE TYPE OF A STMT (I.E. IN DETERMINING 
*              WHICH STMT PROCESSOR IS TO PROCESS A PARTICULAR STMT), 
*              *CST* (CLASSIFY STMT TYPE) USES THE *KEYW* TABLE DURING
*              ITS KEYWORD SEARCH: EACH *KEYW* ENTRY CONTAINS THE ADDR
*              OF A LITERAL STRING THAT IS A FTN KEYWORD.  *CST* TRIES
*              TO MATCH THE KEYWORD THAT OCCURS ON A STMT WITH AN ENTRY 
*              IN THE *KEYW* TABLE. 
* 
*              EXCEPTION: STMTS THAT ARE SYNTACTICALLY DEFINED, SUCH AS 
*              THE REPLACEMENT STMT, ARE SPECIAL-CASED (I.E. NO KEYWORD 
*              SEARCH IS PERFORMED).  HOWEVER, THESE SYNTACTICALLY
*              DEFINED STMTS DO HAVE A SPECIAL *KEYW* ENTRY...SEE 
*              BELOW. 
* 
*           2. AFTER A STMT HAS BEEN TYPED (I.E. AFTER A *KEYW* ENTRY 
*              HAS BEEN CHOSEN FOR A STMT), *CST* TRANSFERS THE 
*              APPROPRIATE *KEYW* ENTRY TO (TB=TYPE).  IN THIS WAY, 
*              ANYBODY WHO IS INTERESTED IN THIS STMTS *KEYW* ENTRY 
*              CAN KNOW WHERE TO FIND IT.  THIS IMPLIES, OF COURSE, 
*              THAT A STMTS *KEYW* ENTRY CONTAINS SOMETHING OF INTEREST 
*              TO THE REST OF THE COMPILER...SEE BELOW. 
* 
*         FIELDS WITHIN EACH INDIVIDUAL *KEYW* ENTRY ARE
*         DESCRIBE/DEFINED IN THE USUAL MANNER VIA SYMBOLS
*         OF THE FORM --
* 
*                KW.XXXL  AND  KW.XXXP
* 
*         WHERE *KW.* IS A COMMON PREFIX AND *XXX* IS A UNIQUE FIELD
*         NAME. 
* 
*         FIELDS *XXX* WITHIN *KW.* STRUCTURE ARE --
* 
*         KEY  = ADDR OF SPECIAL LITERAL STRING (GENERATED VIA
*                *LITKEY* MACRO IN *FTN5TXT*) THAT CONTAINS THE 
*                CHARACTERS THAT CONSTITUTE THIS *FORTRAN* KEYWORD. 
* 
*                THE *LITKEY* MACRO GENERATES THE KEYWORD IN
*                TOKEN-SIZE CHUNKS OF 7 CHARS PER WORD, WHERE EACH
*                CHUNK IS IN -L- FMT. 
* 
*                E.G. *SUBROUTINE* BECOMES -- 
*                  0LSUBROUT
*                  0LINE
* 
*                *CST* (CLASSIFY STATEMENT) IN DECK *LEX* WILL TRY
*                AND MATCH THE 1ST *O.VAR* TOKEN IN EACH STMT WITH
*                ONE OF THE *KEY* LITERALS.  IF A MATCH IS FOUND, 
*                THEN THE *JMP* FIELD OF THIS MATCHING *KEYW* ENTRY 
*                CONTAINS THE ADDR OF THE STMT PROCESSOR THAT IS
*                TO PROCESS THIS STMT.
* 
*                NOTE THAT FOR SYNTACTICALLY DEFINED STMTS SUCH AS
*                *DO*, *IF*, AND REPLACEMENT, THAT NO KEYWORD SEARCH
*                IS PERFORMED AND THE *KEY* FIELD IS SET TO .MI. SO 
*                THAT INTERESTED PARTIES CAN KNOW THAT THIS IS A
*                SYNTACTICALLY DEFINED STMT.
* 
*         LEN  = LENGTH OF KEYWORD (IN BITS). 
* 
*         JMP  = ADDR OF THE STMT PROCESSOR THAT IS TO PROCESS A STMT 
*                DEFINED BY THIS *KEYW* ENTRY.
* 
*         FEC  = *FEC* (FRONT END CONTROLLER) STAGE THAT A STMT 
*                WITH THIS *KEYW* ENTRY CAN OCCUR IN...WHAT MANNER
*                OF BARSOOMIAN MADNESS IS THIS (SEE *FEC=* IN DECK
*                *FEC* FOR MORE, NOT MUCH MORE, INFO).
* 
*         ATTR = ATTRIBUTES OF THIS STATEMENT.  *ATTR* FIELD CONSISTS 
*                OF A NUMBER OF BIT FLAGS THAT CONTAIN MISCELLANEOUS
*                INFORMATION ABOUT THIS STMT.  SEE BELOW. 
* 
* 
*         *ATTR* BIT FLAGS ARE -- 
* 
*         DON  = 1 IF THIS STMT MAY NOT BE A *DO* TERMINAL, ELSE 0. 
* 
*         NIF  = 1 IF THIS STMT MAY NOT BE THE OBJECT OF A LOGICAL
*                  *IF*, ELSE 0.
* 
*         LBL  = 1 IF THIS STMT MAY HAVE A REFERRABLE LABEL, ELSE 0.
* 
*         GEN  = 1 IF THIS STMT GENERATES CODE, ELSE 0. 
* 
*         BKD  = 1 IF THIS STMT IS LEGAL WITH A *BLOCKDATA* 
*                  SUBPROGRAM, ELSE 0.
* 
*         PWS  = 1 IF THIS STMT IS TO BE PROCESSED WHILE SKIPPING,
*                  (STAGE = FEC=BY), ELSE 0.
* 
*         IL   = 1 IF THIS STMT HAS IMPLIED LABEL (NOPATH INVALID), 
*                  ELSE 0.
  
  
 FW.KEYW  BSS    0           ** FWA OF KEYWORD TABLE ** 
  
          KEYW   ASSIGN,EXU,(GEN,LBL) 
          KEYW   BACKSPACE,EXU,(GEN,LBL)
          KEYW   BLOCKDATA,1ST,(NIF)
          KEYW   BOOLEAN,TYP,(BKD,NIF)
          KEYW   BUFFER,EXU,(GEN,LBL) 
          KEYW   CALL,EXU,(GEN,LBL) 
          KEYW   CHARACTER,TYP,(BKD,NIF)
          KEYW   CLOSE,EXU,(GEN,LBL)
          KEYW   COMMON,DEC,(BKD,NIF) 
          KEYW   COMPLEX,TYP,(BKD,NIF)
          KEYW   CONTINUE,EXU,(GEN,LBL) 
          KEYW   DATA,DAT,(BKD,NIF,GEN,IL,NBS)
          KEYW   DECODE,EXU,(GEN,LBL) 
          KEYW   DIMENSION,DEC,(BKD,NIF)
          KEYW   DOUBLEPRECISION,TYP,(BKD,NIF)
          KEYW   ELSE,EXU,(GEN,NIF,DON,IL)
          KEYW   ENCODE,EXU,(GEN,LBL) 
 KY=END   KEYW   END,END,(BKD,DON,GEN,NIF,LBL,IL,PWS) 
          KEYW   ENDFILE,EXU,(GEN,LBL)
          KEYW   ENDIF,EXU,(GEN,LBL,NIF,DON,IL) 
          KEYW   ENTRY,ENT,(GEN,NIF,IL) 
          KEYW   EQUIVALENCE,DEC,(BKD,NIF)
          KEYW   EXTERNAL,DEC,(NIF) 
          KEYW   FORMAT,FMT,(LBL,NIF) 
          KEYW   FUNCTION,1ST,(NIF) 
          KEYW   GOTO,EXU,(GEN,LBL) 
          KEYW   IMPLICIT,IMP,(BKD,NIF) 
          KEYW   INQUIRE,EXU,(GEN,LBL)
          KEYW   INTEGER,TYP,(BKD,NIF)
          KEYW   INTRINSIC,DEC,(NIF)
          KEYW   LEVEL,DEC,(BKD,NIF)
          KEYW   LOGICAL,TYP,(BKD,NIF)
          KEYW   NAMELIST,DAT,(NIF) 
          KEYW   OPEN,EXU,(GEN,LBL) 
          KEYW   OVCAP,1ST,(NIF)
          KEYW   OVERLAY,1ST,(NIF)
          KEYW   PARAMETER,PRM,(BKD,NIF)
          KEYW   PAUSE,EXU,(GEN,LBL)
          KEYW   PRINT,EXU,(GEN,LBL)
          KEYW   PROGRAM,1ST,(NIF)
          KEYW   PUNCH,EXU,(GEN,LBL)
          KEYW   READ,EXU,(GEN,LBL) 
          KEYW   REAL,TYP,(BKD,NIF) 
          KEYW   RETURN,EXU,(DON,GEN,LBL) 
          KEYW   REWIND,EXU,(GEN,LBL) 
          KEYW   SAVE,DEC,(BKD,NIF) 
          KEYW   STOP,EXU,(DON,GEN,LBL) 
          KEYW   SUBROUTINE,1ST,(NIF) 
          KEYW   WRITE,EXU,(GEN,LBL)
  
  
 .T       IFEQ   TEST,ON
          KEYW   BREAK,OK,(BKD) 
          KEYW   PATCH,OK,(BKD,NIF) 
 .T       ENDIF 
  
 L.KEYW   =      *-FW.KEYW
 KEYW     SPACE  4,10 
**        KEYW - SPECIAL ENTRIES FOR SYNTACTICALLY DEFINED STMTS. 
  
  
 UNTYP.   CON    0
 STF.     KEYW   =SFD,STF,(NIF) 
 DO.      KEYW   DO,EXU,(DON,GEN,LBL,NIF) 
 IF.      KEYW   =IFS,EXU,(GEN,LBL) 
 REP.     KEYW   =CNF,EXU,(GEN,LBL) 
 EOS      KEYW   =E.ME,END,(BKD,GEN,IL,PWS) 
 KEY$     SPACE  4,10 
**        KEY$ - ENTRIES FOR C$ DIRECTIVE KEYWORDS. 
  
  
 FW.KEY$  BSS    0           ** FWA OF C$ DIRECTIVE KEYWORD TABLE **
  
          KEY$   BEGCOM,OK,(BKD)
          KEY$   COLLATE,OK,(GEN,NBS) 
          KEY$   DO,OK,(GEN,NBS)
          KEY$   ELSE,OK,(PWS,BKD)
          KEY$   ENDCOM,OK,(BKD)
          KEY$   ENDIF,OK,(PWS,BKD) 
          KEY$   IF,OK,(PWS,BKD)
          KEY$   LIST,OK,(BKD,GEN,NBS)
  
 L.KEY$   EQU    *-FW.KEY$
  
  
 FW.KEYS  CON    FW.KEYW,FW.KEY$
 L.KEYS   CON    L.KEYW,L.KEY$
 LEX      TTL    LEX - LEXICAL SCANNER/MAIN EXECUTIVE LOOP. 
          EJECT 
 LEX      SPACE  4,10 
**        LEX - LEXICAL SCANNER MAIN EXECUTIVE. 
* 
* 
*         THIS IS THE LEXICAL SCANNER MAIN EXECUTIVE WHICH CONTROLS 
*         THE LEXICAL SCANNING FOR A SINGLE SOURCE STATEMENT (INITIAL 
*         LINE PLUS CONTINUATION LINES).
* 
*         *LEX* IS CALLED BY *FEC* (FRONT END CONTROLLER) ONCE PER
*         *FORTRAN* SOURCE STATEMENT, AND PERFORMS THE FOLLOWING
*         TASKS --
* 
*           1. READS SOURCE LINES FROM THE SOURCE INPUT FILE, *F.IN*. 
* 
*           2. LISTS SOURCE LINES TO THE LISTABLE OUTPUT FILE, *F.OUT*. 
*              THIS ALSO INVOLVES THE GENERATION/MANAGEMENT OF THE
*              STMT/DEFERRED LIST BUFFER, *T.STMT*. 
* 
*           3. ENTOKENS THE SOURCE STATEMENT. 
* 
*           4. CLASSIFIES THE SOURCE STATEMENT (I.E. DETERMINES WHICH 
*              STATEMENT PROCESSOR IS TO PROCESS THIS STATEMENT). 
* 
*         STRUCTURALLY, THE LEXICAL SCANNER MAIN EXECUTIVE IS COMPRISED 
*         OF 2 PARTS:  A MAIN LOOP AND A FINAL PROCESSING PHASE.
* 
*         THE MAIN LOOP IS TRAVERSED ONCE PER SOURCE LINE (EMPHASIZE
*         *LINE*), AND CAN BE REPRESENTED BY THE FOLLOWING DIAGRAM -- 
* 
*                                +---------+
*                                +  LIST   +
*                                +  (PLR)  +
*                                +---------+
* 
*                    +---------+             +---------+
*                    +CLASSIFY +             + ENTOKEN +
*                    +LINE(CLN)+             +  (TOK)  +
*                    +---------+             +---------+
* 
*                                +---------+
*                                +  READ   +
*                                +  (RNC)  +
*                                +---------+
* 
*         WHERE MOTION IS CLOCKWISE AND *PLR*, *TOK*, *RNC*, AND *CLN*
*         ARE THE EXECUTIVES THAT PERFORM EACH ABOVE-SPECIFIED TASK.
* 
*         IN GENERAL, THIS MAIN LOOP IS EXITED WHEN *LEX* SENSES
*         THE BEGINNING OF THE STMT **FOLLOWING** THE STMT THAT *FEC* 
*         ORIGINALLY CALLED *LEX* FOR.  I.E. END-OF-CURRENT-STMT IS 
*         BEGINNING-OF-NEXT-STMT. 
* 
*         WHEN THIS *EXIT MAIN LOOP* CONDITION IS SATISFIED, *LEX*
*         ENTERS ITS *FINAL PROCESSING PHASE*.  AT THIS POINT, THE
*         ENTIRE SOURCE STMT HAS BEEN ACCUMULATED IN *T.STMT* (STMT 
*         BUFFER) AND ENTOKENED TO *T.TB* (TOKEN BUFFER).  *LEX* NOW
*         CALLS ITS FIFTH EXECUTIVE, *CST* (CLASSIFY STATEMENT) TO
*         DETERMINE THE STMT TYPE (I.E. AMONG OTHER THINGS, THE 
*         APPROPRIATE STMT PROCESSOR ADDR) FOR THE STMT IN *T.TB*.
* 
*         AT THIS POINT, *LEX* HAS SATIATED ITSELF AND CONTROL RETURNS
*         TO THE CALLER, *FEC*. 
* 
*                            ** IMPORTANT **
* 
*         THE CONCEPTS, LOGIC, TRADE-OFFS/RATIONALES, AND DATA
*         STRUCTURES OF THIS LEXICAL SCANNER ARE DISCUSSED AT MUCH
*         MORE LENGTH IN THE FTN 5 IMS/DECK *LEX*.  TRY IT. 
* 
*                                 * * * 
* 
* 
*         ENTRY  MISCELLANEOUS GLOBAL COMPILER CELLS/FLAGS AND DATA 
*                STRUCTURES SET UP.  E.G. CONTROL CARD OPTIONS, 
*                MANAGED TABLE CELLS, FET/FITS, ... 
* 
*         EXIT   T.STMT  = ENTIRE SOURCE STMT IN SAVED/LISTABLE FORM. 
* 
*                T.TB    = ENTIRE SOURCE STMT IN ENTOKENED FORM.
* 
*                (TB=XXX), WHERE *XXX* IS A UNIQUE NAME, CONTAIN
*                          MISCELLANEOUS INFORMATION ABOUT THE SOURCE 
*                          STMT AT *T.TB*.  SEE *DATA STRUCTURES/TB=*.
* 
*         USES   ALL         HA HA HO HO AND HEE HEE
* 
*         CALLS  CLN,CST,CUA,FATAL,ILX,LTB,PLR,RNC,WARN 
  
  
 LEX      SUBR   =           ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          RJ     ILX         INITIALIZE *LEX* 
          SA1    LEXFLG 
          SA2    LEXMODE
          MX3    1
          LX3    LF.INIP-59 
          SX7    X2-LM.NTR
          BX6    -X3*X1      CLEAR *INI*
          SA6    A1 
          SX4    X2-LM.1ST
          ZR     X7,LEX10    IF *NEED TO READ*
          ZR     X4,LEX10    IF 1ST LINE IN PGM UNIT
  
*         LIST SOURCE LINE AT (CP.CARD) ET SEQ. 
  
 LEX2     RJ     PLR         PROCESS LISTING REQUEST
  
*         SPLIT UP PROCESSING FLOW ACCORDING TO THE *LINE TYPE* 
*         OF THE LINE AT (CP.CARD) ET SEQ.
  
          SA1    LN=TYPE
  
 .T       IFEQ   TEST,ON
          SX2    X1-L.LN1 
          MI     X1,"BLOWUP" IF LINE TYPE TOO SMALL...
          PL     X2,"BLOWUP" IF LINE TYPE TOO BIG...
 .T       ENDIF 
  
          SA2    LEX=LN1+X1 
          SB5    X2          (B5) = *LN1* ADDR TO JUMP TO 
          JP     B5+         GO TO IT...
 LEX=LN1  SPACE  4,10 
**        LEX=LN1 - FIRST *LINE TYPE* JUMP TABLE. 
  
 LEX=LN1  BSS    0
  
          LOC    0
  
 UNTYP    LNJP   "BLOWUP"    IF LINE IS UNTYPED 
  
 INIT     LNJP   LEX3        IF LINE IS INITIAL LINE OF STMT
  
 CONT     LNJP   LEX5        IF LINE IS CONTINUATION LINE 
  
 CMNT     LNJP   LEX10       IF LINE IS COMMENT 
  
 NULL     LNJP   LEX10       IF LINE IS ALL BLANK (I.E. NULL) 
  
 C$       LNJP   LEX4        IF LINE IS *C$* LINE 
  
 EOR      LNJP   LEX20       IF EOR/EOF/EOI ENCOUNTERED 
          LOC    *O 
  
 L.LN1    =      *-LEX=LN1
 LEX      SPACE  4,10 
*         HERE IF AN INITIAL LINE OF STATEMENT IS AT (CP.CARD). 
* 
*         NEED TO PROCESS LINE LABEL (LN=LABL) AND TRANSFER 
*         TO STMT LABEL (TB=LABL).  *CUL* (CHECK UPCOMING LABEL)
*         IS CALLED TO ASSEMBLE AND CHECK THE STMT LABEL. 
* 
*         *CUL* WILL -- 
* 
*           1. STRIP ANY BLANKS FROM THE STMT LABEL.
* 
*           2. STRIP ANY LEADING ZEROES FROM THE LABEL. 
* 
*           3. DETECT AND DIAGNOSE ANY ILLEGAL (NON-NUMERIC)
*              CHARACTERS IN THE STMT LABEL.
* 
*           4. ISSUE A *WARN* ERROR MSG FOR A ZERO LABEL, 
*              E.G.     A=B 
*                    00 CONTINUE
  
 LEX3     SA1    LN=LABL
          BX6    X6-X6
          SX7    -B1
          ZR     X1,LEX3A    IF NO LABEL ON THIS LINE 
          SX6    1R 
          LX6    4*CHAR 
          BX1    X1+X6
  
          CALL   CUL         CHECK UPCOMING LABEL 
          PL     X6,LEX3A    IF LABEL IS OK 
          SX6    0
  
 LEX3A    LX7    X6,B2
          SA6    TB=LABR            SAVE (X6) = STMT LABEL, -R- FMT 
          =A7    A6+TB=LABL-TB=LABR SAVE (X7) = STMT LABEL, -L- FMT 
          EQ     LEX4 
  
  
*         HERE IF WE ARE READY TO ENTOKEN THE 1ST LINE OF A STMT. 
* 
*         WE CAN BE HERE UNDER THE FOLLOWING CIRCUMSTANCES -- 
* 
*           A. IF THIS IS THE INITIAL LINE OF A STMT, AS INDICATED VIA
*              COLUMN 6 (PS: HERE AFTER LABEL PROCESSING).
* 
*           B. IF THIS IS A *C$* LINE (I.E. ALL *C$* LINES ARE INITIAL
*              BECAUSE THEY CAN NOT BE CONTINUED).
* 
*           C. IF THIS IS A CONTINUATION LINE WITH NO INITIAL.  THAT IS,
*              A CONTINUATION LINE AS THE 1ST NON-COMMENT LINE IN A 
*              PROGRAM UNIT, OR AS THE 1ST NON-COMMENT LINE FOLLOWING 
*              A *C$* LINE/STMT.
* 
*         NEED TO --
* 
*           1. TRANSFER LINE NR *LN=NUML/LN=NUMR* TO STMT LINE NR 
*              *TB=NUML/TB=NUMR* SO THAT STMT PROCESSORS CAN GET
*              TO THEM IF THEY WANT.
* 
*           2. CLEAR *LEXFLG/LF.INIP* TO INDICATE THAT AN INITIAL 
*              LINE HAS OCCURRED FOR THIS STMT. 
* 
*           3. SET UP THE PSEUDO P REGISTER (TC=P) FOR *TOK*
*              (COMMON TOKEN GENERATOR).  *TC=P* INDICATES
*              WHERE IN THE TOGEL OBJECT MODULE (TOM) THAT *TOK*
*              IS TO BEGIN EXECUTING/INTERPRETING.
  
 LEX4     SA1    LN=NUML
          SA2    LN=NUMR
          SA3    LN=TYPE
          BX6    X1 
          LX7    X2 
          SX3    X3-LT.C$ 
          SA6    TB=NUML
          SA7    TB=NUMR
          SA1    LEXFLG 
          MX7    0
          SA7    TC=RSF      SET TO *BEGINNING A NEW STMT*
          SA7    TC=EOL      RESET LAST STATEMENTS END OF LINE PROC.
          SA7    TC=REST     RESET LAST STATEMENTS RESTART PROC.
          NZ     X3,LEX4A    IF THIS IS NOT C$ STATEMENT
          =X7    1
  
 LEX4A    SA7    TB=CDF      FLAG C$
          MX3    1
          LX3    LF.INIP-59 
          BX6    X3+X1       SET *INI*
          SX7    TOM=BOS     (X7) = ADDR *TOK* IS TO BEGIN XEQ IN TOM 
          SA6    A1 
          SA7    TC=P 
          EQ     LEX8 
  
  
*         HERE IF A CONTINUATION LINE.
* 
*         NEED TO --
* 
*           1. ISSUE *WARNING* ERR MSG IF THIS CONTINUATION 
*              LINE HAS NO INITIAL.  THEN TREAT THIS LINE AS AN INITIAL.
* 
*           2. ISSUE *WARNING* ERR MSG IF THIS CONTINUATION 
*              LINE HAS TRASH IN LABEL FIELD. 
* 
*           3. INCREMENT AND CHECK (SB=CONT), THE CONTINUATION
*              LINE COUNT.
  
 LEX5     SA1    LEXFLG 
          SA2    LN=LABL
          LX1    59-LF.INIP 
          MI     X1,LEX6     IF THIS STMT HAS AN INITIAL LINE 
          WARN   E.INI       *THIS STMT HAS NO INITIAL LINE*
          EQ     LEX4        TREAT AS INITIAL...
  
 LEX6     ZR     X2,LEX7     IF NO LABEL
          WARN   E.TLBL      *TRASH IN LABEL FIELD IGNORED* 
  
*         INITIALIZE FOR ENTOKENING CONTINUATION LINE.
  
 LEX7     SA1    SB=CONT
          SX6    B1 
          SX7    X1+B1
          SA6    TC=RSF       SET TO *RESTARTING TOKEN GENERATION*
          SA7    A1+
  
          SX2    X1-ANS.CONT
          MI     X2,LEX8     IF CONTINUATION LINE COUNT IS OK 
          NZ     X2,LEX8     IF HAVE ALREADY ISSUED ERR MSG 
          FATAL  E.MCA       *TOO MANY CONTINUATION LINES*
  
*         READY TO ENTOKEN THE LINE AT *T.STMT*.
* 
*           1. ALLOCATE ENOUGH TABLE SPACE IN TOKEN BUFFER FOR NEW
*              LINE TO ENTOKEN.  THE LENGTH OF *T.TB* IS INCREASED
*              BY 82D WHICH REFLECTS THE MAXIMUM NR OF TOKENS 
*              THAT COULD POSSIBLY BE GENERATED FOR THIS SOURCE 
*              LINE.
* 
*              AFTER ENTOKENING THE LINE AT *T.STMT*, THE LENGTH OF 
*              *T.TB* IS SHRUNK TO THE ACTUAL LENGTH OF THE TOKEN BUFFER
*              (I.E. AS DETERMINED BY HOW MANY TOKENS *TOK* GENERATED). 
* 
*           2. CONVERT *TC=SOA* AND *TC=TBA* FROM ORDINALS TO HARD
*              ADDRESSES.  IN THIS WAY, *TOK* CAN LOCK (A5) AND (A6)
*              THEREBY NOT HAVING TO WORRY ABOUT ADDRESS BIASING. 
*              SEE *TOK*.  UPON RETURNING FROM *TOK*, *LEX* WILL
*              CONVERT *TC=TBA* FROM AN AN ADDRESS BACK TO AN ORDINAL.
*              IN THIS WAY, *LEX* DOES NOT HAVE TO WORRY ABOUT
*              RELOCATING THIS POINTER ACROSS ANY POSSIBLE *ALLOC*
*              CALLS. 
* 
*           3. CALL *TOK* TO ENTOKEN THE SOURCE LINE AT *T.STMT*. 
*              NOTE THAT MOST OF THE *LEX/TOK* COMMUNICATION CELLS
*              HAVE ALREADY BEEN SET UP (THE EXCEPTIONS ARE *TC=SOA*
*              AND *TC=TBA* WHICH ARE DISCUSSED ABOVE). 
  
 LEX8     ALLOC  T.TB,82D 
  
*         RELOCATE (TC=TBA).
  
          SA2    TC=TBA 
          IX6    X1+X2
          SA6    A2 
  
*         RELOCATE (TC=SOA).
  
          SA1    T.STMT 
          SA2    SB=LORD     (X2) = *T.STMT* ORD OF LINE TO ENTOKEN 
          SA3    TC=SOA      (X3) IS RELATIVE TO *CP.FLIN*
          SB2    X2+B1
          SB3    X1+B2
          SX6    B3+X3       RELOCATE (TC=SOA)
          SA6    A3 
  
*         ENTOKEN THE SOURCE LINE.
  
          SB2    FW.TCOM     (B2) = FWA OF *USER/TOK* COMMUNICATIONS
          RJ     TOK         TOKEN GENERATOR
  
          SA1    T.TB 
          SA2    TC=TBA 
          IX7    X2-X1
          SX6    X7+1        (X6) = TRUE LEN OF *T.TB*
          SA7    A2 
          SHRINK T=TB,X6
  
*         NEED TO DO SOME SPECIAL CASING TO AVOID READ-AHEAD. 
*         SPECIAL CASES ARE --
* 
*           1. WHEN *END* OCCURS AS THE INITIAL LINE OF A STMT. 
* 
*           2. WHEN A *C$* LINE/STMT OCCURS.  IN THIS CASE, 
*              WE ALSO NEED TO SET *NEED TO READ* STATUS IN (LEXMODE).
* 
*              THE NEXT TIME *LEX* IS CALLED, THIS WILL CAUSE THE LINE
*              IMMEDIATELY FOLLOWING THIS C$ LINE/STMT TO FIRST BE READ.
  
          SA1    T.TB 
          SA2    LN=TYPE
          SA3    =0LEND 
          SA1    X1+B1       (X1) = 1ST TOKEN AFTER *BOS* (I.E. KEYWORD)
          MX4    TB.TOCL
          SX6    X2-LT.INIT 
          BX1    X4*X1       (X1) = STMT KEYWORD IN -L- FMT 
          NZ     X6,LEX9     IF NOT AN INITIAL LINE 
          IX6    X1-X3
          NZ     X6,LEX10    IF NOT *END* 
          SA2    KY=END 
          SA1    A1+B1       (X1) = TOKEN THAT FOLLOWS *END*
          BX6    X2 
          NZ     X1,LEX10    IF *END* NOT FOLLOWED BY *EOS* 
          SX7    A1+         (X7) = ADDR OF TOKEN THAT FOLLOWS *END*
          SA6    TB=TYPE
          SA7    TB=1ST 
          EQ     LEX11A      AVOID READ-AHEAD...
  
 LEX9     SX7    X2-LT.C$ 
          NZ     X7,LEX10    IF NOT *C$* LINE 
          SX6    LM.NTR 
          SA6    LEXMODE     SET TO *NEED TO READ*
          EQ     LEX11       AVOID READ-AHEAD...
  
*         READ NEXT CARD. 
  
 LEX10    RJ     RNC         READ NEXT CARD 
  
*         CLASSIFY LINE AT (CP.CARD) ET SEQ.
  
          RJ     CLN         CLASSIFY LINE
  
*         SPLIT UP PROCESSING FLOW ACCORDING TO THE *LINE TYPE* 
*         OF THE LINE AT (CP.CARD) ET SEQ.
* 
*         NOTE: WE NEED TO SPECIAL-CASE THE *NEED TO READ* AND
*         *1ST LINE OF PGM UNIT* CASES SO THAT THIS LINE GETS HANDLED 
*         PROPERLY.  UPON ENTRY TO *LEX*, THESE LINES WERE EITHER 
*         NOT READ AND/OR NOT CLASSIFIED SO WE NOW NEED TO GO BACK
*         TO THE TOP OF THE LEXICAL SCAN MAIN LOOP IN ORDER TO GET
*         BACK IN SYNC (I.E. ACT LIKE THEY WERE REGULAR OLD NORMAL
*         SOURCE LINES).
  
          SA1    LN=TYPE
  
 .T       IFEQ   TEST,ON
          SX2    X1-L.LN2 
          MI     X1,"BLOWUP" IF LINE TYPE IS TOO SMALL... 
          PL     X2,"BLOWUP" IF LINE TYPE IS TOO BIG... 
 .T       ENDIF 
  
          SA4    LEXMODE
          SX6    X4-LM.NTR
          SX7    X4-LM.1ST
          BX6    X6*X7
          NZ     X6,LEX10B   IF NOT FUNNY START-UP
  
          SX6    LM.NTR      *** KLUDGE FOR CMNTS BEFORE 1ST STMT *** 
          SX7    X1-LT.CMNT 
          SA6    A4+         SET TO *NEED-TO-READ FOR CMNTS*
          ZR     X7,LEX10B   IF COMMENT LINE BEFORE 1ST STMT (KLUDGE) 
          SX7    X1-LT.NULL 
          ZR     X7,LEX10B   IF NULL LINE BEFORE 1ST STMT (KLUDGE)
          =X6    LM.NORM
          SA6    A4          CLEAR TO *NORMAL* MODE 
          EQ     LEX2 
  
 LEX10B   SA2    LEX=LN2+X1 
          SB5    X2+         (B5) = *LN2* ADDR TO JUMP TO 
          JP     B5          ONWARD...
 LEX=LN2  SPACE  4,10 
**        LEX=LN2 - 2ND *LINE TYPE* JUMP TABLE. 
  
 LEX=LN2  BSS    0
  
          LOC    0
  
 UNTYP    LNJP   "BLOWUP"    IF LINE IS UNTYPED 
  
 INIT     LNJP   LEX11       IF LINE IS INITIAL LINE OF STMT
  
 CONT     LNJP   LEX2        IF LINE IS CONTINUATION
  
 CMNT     LNJP   LEX2        IF LINE IS COMMENT 
  
 NULL     LNJP   LEX2        IF LINE IS NULL (ALL BLANK)
  
 C$       LNJP   LEX11       IF LINE IS C$ LINE/STMT
  
 EOR      LNJP   LEX11       IF EOR/EOF/EOI ENCOUNTERED 
  
          LOC    *O 
  
 L.LN2    =      *-LEX=LN2
 LEX      SPACE  4,10 
*         HERE TO TYPE THE STATEMENT AT *T.TB* AND SAVE 
*         THE STMT TYPE AT (TB=TYPE). 
  
 LEX11    SA1    T.TB        (X1) = FWA OF *T.TB* 
          SB4    X1+1        (B4) = ADDR OF TOKEN IMMEDIATELY FOLLOWING 
*                                   *BOS* TOKEN 
          RJ     CST         CLASSIFY STATEMENT 
  
 LEX11A   BSS    0
  
 .T       IFEQ   TEST,ON
          SA1    =XCO.IDP 
          LX1    1RM
          PL     X1,LEX11B   IF *IDP=M* NOT SELECTED
 IDP=M    BREAK 
  
 LEX11B   SA1    CO.SNAP
          LX1    1RM
          PL     X1,LEX12    IF *SNAP=M* NOT SELECTED 
          CALL   LTB=        LIST TOKEN BUFFER
  
 LEX12    BSS    0
  
 .T       ENDIF 
  
*         CHECK FOR INCOMPLETE '/" STRING.
* 
*         SEE *LEXFLG/QAC*, *CH=TAD*, AND *CH=TYPE* FOR MORE
*         INFORMATION.
  
          SA1    CH=TAD      (X1) = ADDR OF INCOMPLETE *O.CHAR/O.HOLL*
          SA2    CH=TYPE     (X2) = STRING TYPE CODE (I.E. "" OR '')
          ZR     X1,LEX14    IF NO INCOMPLETE *O.CHAR/O.HOLL* TOKEN 
          SA3    LEXFLG 
          LX3    59-LF.TDEP 
          PL     X3,LEX13    IF MISSING DELIMITER 
          SA3    T.TB 
          SA4    TC=TBA      (X4) = *T.TB* ORD OF *EOS* TOKEN 
          IX6    X3+X4
          SB3    X6          (B3) = LWA+1 OF '/" STRING 
          SX3    X2-CT.SQT
          ZR     X3,LEX12A   IF '' STRING 
          RJ     EOH         END OF HOLLERITH STRING PROCESSING 
          RJ     TTB         TERMINATE TOKEN BUFFER 
          EQ     LEX14
  
 LEX12A   RJ     EOC         END OF CHARACTER STRING PROCESSING 
          RJ     TTB         TERMINATE TOKEN BUFFER 
          EQ     LEX14
  
 LEX13    SX6    1R'
          SX7    X2-CT.SQT
          ZR     X7,LEX13B   IF '' STRING 
  
          SX7    X2-CT.H
          ZR     X7,LEX13C   IF *H* STRING
          SX6    1R"
  
 LEX13B   LX6    10*CHAR-1*CHAR  (X6) = MISSING DELIMITER, -L- FMT
          SA6    FILL.
          FATAL  E.HC3       ** TERMINAL DELIMITER MISSING ** 
          =X6    O.ILL
          SA2    =7LBAD-STR 
          BX6    X6+X2
          SA6    X1          O.CHAR TO O.ILL
          RJ     TTB         TERMINATE TOKEN BUFFER 
          EQ     LEX14
  
*         HERE IF INCOMPLETE -H-, -L-, OR -R- STRING. 
* 
*         ISSUE APPROPRIATE ERROR MESSAGE.
  
 LEX13C   SX6    O.ILL
          SA2    =7LBAD-STR 
          BX6    X6+X2
          SA6    X1          *O.HOLL* BECOMES *O.ILL* 
          RJ     TTB         TERMINATE TOKEN BUFFER 
  
          FATAL  E.HC2       ** EOS BEFORE END OF HOLLERITH **
  
*         CLEAR *LEXFLG/LF.LAC* BIT TO INDICATE THAT *LEX* IS NO LONGER 
*         ACTIVE.  SEE *LEXFLG*.
  
 LEX14    SA1    LEXFLG      (X1) = *LEX* MASTER CONTROL FLAG 
          MX2    1
          LX2    LF.LACP-59 
          BX6    -X2*X1      CLEAR *LAC*
          SA6    A1 
          EQ     EXIT.       BACK TO FRONT END CONTROLLER...
  
 LEX20    SA1    EOS
          BX6    X1 
          SA6    TB=TYPE     INVENTED END LINE
          SA1    LEXFLG 
          CLAS=  X2,LF,(LAC)
          BX7    -X2*X1      SET TO *LEX NOT ACTIVE*
          SA7    A1 
          SBIT   X1,LF.HDRP 
          PL     X1,LEX21    IF NOT IN *HEADER DELAY* 
          RJ     LDB         LIST DEFERRED BUFFER 
  
 LEX21    SA1    LEX.DLN
          MX6    0
          LX7    X1 
          SA6    SB=LINC     SET TO NO LINES PRESENT
          SA7    TB=NUML     SET TO MAX LINE/SEQ NUM TO AVOID BAD DIAG
          EQ     EXIT.
  
 LEX.DLN  CON    5L99999
 LEX      TTL    LEX - LEXICAL SCANNER/THE EXECUTIVES.
          EJECT 
 CLN      SPACE  4,10 
**        CLN - CLASSIFY LINE.
* 
* 
*         THIS ROUTINE IS RESPONSIBLE FOR PERFORMING SOME INITIAL 
*         LINE (EMPHASIZE *LINE*) ANALYSIS/PROCESSING ON THE INPUT
*         SOURCE LINE AT (CP.CARD). 
* 
*         *CLN* WILL PERFORM THE FOLLOWING TASKS -- 
* 
*           1. DETERMINE THE LINE TYPE OF THE LINE VIA THE PROCEDURES 
*              OUTLINED IN THE FTN5 IMS/DECK *LEX*.  LINE TYPES ARE --
* 
*              A. INITIAL LINE OF STATEMENT.
*              B. CONTINUATION LINE.
*              C. COMMENT LINE. 
*              D. NULL (ALL BLANK) LINE.
*              E. C$ LINE.
*              F. EOR/EOF ENCOUNTERED.
* 
*           2. PROVIDE/SET UP THE LINE NUMBER OF THE LINE.
* 
*           3. EXTRACT THE LABEL SPECIFIED ON THE LINE (IF PRESENT).
* 
*           4. STRIP THE BLANK (55B) CHARACTERS THAT PRECEDE THE 1ST
*              ENTOKENABLE CHARACTER ON THE LINE.  TOKEN GENERATION,
*              IF APPROPRIATE FOR THIS LINE, WILL THEREFORE BEGIN AT
*              THIS 1ST NON-BLANK CHARACTER.  THIS BLANK STRIP IS 
*              REQUIRED IN ORDER TO CORRECTLY TYPE A *NULL* (I.E. ALL 
*              BLANK) LINE.  SEE BELOW. 
* 
*           5. SAVE THE POSITION OF THE 1ST NON-BLANK ENTOKENABLE 
*              CHARACTER IN *TOKCOM*, THE *USER/TOK* COMMUNICATIONS 
*              AREA, SO THAT THE TOKEN GENERATOR CAN KNOW WHERE TO
*              BEGIN TOKEN GENERATION OF THIS LINE.  NOTE THAT NOT
*              ALL LINES ARE ENTOKENABLE (E.G. COMMENT LINES).
* 
*         *CLN* COMMUNICATES MOST OF THE ABOVE INFORMATION TO THE REST
*         OF *LEX* VIA A NUMBER OF DATA CELLS THAT HAVE NAMES OF THE
*         FORM -- 
* 
*                LN=XXX 
* 
*         WHERE *LN=* IS A COMMON PREFIX, AND *XXX* IS A UNIQUE NAME. 
*         BRIEFLY, THE *LN=* CELLS ARE -- 
* 
*           LN=TYPE  CONTAINS THE LINE TYPE  (INITIAL, CONTINUATION,
*                    ETC) OF THE LINE.
*           LN=NUM   CONTAINS THE LINE NUMBER OF THE LINE.
*           LN=LABL  CONTAINS THE LABEL THAT OCCURRED ON THE LINE,
*                    IF ONE WAS PRESENT.
*           LN=FEN   CONTAINS THE POSITION OF THE 1ST ENTOKENABLE 
*                    CHARACTER ON THE LINE, IF APPROPRIATE.  THE WORD 
*                    *APPROPRIATE* HERE MEANS: IF THE LINE **HAS**
*                    AN ENTOKENABLE CHARACTER (I.E. NOT COMMENT). 
* 
*         SEE *LN=* CELLS AND THEIR DESCRIPTIONS FOR A MORE DETAILED
*         DESCRIPTION OF THESE CELLS AND THEIR FORMATS. 
* 
* 
*         THE SOURCE LINE AT (CP.CARD) WILL/CAN BE IN 1 OF 2 FORMATS, 
*         AS DETERMINED BY THE PRESENCE OR ABSENCE OF THE *SEQ* FTN 
*         CONTROL CARD OPTION. (INDICATED VIA *CO.SEQ*).  SEE FTN5
*         IMS/DECK *LEX* FOR A DESCRIPTION OF *SEQ* AND NON-*SEQ* LINES 
*         IN THE CHAPTER ENTITLED *CLN AND LINE CLASSIFICATION*.
* 
*         ENTRY  (CP.CARD) ET SEQ = INPUT SOURCE LINE IN PACKED (10 CHAR
*                                   PER WORD) FORMAT. 
*                (CP.IFMT) = 1S59 IF EOR/EOF/EOI ENCOUNTERED, ELSE 0. 
* 
*         EXIT   *LN=* CELLS SET UP.
*                *TC=* (TOKCOM) CELLS SET UP. 
* 
*         USES   ALL BUT (A0) 
* 
*         CALLS  BUB,BUN,CDD
  
  
 CLN      SUBR               ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SA5    CP.CARD
          SA2    L.CARD      (X2) = NR OF WORDS IN SOURCE LINE
          MX0    -CHAR
          BX6    X6-X6
          SA6    LN=LABL     CLEAR *LINE LABEL* 
          SA6    LN=NUML     CLEAR *LINE NUMBER, -L- FMT* 
          SA6    LN=NUMR     CLEAR *LINE NUMBER, -R- FMT* 
          SA6    LN=FEN 
          SA6    LN=FENB
          SA6    LN=FENL
          SX7    LT.EOR 
          SA7    LN=TYPE     PRESET TO *EOR/EOF OCCURRED* 
  
          SA1    CP.IFMT
          MI     X1,EXIT.    IF EOR/EOF/EOI ENCOUNTERED, DONE...
  
          SX2    X2-1        (X2) = NR OF USEABLE WORDS IN SOURCE LINE
*                                   I.E. EXCLUDING FULL WORD EOL MARK 
          SX3    60D         (X3) = NR OF BITS IN A WORD
          SA6    A7          CLEAR TO *LINE IS UNTYPED* 
          IX4    X2*X3       (X4) = NR OF BITS IN SOURCE LINE 
          SB5    8*60        (B5) = MAX NR OF BITS PER LINE 
          SB7    X4 
          LE     B7,B5,CLN1  IF LINE NOT TOO LONG 
          SB7    B5 
  
 CLN1     SA1    CO.SEQ 
          NZ     X1,CLN10    IF THIS IS *SEQ* MODE INPUT
 CLN      SPACE  4,10 
**        HERE FOR NORMAL (NON-SEQ) LINE. 
* 
*           1. CHECK LINE LENGTH AND MAKE SURE THAT LINE IS .LE. 8 WORDS
*              LONG.  ALSO ASSURE THAT IF THIS LINE **IS** 8 WORDS LONG,
*              THAT (TC=SOBE) ARE SET UP SO THAT DURING TOKEN GENERATION
*              OF THIS LINE, *BUB/BUN* WILL ONLY PROCESS 2 CHARS FROM 
*              THE 8TH WORD  (I.E. COLS 71 AND 72). 
* 
*           2. SET UP LINE NUMBER, *LN=NUM*, TO BE A COMPILER-GENERATED 
*              NUMBER EQUAL TO THE NR OF CARDS/LINES READ SO FAR IN 
*              THIS PROGRAM UNIT (SEE *CARDS*). 
* 
*           3. EXTRACT THE LINE LABEL FROM COLS 1-5 AND SAVE
*              IN *LN=LABL*.
* 
*           4. TYPE THE LINE BY SCANNING COLS 1-6.  NOTE THAT FOR 
*              A NULL (ALL BLANK) LINE, THE **ENTIRE** SOURCE LINE
*              MUST BE SCANNED.  SEE *CLN* SUBROUTINE PREAMBLE ABOVE. 
* 
*           5. SAVE STARTING CHAR POSITION OF THE ENTOKENABLE PART
*              OF THIS LINE (I.E. COL 7).  THIS IS USED BY *TOK*
*              WHEN HE HAS TO INVENT BLANKS FOR A CHARACTER CONSTANT
*              THAT IS CONTINUED ACROSS 2 SOURCE LINES.  SEE *CLN*
*              PREAMBLE ABOVE.
* 
*           6. STRIP THE BLANKS THAT PRECEDE THE 1ST NON-BLANK CHAR 
*              IN COLS 7-72.
  
          LT     B7,B5,CLN2  IF NUMBER OF COLUMNS .LE. 70 
          SB7    B7-8*CHAR
  
 CLN2     SA1    CARDS
          CALL   CDD         CONVERT BINARY TO DECIMAL DPC
          MX1    1
          SB3    B2-B1
          AX1    B3          (X1) = EXTRACTION MASK FOR CONVERTED DIGITS
          BX6    X1*X4       (X6) = LINE NR, -L- FMT
          LX7    X6,B2       (X7) = LINE NR, -R- FMT
          SA6    LN=NUML
          LX5    CHAR        (X5) = COL 2345678901
          SA7    LN=NUMR
          BX4    -X0*X5      (X4) = CHAR IN COL 1, -R- FMT
  
*         CHECK COL 1.
  
          SX1    X4-1R* 
          SX2    X4-1RC 
          ZR     X1,CLN3     IF COL 1 IS -*-, COMMENT LINE... 
          NZ     X2,CLN4     IF COL 1 IS NOT -*- OR -C-, NOT COMMENT... 
  
*         DISTINGUISH BETWEEN COMMENT AND C$ LINE.
  
          SA1    =6RC$
          LX5    5*CHAR      (X5) = COL 7890123456
          MX2    -6*CHAR
          BX6    -X2*X5      (X6) = COLS 1-6 IN -R- FMT 
          IX3    X6-X1
          SX7    LT.C$
          NZ     X3,CLN3     IF NOT A C$ LINE, COMMENT... 
          SA1    CO.DS
          PL     X1,CLN7     IF C$ PROCESSING NOT DESELECTED
 CLN3     SX7    LT.CMNT
          SA7    LN=TYPE
          EQ     EXIT.       DONE...
  
*         HERE FOR NON-COMMENT, NON-C$ LINE.  NEED TO EXTRACT 
*         LABEL FROM COLS 1-5.
  
 CLN4     SA1    =5R
          LX5    4*CHAR      (X5) = COLS 6789012345 
          MX2    -5*CHAR
          BX6    -X2*X5      (X6) = COLS 1-5 IN -R- FMT 
          IX3    X6-X1
          LX6    10*CHAR-5*CHAR (X6) = COLS 1-5 IN -L- FMT
          ZR     X3,CLN5     IF COLS 1-5 ALL BLANK
          SA6    LN=LABL
  
*         EXTRACT AND CHECK COL 6.
  
 CLN5     LX5    CHAR        (X5) = COL 7890123456
          BX4    -X0*X5      (X4) = CHAR IN COL 6, -R- FMT
          SX7    LT.CONT
          SX2    X4-1R
          NZ     X2,CLN6     IF COL 6 IS NON-BLANK
          SX7    LT.INIT
          NZ     X3,CLN7     IF COLS 1-5 NOT ALL BLANK
          SX7    LT.NULL
          EQ     CLN7 
  
*         HERE IF COL 6 NON-BLANK.
  
 CLN6     SX2    X4-1R0 
          NZ     X2,CLN7     IF COL 6 NOT -0-, LINE IS CONTINUATION...
          SX7    LT.INIT
  
*         HERE TO STRIP PRECEDING BLANKS FROM SOURCE LINE.
* 
*           1. SAVE LINE TYPE IN *LN=TYPE*. 
* 
*           2. SAVE STARTING CHARACTER POSITION FOR ENTOKENABLE 
*              PART OF LINE  (HERE FOR COMPATIBILITY WITH *SEQ*). 
* 
*           3. STRIP PRECEDING BLANKS.
  
 CLN7     SA7    LN=TYPE
          SB4    CP.FLIN
          SB6    4*CHAR 
          SB3    10*CHAR-1*CHAR 
          SX6    A5-B4       (X6) = ORD OF 1ST ENTOKENABLE WORD 
          SX7    B6 
          SA6    LN=FEN      SAVE ORDINAL OF 1ST ENTOKENABLE WORD 
          SA7    LN=FENB     SAVE (B6) = CHAR POS OF 1ST ENTOKENABLE
*                                        CHAR IN 1ST ENTOKENABLE WORD 
          BX1    X1-X1       SET TO *BU/BU NO CHARACTERS* (STRIP BLANKS)
  
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          BX6    X6-X6       CLEAR PACKING REG TO PREVENT (A6) STORE
          SX7    B7 
          SA6    CLNA        PRESTORE (A6)...JUST IN CASE 
          SA7    LN=FENL     SAVE (B7) = NR OF BITS REMAINING 
          RJ     BUB         BURST/BUILD CHARACTERS WITH BLANK SQZ
          LE     B7,B0,CLN18 IF WE STRIPPED EVERYTHING, DONE... 
  
*         HERE WHEN COLS 7-72 ARE NOT ALL BLANK.  NEED TO RETYPE
*         LINE AS *INITIAL* IF LINE TYPE IS *NULL*. 
  
          SA1    LN=TYPE
          SX7    LT.INIT
          SX3    X1-LT.NULL 
          NZ     X3,CLN20    IF LINE NOT INITIALLY TYPED AS NULL
          SA7    A1+
          EQ     CLN20
 CLN      SPACE  4,10 
**        HERE FOR *SEQ* LINE.
* 
*           1. STRIP ANY BLANKS THAT PRECEDE LINE NUMBER. 
* 
*           2. EXTRACT LINE NUMBER AND SAVE IN *LN=NUM*.
* 
*           3. TYPE THE LINE BY CHECKING THE CHARACTER THAT FOLLOWS 
*              THE LINE NUMBER -- 
* 
*              A. + MEANS LINE IS CONTINUATION. 
*              B. BLANK MEANS LINE IS INITIAL (OR NULL).
*              C. C$ MEANS LINE IS C$.
*              D. ANYTHING ELSE MEANS LINE IS COMMENT.
* 
*              NOTE THAT FOR A NULL (ALL BLANK) LINE, THE **ENTIRE**
*              LINE MUST BE SCANNED.  SEE FTN 5 IMS/DECK *LEX* FOR A
*              DESCRIPTION/DEFINITION OF A *SEQ* LINE.
* 
*           4. EXTRACT THE LINE/STMT LABEL IF LINE IS AN INITIAL LINE 
*              OF STMT (ONLY IF ONE IS PRESENT, OF COURSE) AND SAVE IN
*              *LN=LABL*. 
* 
*           5. STRIP THE BLANKS THAT PRECEDE THE 1ST NON-BLANK CHARACTER
*              FOLLOWING THE LINE NUMBER (OR LINE LABEL, IF ONE WAS 
*              PRESENT).
  
 CLN10    SB3    9*CHAR      (B3) = LEFT SHIFT FOR 1ST CHAR *BUB/BUN* 
*                                   WILL BUILD INTO (X6). 
          BX1    X1-X1       SET TO *BU/BU NO CHARACTERS* (STRIP BLANKS)
          MX6    0           CLEAR PACKING REG TO PREVENT (A6) STORE
          SA6    CLNA        PRESTORE (A6)...JUST IN CASE 
          SX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SB6    10*CHAR
          RJ     BUB         BURST/BUILD CHARACTERS WITH BLANK SQZ
          LE     B7,B0,CLN14 IF LINE IS EMPTY 
  
*         CHECK FOR AND EXTRACT LINE NUMBER.
  
          SA1    MX=0..9     (X1) = CHAR SHIFT MASK FOR 0 THRU 9
          SB2    X4+10000B-BICH 
          LX7    X1,B2
          PL     X7,CLN14    IF 1ST CHAR OF LINE NR IS NOT DIGIT
          BX6    X6-X6
          SB5    6           (B5) = MAX NR OF CHARS IN LINE NR
          SA6    CLNA        PRESTORE (A6)
          SB3    10*CHAR-1*CHAR 
          RJ     BUN         BURST/BUILD CHARACTERS WITH NO BLANK SQZ 
          SA6    LN=NUML
          SB4    60-CHAR
          SX7    LT.NULL
          SB5    B4-B3       (B5) = SHIFT COUNT TO RIGHT JUSTIFY (X6) 
          LX6    B5          (X6) = SEQ NR, -R- FMT 
          SA7    LN=TYPE
          SA6    LN=NUMR
          LE     B7,B0,EXIT. IF NOTHING AFTER LINE NR 
  
*         CHECK CHAR THAT TERMINATED LINE NUMBER. 
  
          SX2    X4-1R
          SX3    X4-1R+ 
          ZR     X2,CLN16    IF LINE IS *NULL* SO FAR 
          SX7    LT.CONT
          ZR     X3,CLN15    IF LINE IS *CONTINUATION*
  
*         CHECK FOR C$ LINE.
* 
*           1. IF CHAR THAT FOLLOWED/TERMINATED LINE NR IS NOT -C-, 
*              THEN THIS LINE IS A COMMENT. 
* 
*           2. IF CHAR THAT FOLLOWED/TERMINATED LINE NR IS A -C-, 
*              THEN EXTRACT 3 CHARS AND SEE IF THEY ARE 
*              -C$.- (.=BLANK(55B)).  IF SO, THEN THIS IS A C$ LINE.
*              ELSE, THIS IS A COMMENT LINE.
* 
*         NOTE: SOME WORK MUST BE DONE TO CORRECTLY TYPE A C$ LINE
*         THAT IS NULL (I.E. -C$- IMMEDIATELY FOLLOWED BY EOL MARK) 
*         BECAUSE IN THIS CASE, THE BLANK FOLLOWING THE -C$- IS 
*         IMPLICIT (I.E. IT IS NOT THERE...IT HAS BEEN STRIPPED OFF 
*         BY THE OPERATING SYSTEM). 
  
          SX2    X4-1RC 
          NZ     X2,CLN14    IF COMMENT LINE
          SB5    2           (B5) = NR OF CHARS TO EXTRACT
          MX1    60          SET TO *BU/BU ANY CHARACTERS*
          BX6    X6-X6
          SA6    CLNA        PRESTORE (A6)
          SB3    10*CHAR-1*CHAR 
          RJ     BUN         BURST/BUILD CHARACTERS WITH NO BLANK SQZ 
  
          SA2    =2LC$
          BX7    X6-X2
          NZ     X7,CLN14    IF NOT -C$-, LINE IS COMMENT...
          SX2    X4-1R
          LE     B7,B0,CLN13 IF -C$- IMMEDIATELY FOLLOWED BY EOL MARK 
          NZ     X2,CLN14    IF NOT -C$.- (.=BLANK(55B))
  
*         HERE IF C$ LINE.
  
 CLN13    SA1    CO.DS
          SX7    LT.C$
          PL     X1,CLN16    IF C$ PROCESSING NOT DESELECTED
  
*         HERE IF COMMENT LINE. 
  
 CLN14    SX7    LT.CMNT
          SA7    LN=TYPE
          EQ     EXIT.       DONE...
  
*         HERE IF READY TO TO STRIP PRECEDING BLANKS FROM SOURCE LINE.
* 
*           1. SAVE LINE TYPE IN *LN=TYPE*. 
* 
*           2. SAVE STARTING CHARACTER POSITION FOR ENTOKENABLE PART
*              OF LINE IN *LN=FEN*.  I.E. SAVE THE POSITION OF 2ND CHAR 
*              FOLLOWING THE LINE NUMBER (THE 1ST CHAR FOLLOWING
*              THE LINE NUMBER DETERMINES THE LINE TYPE FOR *SEQ* 
*              LINES).  TO DO THIS, WE MUST FIRST GET THIS CHAR AS
*              WE ARE CURRENTLY POINTING AT THE 1ST CHAR FOLLOWING
*              THE LINE NUMBER.  THEREFORE WE MUST FIRST CALL *BUB* 
*              TO GET ONE CHARACTER.
* 
*           3. STRIP PRECEDING BLANKS.
  
 CLN15    SA1    TF=SQZ 
          NZ     X1,CLN16    IF IN BLANK SQUEEZE MODE 
          SA7    LN=TYPE
          SB4    CP.FLIN
          SX6    A5-B4       ORD OF WORD CONTAINING 1ST CHAR OF SOURCE
          SX7    B6 
          SA6    LN=FEN 
          =A7    A6-LN=FEN+LN=FENB
          SX6    B7 
          =A6    A7-LN=FENB+LN=FENL 
          LX5    -CHAR
          EQ     CLN18
  
 CLN16    SA7    LN=TYPE
          LE     B7,B0,CLN17 IF NOTHING LEFT
          BX6    X6-X6       CLEAR PACKING REG TO PREVENT (A6) STORE
          MX4    -1          SET TO *NO USEABLE CHARACTER IN (X4)*
          SX1    0           SET TO *BU/BU NO CHARACTERS* 
          SB5    B1          (B5) = NR OF CHARS TO BU/BU
          SB3    10*CHAR-1*CHAR 
          RJ     BUN         BURST/BUILD CHARACTERS WITH NO BLANK SQZ 
  
 CLN17    SB4    CP.FLIN
          SX6    A5-B4       ORD OF WORD CONTAINING 1ST CHAR OF SOURCE
          SX7    B6 
          SA6    LN=FEN 
          =A7    A6-LN=FEN+LN=FENB
          SX6    B7 
          =A6    A7-LN=FENB+LN=FENL 
          LE     B7,B0,CLN18 IF NOTHING LEFT
          SB3    10*CHAR-1*CHAR 
          BX6    X6-X6
          RJ     BUB         BURST/BUILD CHARACTERS WITH BLANK SQZ
          LE     B7,B0,CLN18 IF NOTHING LEFT
  
*         HERE IF PRECEDING BLANK STRIP WAS NOT TERMINATED BY EOL.
* 
*           1. IF THIS LINE HAS BEEN TYPED SO FAR AS NULL, THEN NEED
*              TO RETYPE AS INITIAL.
* 
*           2. IF LINE IS INITIAL (I.E. AS TYPED ABOVE), THEN NEED
*              TO CHECK FOR/EXTRACT STMT LABEL. 
  
          SA2    LN=TYPE
          SA1    MX=0..9     (X1) = CHAR SHIFT MASK FOR 0 THRU 9
          SX3    X2-LT.NULL 
          SB2    X4+10000B-BICH 
          NZ     X3,CLN20    IF NOT *NULL SO FAR* LINE
  
          LX6    X1,B2
          SX7    LT.INIT
          SA7    A2 
          PL     X6,CLN20    IF NO STATEMENT LABEL PRESENT
  
*         EXTRACT STATEMENT LABEL.
  
          SB5    5           (B5) = MAX NR OF DIGITS IN STMT LABEL
          BX6    X6-X6
          SA6    CLNA        PRESTORE (A6)
          SB3    10*CHAR-1*CHAR 
          RJ     BUN         BURST/BUILD CHARACTERS WITH NO BLANK SQZ 
          BX1    X6 
          CALL   SFN         SPACE FILL 
          MX1    5*CHAR 
          BX6    X1*X6       ERASE LOWER 5 CHARACTERS 
          SA1    MX=0..9
          SA6    LN=LABL
          EQ     CLN17       NEED TO STRIP PRECEDING BLANKS 
 CLN      SPACE  4,10 
**        HERE FOR FINAL PROCESSING.
* 
*         SAVE CRITICAL *BUB/BUN* SOURCE LINE POINTER REGISTERS 
*         FOR LATER TOKEN GENERATION OF THIS LINE.  THESE REGISTERS 
*         ARE SAVED SO THAT *TOK* CAN KNOW WHERE TO BEGIN AND END 
*         TOKEN GENERATION OF THIS LINE.
* 
*         REGISTERS ARE SAVED IN *TOKCOM*, THE *USER/TOK* COMMUNICATIONS
*         AREA AS FOLLOWS --
* 
*         (TC=SOA) = (A5)-CP.FLIN 
*                  = ORDINAL OF 1ST SOURCE WORD TO ENTOKEN. 
*         (TC=SOL) = (B7) 
*                  = NR OF WORDS TO ENTOKEN (NOT INCLUDING FULL 
*                    ZERO WORD EOL MARK).  NOTE THAT IN NORMAL (NON-SEQ)
*                    MODE, THE MAXIMUM VALUE THAT (B7) CAN HAVE IS
*                    7 (I.E. COLS 1-70).  COLS 71-72 HAVE TO BE SPECIAL 
*                    CASED SO THAT *TOK* WILL NOT AUTOMATICALLY ENTOKEN 
*                    COLS 73-80.
*         (TC=SOB) = (B6) 
*                  = NR OF BITS REMAINING IN (X5).
*         (TC=SOC) = (X4) 
*                  = 1ST CHAR TO ENTOKEN (-R- FMT), ELSE
*                  = .MI. IF NONE (I.E. NEED TO EXTRACT CHAR FROM (X5)
*                    FIRST).
* 
*                    NOTE THAT *CLN18* IS A SPECIAL SPOT FOR HANDLING 
*                    THE *NOW AT EOL* CONDITION.  THIS IS NECESSARY 
*                    BECAUSE WHEN *BUB/BUN* DETECT EOL, IT IS POSSIBLE
*                    THAT (X4) CONTAIN AN ERRONEOUS CHARACTER  (I.E.
*                    (X4) IS **UNDEFINED** AT EOL). 
  
  
 CLN18    SX4    -1          SET TO *NO USEABLE CHARACTER IN (X4)*
  
 CLN20    SB4    CP.FLIN
          SX6    B7 
          SX7    A5-B4
          SA6    TC=SOL 
          SA7    TC=SOA 
          SX6    B6 
          BX7    X4 
          SA6    TC=SOB 
          SA7    TC=SOC 
          BX6    X5 
          SA6    TC=SOX 
          EQ     EXIT.
  
  
 CLNA     BSSZ   2           DUMMY AREA FOR *BUB/BUN* (A6) REFERENCES 
 CST      SPACE  4,10 
**        CST - CLASSIFY STATEMENT. 
* 
* 
*         *CST* IS RESPONSIBLE FOR DETERMINING THE STATEMENT TYPE 
*         (SAVED IN *TB=TYPE*) FOR THE STMT IN *T.TB*.  DETERMINING 
*         THE STMT TYPE FOR A STMT INVOLVES 2 DISTINCTLY DIFFERENT
*         ALGORITHMS -- 
* 
*           1. FOR THE SEMANTICALLY DEFINED STMTS (REPLACEMENT, *DO*, 
*              AND *IF*), STMT TYPING INVOLVES BOTH A POSSIBLE KEYWORD
*              VERIFICATION .AND. THE QUERYING OF A NUMBER OF SPECIAL 
*              *SEMANTIC* FLAGS THAT MIGHT HAVE BEEN SET DURING TOKEN 
*              GENERATION.
* 
*              THESE FLAGS ARE -- 
* 
*                ZLEQUAL = ADDR IN *T.TB* OF THE LAST *O.=* TOKEN 
*                          THAT THE TOKEN GENERATOR ENCOUNTERED 
*                          AT PAREN LEVEL ZERO, ELSE
*                        = .ZR. IF NO ZERO LEVEL EQUAL OCCURRED.
* 
*                ZLCOMMA = ADDR IN *T.TB* OF LAST *O.COMMA* TOKEN 
*                          GENERATED AT PAREN LEVEL ZERO, ELSE
*                        = .ZR. IF NO ZERO LEVEL COMMA OCCURRED.
* 
*                ZLPAREN = ADDR IN *T.TB* OF 1ST ZERO **LEVELING**
*                          *O.RP* TOKEN GENERATED, ELSE 
*                        = .ZR. IF NO ZERO LEVELING PAREN ENCOUNTERED.
* 
*                ZLCOLON = ADDR IN *T.TB* OF 1ST *O.COLON* TOKEN
*                          GENERATED AT PAREN LEVEL 1, ELSE 
*                        = .ZR. IF NO LEVEL 1 COLON ENCOUNTERED.  NOTE
*                          THAT THE NAME OF THIS CELL, *ZLCOLON*, IS
*                          SOMEWHAT OF A MISNOMER: I.E. IT HAS **NOTHING
*                          TO DO WITH PAREN LEVEL 0.  HOWEVER, IT WAS 
*                          FELT THAT THIS CELL WAS SUFFICIENTLY CLOSE 
*                          IN FUNCTION TO THE OTHER *ZL* CELLS TO WARRAN
*                          BEING ASSOCIATED BY NAME.  ERGO, THE MISNOMER
* 
*              FOR EXAMPLE -- 
* 
*                SUBROUTINE THUMB(A,B),RETURNS(C,D) 
*                                    .. 
*                                    ..... ZLCOMMA
*                                    ..... ZLPAREN
* 
*                BIRDY = VULTURE = TURKEY 
*                                .
*                                ......... ZLEQUAL
* 
*                EAT(1:10) = 'GRUNT' // SNARF(1)(6:10)
*                     . 
*                     .................... ZLCOLON
* 
*              FOLLOWING IS A BRIEF DISCUSSION OF THE VARIOUS 
*              SEMANTICALLY DEFINED STMTS IN FTN AND HOW THEY 
*              ARE TYPED/DETECTED, DISCUSSED IN THE ORDER OF THEIR
*              DETECTABILITY -- 
* 
*                A. DO 100 I=1,10 
*                           . . 
*                           . ............ ZLEQUAL
*                           .............. ZLCOMMA
* 
*                   THE 1ST 2 CHARS OF THE 1ST *O.VAR* TOKEN MUST BE
*                   *DO*, AND (ZLEQUAL) MUST PRECEDE (ZLCOMMA). 
* 
*                B. IF (MANAGER.EQ.TURKEY)WORK=WORK-1 
*                                        .    . 
*                                        .    .... ZLEQUAL
*                                        ......... ZLPAREN
* 
*                   THE 1ST *O.VAR* TOKEN MUST CONTAIN *IF*, AND THE
*                   TOKEN IMMEDIATELY FOLLOWING THE ZERO LEVELING 
*                   *O.RP* TOKEN MUST **NOT** BE A SEPARATOR TOKEN
*                   (DEFINED VIA *O.SEP* TOKEN TYPE).  IN ADDITION, 
*                   WE MUST BE CAREFUL ABOUT *IF*S THAT ARE THE OBJECTS 
*                   OF *IF*S, I.E. *IF(...)IF(...)*  (SEE BELOW). 
* 
*                C. TOAD = FROG+1     (REPLACEMENT) 
*                        .
*                        ......................... ZLEQUAL
* 
*                   A REPLACEMENT STMT IS DETECTED WHEN A ZERO
*                   LEVEL EQUAL IS PRESENT.  NOTE THAT SOME 
*                   CARE MUST BE EXERCISED TO DISTINGUISH BETWEEN 
*                   AN ARRAY REPLACEMENT AND AN ASF DEFINITION
*                   (SEE BELOW).
* 
*                D. ASF(I) = I+1      (ASF DEFINITION)
* 
*                   ASF DEFS AND ARRAY REPLACEMENTS ARE DISTINGUISHED 
*                   VIA A SYMBOL TABLE SEARCH ON THE ARRAY/ASF NAME.
*                   IF THE NAME IS DEFINED IN *T.SYM* AS HAVING 
*                   BEEN DIMENSIONED, THEN THIS IS AN ARRAY 
*                   REPLACEMENT STMT.  ELSE, IT IS A STMT FUNCTION
*                   DEFINITION, OR... 
* 
*                E. COW(1:8) = 'STUBBORN'  (CHAR SUBSTRING ASGMNT)
* 
*                   THIS STMT TYPE HAS TO BE SPECIAL-CASED BECAUSE
*                   A CHARACTER SUBSTRING ASSIGNMENT **LOOKS** LIKE 
*                   A STMT FUNCTION DEFINITION.  I.E. *COW* IS **NOT**
*                   DIMENSIONED.  THE GIVEAWAY IS THE COLON.
* 
*                  THEREFORE, A COLON OCCURING AT PAREN LEVEL 1 
*                  **BEFORE** THE 1ST ZERO LEVEL EQUAL INDICATES
*                  THAT THIS IS A CHARACTER SUBSTRING ASSIGNMENT, 
*                  **NOT** A CHARACTER STMT FUNCTION DEFINITION.
* 
*           2. FOR THE FTN KEYWORD STMTS, *CST* CALLS *CAK* (CHECK FOR
*              AND ADJUST KEYWORD) TO SEARCH THE FTN KEYWORD TABLE
*              AT *FW.KEYW* FOR A KEYWORD MATCH.  SEE *CAK* FOR DETAILS.
* 
*         WHEN THE STMT TYPE HAS BEEN DETERMINED, A STMT TYPE 
*         INFORMATION WORD IS TRANSFERED FROM THE KEYWORD TABLE 
*         (OR FROM AN ARTIFICIALLY GENERATED KEYWORD TABLE ENTRY FOR
*         THE SEMANTICALLY DEFINED STMTS) TO THE CONTENTS OF *TB=TYPE*. 
*         IN THIS WAY, ANY INTERESTED PARTY CAN EASILY FIND OUT ANY 
*         STMT TYPE INFORMATION FOR THE STMT AT *T.TB*.  (TB=TYPE) WILL 
*         BE USED BY *FEC* (FRONT END CONTROLLER) IN DETERMINING WHICH
*         STMT PROCESSOR IS TO PROCESS THE STMT AT *T.TB*.
* 
*         ENTRY  (B4) = ADDR OF 1ST KEYWORD TOKEN TO CHECK IN *T.TB*. 
*                (ZLEQUAL), (ZLCOMMA), AND (ZLPAREN) SET UP AS DESCRIBED
*                ABOVE. 
* 
*         EXIT   (TB=TYPE) = STMT TYPE INFORMATION WORD 
*                (TB=1ST)  = ADDR OF 1ST NON-KEYWORD TOKEN IN *T.TB*. 
*                            I.E. ADDR OF 1ST TOKEN THAT A STMT 
*                            PROCESSOR WILL BEGIN PROCESSING AT.
* 
*         USES   ALL BUT (A0) 
* 
*         CALLS  CAK,IFBIT,SSY,TLV,WARN 
  
  
 CST      SUBR   =           ** ENTRY/EXIT ** 
          SA1    TB=CDF 
          NZ     X1,CST7     IF C$ LINE 
  
*         INITIALIZATION. 
  
          SA5    B4          (X5) = TOKEN WE ARE TO TRY AND FIND
*                                   A KEYWORD MATCH FOR 
          BX6    X6-X6
          SA4    ZLEQUAL     (X4) = ADDR IN *T.TB* OF LAST ZERO LVL *=* 
          SA3    ZLCOMMA
          SX2    X5-O.VAR 
          SX7    B4 
          MX1    2*CHAR 
          SA7    TB=1ST 
          SB5    UNTYP. 
          NZ     X2,CST8     IF NOT A *VAR* TOKEN, STMT IS BAD (UNTYPED)
  
*         CHECK FOR *DO* STATEMENT. 
  
          BX6    X1*X5       (X6) = 1ST 2 CHARS IN *VAR* TOKEN, -L- FMT 
          IX7    X3-X4       (X7) = (ZLCOMMA) - (ZLEQUAL) 
          LX6    2*CHAR 
          SX2    X6-2RDO
          NZ     X2,CST2     IF 1ST 2 CHARS NOT *DO*
          ZR     X4,CST7     IF NO ZERO LEVEL *=* IN THIS STMT
          MI     X7,CST5     IF ZERO LEVEL *,* NOT AFTER ZERO LVL *=* 
          SB5    DO.
          EQ     CST8 
  
*         CHECK FOR *IF* STATEMENT. 
  
 CST2     SX2    X6-2RIF
          NZ     X2,CST5     IF 1ST 2 CHARS NOT *IF*
          MX1    -5*CHAR
          NO
          LX1    8*CHAR-5*CHAR
          BX2    -X1*X5 
          NZ     X2,CST5     IF MORE THAN JUST *IF* 
  
*         HERE IF KEYWORD IS *IF*.
* 
*         CHECK FOR --
* 
*                IF(...)XXX 
* 
*         WHERE *XXX* IS -
* 
*           A. *EOS* TOKEN. 
*           B. *VAR* TOKEN. 
*           C. *CONS* TOKEN.
*           D. *HOLL* TOKEN.
  
          SA3    ZLPAREN     (X3) = ADDR OF 1ST ZERO LEVELING PAREN,
*                                   ELSE .ZR. IF NONE (SEE PREAMBLE)
          SA2    B4+B1       (X2) = TOKEN THAT FOLLOWS *IF* 
          SB2    X3 
          SX7    X2-O.( 
          SX1    B2-B4
          NZ     X7,CST5     IF NOT *IF(* 
          ZR     X3,CST5     IF NO ZERO LEVELING PAREN, NOT *IF* STMT 
          PL     X1,CST3     IF *IF(* IS BEFORE 1ST ZERO LEVELING PAREN 
  
*         HERE IF WE MUST BE TYPING AN *IF(* THAT IS THE OBJECT 
*         OF AN *IF*.  I.E. *IF(...)IF(*.  IF THIS STMT CONTAINS
*         A ZERO LEVEL *=*, THEN *=* MUST BELONG TO OBJECT OF 
*         *IF* AND OBJECT OF *IF* MUST BE REPLACEMENT STMT. 
* 
*         E.G. -- 
*                DIMENSION IF(10) 
*                IF(...) IF(10)=0 
  
          NZ     X4,CST5     IF ZERO LEVEL *=* PRESENT
          EQ     CST4        STMT IS *IF*...
  
*         CHECK 1ST TOKEN AFTER ZERO LEVELING RIGHT PAREN.
  
 CST3     SA2    X3+1        (X2) = TOKEN THAT FOLLOWS ZERO LVLING PAREN
          SX7    X2-O.SEP 
          PL     X7,CST5     IF TOKEN IS NOT POSSIBLE IN *IF* STMT
  
 CST4     SB5    IF.
          EQ     CST8 
  
*         CHECK FOR REPLACEMENT STATEMENT.
  
 CST5     ZR     X4,CST7     IF NO ZERO LEVEL *=*, NOT REPLACEMENT... 
          SA1    B4+1        (X1) = TOKEN FOLLOWING *VAR* TOKEN 
          SB5    REP. 
          SX6    X1-O.VAR 
          NZ     X6,CST6     IF NOT A LONG NAME (NR CHARS .LE. 7) 
          CALL   TLV         TRUNCATE LONG VARIABLE NAME
          SX6    B4 
          SA6    TB=1ST 
  
*         DISTINGUISH BETWEEN --
* 
*           1. SIMPLE REPLACEMENT.
*              E.G.  DOG = CAT
* 
*           2. ARRAY REPLACEMENT. 
*              E.G.  DIMENSION DOG(10)
*                    DOG(10) = CAT
* 
*           3. ASF DEFINITION.
*              E.G.  DOG(10) = CAT
* 
*           4. CHARACTER SUBTRING ASSIGNMENT. 
*              E.G.  CHAR(1:5) = 'HORNS'
  
          SA1    B4+B1
  
 CST6     SB5    REP. 
          SA3    STAGE
          SX6    FEC=EXU
          IX6    X3-X6
          ZR     X6,CST8     IF IN EXECUTABLES
          MX2    WA.SYML
          SX3    X1-O.( 
          BX6    X2*X5       (X6) = 1ST 7 CHARS OF *VAR* TOKEN, -L- FMT 
          NZ     X3,CST8     IF *VAR* NOT FOLLOWED BY *(*, NOT ARRAY/ASF
          HX1    TB.COL 
          MI     X1,CST8     IF ( CONTAINS COLON, IS REPL.
          CALL   SSY         SCAN SYMBOL TABLE
          SB5    REP. 
          SBIT   X2,WB.ARYP 
          MI     X2,CST8     IF AN ARRAY, MUST BE REP.
          SB5    STF. 
          EQ     CST8 
  
*         HERE TO SCAN FTN KEYWORD TABLE. 
  
 CST7     SA1    TB=CDF      C$ FLAG
          SA2    X1+FW.KEYS 
          SA3    X1+L.KEYS
          SB6    X2 
          SB7    X3 
          RJ     CAK         CHECK AND ADJUST KEYWORD 
          SB5    UNTYP. 
          ZR     B7,CST8     IF NO FIND IN FTN KEYWORD TABLE
          PL     B7,CST10    IF KEYWORD SPELLED OK
  
*         HERE TO LOAD UP A SPECIAL *KEYW* ENTRY, I.E. ONE THAT IS
*         NOT IN THE FTN KEYWORD TABLE. 
  
 CST8     SA5    B5+
          NO
          BX6    X5 
  
*         FINAL PROCESSING. 
* 
*           1. SAVE STATEMENT TYPE *KEYW* ENTRY IN (TB=TYPE). 
* 
*           2. SET (TB=1ST) = ADDR OF 1ST NON-KEYWORD TOKEN.
  
 CST10    SX7    B4+
          SA6    TB=TYPE
          SA7    TB=1ST 
          EQ     EXIT.
 PLR      SPACE  4,40 
**        PLR - PROCESS LISTING REQUEST.
* 
* 
*         *PLR* IS CONCERNED WITH MAKING SOME VERY IMPORTANT DECISIONS
*         ABOUT WHAT TO DO ABOUT THE SOURCE LINE AT *CP.FLIN/CP.CARD* 
*         ET SEQ.  AS *PLR*S NAME IMPLIES, THIS USUALLY HAS SOMETHING TO
*         DO WITH LISTING...BUT NOT ALWAYS. 
* 
*         *PLR* IS PRIMARILY CONCERNED, NOT WITH LISTING, BUT WITH
*         FREEING UP *CP.CARD* ET SEQ FOR A NEW SOURCE LINE THE NEXT
*         TIME WE READ VIA *RNC* (READ NEXT CARD).  *PLR* USUALLY 
*         ENDS UP MOVING THE SOURCE LINE AT *CP.FLIN/CP.CARD* TO
*         *T.STMT* (STMT/DEFERRED LIST BUFFER)...BUT NOT ALWAYS.
* 
*         THIS COMMENTARY IS REALLY MORE AT A WARNING THAN INFORMATIVE. 
*         LISTING/LINE LOGIC CAN BE VERY PATHOLOGICAL WITHOUT EVEN
*         TRYING.  I MADE AN ATTEMPT TO DEAL WITH THIS IN THE *LEX* 
*         IMS.  THAT'S WHERE TO GO... 
* 
* 
*         ENTRY  A VARIETY OF CELLS/FLAGS, SOME GLOBAL, SOME LOCAL. 
*                FOLLOWING IS A BRIEF LIST.  SEE APPROPRIATE CELL 
*                DEFINITION FOR MORE INFORMATION. 
* 
*                GLOBAL --
* 
*                *CP.FLIN/CP.CARD* IS THE INPUT LINE IMAGE AREA.
* 
*                (L.CARD)  = NR OF WORDS IN *CP.FLIN/CP.CARD*.
* 
*                (CO.SEQ)  = .NZ. IF IN *SEQ* MODE, ELSE .ZR. 
* 
*                (WO.LOS)  = WORKING SOURCE LISTING FLAG. 
*                          = .NZ. IF LISTING SELECTED, ELSE .ZR.
* 
*                (CARDS)   = NR OF CARDS/LINES READ, I.E. SOURCE LINE 
*                            NR IN BINARY.
* 
*                LOCAL -- 
* 
*                (LN=XXX) ARE A GROUP OF CELLS THAT CONTAIN INFORMATION 
*                         ABOUT THE CURRENT SOURCE LINE AT *CP.CARD*. 
* 
*                (SB=XXX) ARE A GROUP OF CELLS THAT CONTAIN INFORMATION 
*                         ABOUT *T.STMT* (STMT/DEFERRED LIST BUFFER). 
* 
*         EXIT   *T.STMT* SET UP, IF APPROPRIATE. 
*                LINE LISTED, IF APPROPRIATE. 
* 
*         USES   ALL
* 
*         CALLS  ALLOC,LDB,LSL,MOVE,ZTB 
  
  
 PLR      SUBR               ** ENTRY/EXIT ** 
  
*         SET UP LINE NUMBER FOR LISTING PURPOSES IN NON-SEQ MODE --
* 
*           IF IN LIST MODE (L.NE.0 .AND. C/-LIST,ALL ACTIVE) AND --
* 
*             1. IF THIS LINE NR IS A MULTIPLE OF 5, OR 
*             2. IF THIS LINE IS A C/-LIST LINE, OR 
*             3. IF (CO.SNAP) .NZ. IN *TEST* MODE.
* 
*           IF IN DEFERRED LIST MODE (L=0 .OR. C/-LIST,NONE ACTIVE) AND 
* 
*             1. IF THIS IS INITIAL LINE OF STATEMENT, OR 
*             2. IF NOT INITIAL LINE OF STMT .AND. LINE NR IS MULTIPLE
*                OF 5.
* 
*         NOTE: ALL THIS HOO DAH DAH IS SKIPPED FOR NOW... WE ARE 
*         TRYING TO DECIDE WHETHER WE LIKE A SOURCE LISTING THAT
*         UNCONDITIONALLY HAS A COMPILER-GENERATED LINE NUMBER ON 
*         EACH SOURCE LINE (NON-SEQ ONLY).
  
          SA1    CO.SEQ 
          SA2    =10H 
          NO
          BX6    X2 
          NZ     X1,PLR40    IF *SEQ* MODE INPUT
  
 .LINR    SKIP
 .T       IFEQ   TEST,ON
          SA1    CO.SNAP
          NZ     X1,PLR30    IF ANY SNAP IS ON, FORCE OUT LINE NR 
 .T       ENDIF 
  
          SA1    SLIST
          SA2    WO.LOS      (X2) = WORKING SOURCE LIST FLAG
          SA3    LN=TYPE
          BX1    X1*X2       (X1) = .NZ. IF LISTING THIS LINE, ELSE .ZR.
          SX7    X3-LT.INIT 
          NZ     X1,PLR20    IF LISTING THIS LINE 
          ZR     X7,PLR30    IF INITIAL LINE OF STMT .AND. NOT LISTING
  
 PLR20    BSS    0
          SA1    CARDS       (X1) = LINE NR (IN BINARY) 
          SX2    146315B     (X2) = MAGIC NR FOR SENSING MULTIPLES OF 5 
          SX3    5
          IX7    X1*X2
          AX7    18 
          IX2    X7*X3
          IX3    X1-X2
          NZ     X3,PLR40    IF LINE NR IS NOT MULTIPLE OF 5
 .LINR    ENDIF 
  
 PLR30    SA1    LN=NUMR     (X1) = LINE NR, IN -R- FORMAT
          CALL   ZTB         CONVERT ZEROES TO BLANKS 
  
 PLR40    SA1    STAGE       CHECK IF LINE COMPILED 
          LX6    CHAR 
          SX2    FEC=BY      BYPASS FLAG
          IX1    X1-X2
          NZ     X1,PLR41    IF COMPILED
          SX2    2R-- 
          LX2    42 
          MX0    12 
          EQ     PLR43       GO STORE 
  
 PLR41    SA1    IFLEVEL     GET CURRENT IF LEVEL 
          ZR     X1,PLR44    IF ZERO
          SX2    X1-100D
          PL     X2,PLR42    IF GREATER THAN 99 
          BX5    X6 
          RJ     CDD         CONVERT LEVEL
          MX0    12 
          LX6    42 
          LX0    -6 
          BX6    X0*X6       MASK TWO DIGITS
          BX5    -X0*X5 
          BX6    X5+X6       MERGE IF LEVEL AND LINE NR 
          EQ     PLR44
  
 PLR42    SX2    3R99+       INDICATE IF LEVEL > 99 
          LX2    36 
          MX0    18 
  
 PLR43    LX0    -6 
          BX2    X0*X2
          BX6    -X0*X6 
          BX6    X2+X6       MERGE 99+ AND LINE NR
  
 PLR44    SA6    CP.FLIN
  
*         DECIDE WHETHER TO MOVE LINE AT *CP.FLIN/CP.CARD* TO *T.STMT*. 
* 
*         LINE IS MOVED TO *T.STMT* ACCORDING TO THE FOLLOWING
*         RULES --
* 
*           1. IF NOT IN *HEADER DELAY* MODE (*LEXFLG/LF.HDR* OFF,
*              I.E. THE MOST FREQUENT CASE), ALL NON-COMMENT LINES
*              ARE MOVED TO *T.STMT*. 
* 
*           2. IF IN *HEADER DELAY* MODE, AN ATTEMPT IS MADE TO SAVE
*              ALL LINES IN *T.STMT*.  AS FAR AS *PLR* IS CONCERNED,
*              THIS EFFORT IS THWARTED ONLY WHEN THE NR OF LINES
*              IN *T.STMT* EXCEEDS *MAX.LINC*.
* 
*              SEE *LEXFLG/LF.HDR* FOR MORE INFORMATION.
  
          SA1    LEXFLG 
          SA2    LN=TYPE
          SA3    SB=LINC     (X3) = NR OF LINES IN *T.STMT* 
          LX1    59-LF.HDRP 
          SX6    X2-LT.CMNT 
          SX7    X2-LT.NULL 
          MI     X1,PLR60    IF IN *HEADER DELAY* MODE
          ZR     X6,PLR70    IF LINE IS COMMENT 
          ZR     X7,PLR70    IF LINE IS BLANK/NULL/COMMENT
  
*         HERE TO MOVE LINE AT *CP.FLIN* ET SEQ TO *T.STMT*.
* 
*           1. ALLOCATE ENOUGH SPACE IN *T.STMT* FOR SAVED LINE.
*              THE NR OF WORDS TO ALLOCATE IS DETERMINED BY TAKING
*              THE SUM OF THE FOLLOWING --
* 
*             A. THE CONTENTS OF *L.CARD*, WHICH CONTAINS THE NR
*                OF WORDS IN THIS SOURCE LINE, AS DETERMINED BY *RNC* 
*                (READ NEXT CARD).
* 
*             B. + CP.CARD-CP.FLIN, WHICH REFLECTS THE PRINT LINE 
*                IMAGE AREA USED FOR SPACING AND THE COMPILER-GENERATED 
*                LINE NR. 
* 
*             C. + 1, FOR THE *LINE INFORMATION* HEADER WORD THAT 
*                EVERY LINE IN *T.STMT* IS PREFIXED WITH. 
* 
*           2. SET UP THE *LINE INFORMATION* HEADER WORD TO CONTAIN --
* 
*             A. THE NR OF WORDS IN THIS *T.STMT* LINE ENTRY. 
* 
*             B. THE *LINE TYPE*, (LN=TYPE), OF THIS LINE.
* 
*             C. THE POSITION OF THE 1ST ENTOKENABLE CHARACTER ON 
*                THIS LINE, (LN=FEN), (LN=FENB), (LN=FENL). 
* 
*           3. MOVE THE LINE AT *CP.FLIN* ET SEQ TO *T.STMT*. 
  
 PLR60    SA1    L.CARD      (X1) = NR OF WORDS IN SOURCE LINE
          SB2    CP.FLIN     (B2) = FWA OF LISTABLE SOURCE LINE AREA
          SB3    CP.CARD     (B3) = FWA OF SCANNABLE SOURCE LINE
          SB4    B3-B2
          SB5    B4+X1       (B5) = NR OF WORDS IN LISTABLE SOURCE LINE 
*                                   AREA (INCLUDES FULL WORD EOL MARK)
          SB6    B5+B1       (B6) = NR OF WORDS TO ALLOCATE 
          ALLOC  T.STMT,B6
          SA3    LN=TYPE
          SX6    B6 
          SB4    B7-B6
          LX6    SB.LENP-0
          SX7    B4 
          LX3    SB.LNTP-0
          BX6    X6+X3       MERGE *LNT*
          IX7    X7-X1       (X7) = ORD OF *LINE INFO* HEADER WORD
          SA1    LN=FEN      (X1) = ORD, RELATIVE TO *CP.FLIN*, OF WORD 
*                                   CONTAINING 1ST ENTOKENABLE CHAR 
          SA2    LN=FENB     (X2) = BIT POSITION OF 1ST ENTOKENABLE CHAR
          SA3    LN=FENL     (X3) = NR OF BITS, RELATIVE TO *FEN/FENB*, 
*                                   IN THIS SOURCE LINE 
          IX4    X7+X1
          LX2    SB.FENBP-0 
          SX4    X4+B1       (X4) = ORD, RELATIVE TO *T.STMT*, OF FEN 
          BX6    X6+X2       MERGE *FENB* 
          LX3    SB.FENLP-0 
          BX6    X6+X3       MERGE *FENL* 
          LX4    SB.FENP-0
          BX6    X6+X4       MERGE *FEN*
          SA7    SB=LORD
          SA6    B4 
  
*         MOVE THE LINE AT *CP.FLIN* ET SEQ TO *T.STMT*.
  
          SX1    B5          (X1) = COUNT 
          SX2    CP.FLIN     (X2) = FROM
          SX3    B4+B1       (X3) = TO
          MOVE   X1,X2,X3 
  
          SA1    SB=LINC
          SX6    X1+B1
          SA6    A1 
  
*         LIST SOURCE LINE AT *CP.FLIN* ET SEQ -- 
* 
*           1. IF NOT IN *HEADER DELAY* MODE, .AND. 
* 
*           2. IF IN *LIST* MODE (L.NE.0, SL.NE.0, C$-LIST,ALL ACTIVE). 
* 
*         ALSO NEED TO SET *SB.LOUTP* BIT IN *LINE INFORMATION* 
*         HEADER WORD FOR LINE TO LIST. 
  
 PLR70    SA1    WO.LOS 
          SA3    LEXFLG 
          SA4    LN=TYPE
          LX3    59-LF.HDRP 
          ZR     X1,EXIT.    IF NOT LISTING THIS SOURCE LINE
          MI     X3,EXIT.    IF IN *HEADER DELAY* MODE, DONT LIST NOW...
          SX6    X4-LT.CMNT 
          ZR     X6,PLR80    IF COMMENT LINE, IT CANT BE IN T.STMT ...
  
          SA1    T.STMT 
          SA2    SB=LORD
          IX6    X1+X2       (X6) = ADDR OF *LINE INFO* WORD FOR LINE 
          MX7    1
          SA3    X6          (X3) = *LINE INFO* WORD
          LX7    SB.LOUTP-59
          BX6    X3+X7       SET TO *LINE HAS BEEN LISTED*
          SA6    A3 
  
 PLR80    SX1    CP.FLIN
          SA2    L.CARD 
          =X4    X2+2-1      LENGTH INC. LINE# AND BLANK LESS EOL 
          RJ     LSL         LIST SOURCE LINE 
          EQ     EXIT.
 RNC      SPACE  4,8
**        RNC - READ NEXT CARD. 
* 
* 
*         READS A SINGLE SOURCE LINE FROM THE INPUT BUFFER *F.IN* 
*         TO THE SOURCE LINE IMAGE AREA *CP.CARD*.  ALSO GUARANTEES 
*         THAT, ON EXIT, THE EOL MARK IS ON A WORD BOUNDARY BY
*         APPROPRIATELY BLANK FILLING THE LAST WORD OF THE LINE IMAGE 
*         AND STORING A FULL ZERO WORD EOL MARK AFTER IT. 
* 
*         ENTRY  (B1)     =  1
*                CIO ONLY - INITIAL *READ* ISSUED 
*                RM  ONLY - FILE TABLES INITIALIZED 
*                (LEXMODE)=  LEXICAL SCANNER MODE FLAG WHICH INDICATES
*                            TO *RNC* WHETHER OR NOT HE IS TO ACTUALLY
*                            PERFORM A *READC*.  SEE *LEXMODE* FOR
*                            DETAILS. 
*                (CP.IFMT)=  +0 IF NORMAL UNCOMPRESSED INPUT
*                         =   1 IF MODIFY COMPRESSED INPUT (UNSUPPORTED)
*                         =   2 IF UPDATE COMPRESSED INPUT (UNSUPPORTED)
* 
*         EXIT   (B1)     =  1
*                (CP.IFMT) = 1S59 IF EOR/EOF/EOI ENCOUNTERED, ELSE
*                              AS ON ENTRY. 
*                (CP.CARD) = .ZR. IF EOR/EOF/EOI ENCOUNTERED, ELSE 1ST
*                              WORD OF SOURCE LINE IMAGE
*                (L.CARD) =  NR OF WORDS IN SOURCE LINE IMAGE 
*                              I.E. INCLUDES FULL ZERO WORD EOL MARK
* 
*         USES   ALL BUT A0,X0,A5,X5  (INCLUDES ALL CALLS)
* 
*         CALLS  FETCH,READC,SFN
  
  
 RNC      SUBR   =           ** ENTRY/EXIT ** 
          SA1    CARDS
          SA2    CP.IFMT
          SA3    LEXMODE
          SX6    X1+B1
          SA6    A1          UPDATE LINE COUNT
          NZ     X2,*+4S15   IF COMPRESSED INPUT (UPDATE OR MODIFY) 
          SX7    X3-LM.1ST
          NZ     X7,RNC4     IF NOT 1ST LINE IN PGM UNIT
  
*         ZERO OUT UNUSED BITS IN LAST WORD OF CARD IMAGE.
  
 #RM      IFNE   CP#RM,0
          SA2    F.IN        (X2) = ADDRESS OF INPUT FILE FIT 
          FETCH  X2,RL,X1    RETURNS RECORD LENGTH (CHARS.) IN X1 
          IX2    X1+X1
          SX3    X1+9 
          SX1    52429       (2**19)/10 + 1 
          IX3    X3*X1
          AX3    19          RECORD LENGTH (WORDS) IN X3
          LX1    X2,B1
          SB6    X3 
          IX2    X2+X1       RECORD LENGTH (BITS) 
          BX4    X3 
          LX3    6
          SA1    CP.CARD-1+B6  LAST WORD OF LINE
          LX4    2
          IX3    X3-X4       LINE LENGTH (BITS) 
          MX4    1
          IX3    X3-X2       UNUSED BIT COUNT 
          SB2    X3-59
          AX4    -B2
          BX6    X4*X1       DISCARD UNUSED BITS
          AX4    6
          SA6    A1 
          NZ     X4,RNC2     IF TERMINATOR AT LEAST 12 BITS LONG
          MX7    0
          SA7    A6+B1       TERMINATE LINE WITH 60 ZERO BITS 
  
 RNC2     BSS    0
 #RM      ENDIF 
  
          SA3    CP.CARD
          MX0    -2*CHAR
  
 RNC3     BX4    -X0*X3 
          SA3    A3+B1
          NZ     X4,RNC3     IF NOT END OF IMAGE
  
          SB6    A3          (B6) = LWA+1 OF SOURCE LINE
          BX1    X1-X1       SET TO *NO EOR/EOF/EOI ENCOUNTERED*
          EQ     RNC5 
  
 RNC4     READC  F.IN,CP.CARD,16
  
*         CHECK FOR AND PROCESS EOR/EOF/EOI.
  
 RNC5     SB4    CP.CARD
          ZR     X1,RNC6     IF NO EOR/EOF/EOI ENCOUNTERED
          MX6    1
          SB7    B0 
          SA6    CP.IFMT     SET TO *EOR/EOF/EOI ENCOUNTERED* 
          EQ     RNC11
  
*         CHECK FOR FULL WORD AND 11 CHARACTER EOL MARK.
  
 RNC6     SA1    B6-1        (A1,X1) = A+C OF LAST WORD OF LINE IMAGE 
          NZ     X1,RNC7     IF NOT A FULL WORD EOL MARK
          SA1    A1-1 
          SB6    B6-1 
          MX2    -CHAR
          BX3    -X2*X1 
          NZ     X3,RNC8     IF NOT 11 CHAR EOL MARK
  
*         SPACE/BLANK FILL LAST WORD OF LINE IMAGE. 
  
 RNC7     CALL   SFN         SPACE FILL NAME
          SA6    A1+
  
*         CHECK FOR, AND TRUNCATE, LONG LINE. 
  
 RNC8     SB7    B6-B4       (B7) = NR OF USEABLE WORDS IN SOURCE LINE
          SB5    MAX.CDL-1
          LE     B7,B5,RNC9  IF LINE LEN OK 
          SB7    B5+
  
*         PAD OUT LINE WITH BLANKS TO COLUMN 90.
  
 RNC9     SA1    =10H 
          BX6    X1 
  
 RNC10    GE     B7,B5,RNC11 IF DONE
          SA6    B4+B7
          SB7    B7+B1
          EQ     RNC10
  
*         FINAL PROCESSING AND EXIT.
  
 RNC11    BX6    X6-X6
          SX7    B7+1        (X7) = NR OF WORDS IN LINE (W/ EOL)
          SA6    B4+B7       MARK EOL 
          SA7    L.CARD 
          EQ     EXIT.
*CALL     COMCTOK            TOKEN GENERATOR. 
 TOK      SPACE  4,10 
 TOK=EOL  =      /COMCTOK/TOK=EOL 
  
  
          ENTRY  TOK=CAL,TOK=COF
          ENTRY  TOK=GN,TOK=GO,TOK=GS 
          ENTRY  TOK=IFT
          ENTRY  TOK=ON 
          ENTRY  TOK=XEQ
  
          IFEQ   TEST,ON,2
          ENTRY  TOK=ELS,TOK=ENT
          ENTRY  TF=IDP 
 TOGEL    TITLE  THE *TOGEL* PROGRAMS.
***       THE *TOGEL* PROGRAMS. 
* 
* 
*         THIS SECTION CONTAINS THE *TOGEL* PROGRAMS THAT 
*         DRIVE/DESCRIBE THE GENERATION OF FTN TOKENS.
* 
*         STRICTLY SPEAKING, THIS SECTION IS A DATA STRUCTURE, NOT
*         A PIECE OF CODE.  HOWEVER, BECAUSE THE RELATIONSHIP BETWEEN 
*         *COMCTOK* AND ITS DRIVING *TOGEL* PROGRAM IS SO SYMBIOTIC,
*         IT WAS FELT THAT TOKEN GENERATION MIGHT BE MORE EASILY
*         UNDERSTOOD/MANHANDLED IF THE *TOGEL* PROGRAM WAS IN THE 
*         VICINITY OF *COMCTOK* IN THIS LISTING.
* 
************************************************************************
  
  
  
*         PRECEDE START OF *TOGEL* PROGRAM WITH DUMMY INSTRUCTION.
*         THIS IS TO SUPPLY RESTART ADDRESS IN CASE INITIAL LINE HAD
*         PERFORMED NO PROCESSING, LEAVING THE PSEUDO P-COUNTER (A0)
*         AT TOM=BOS.  SINCE RESTART LOOKS AT A0-1 WE WOULD BE IN 
*         TROUBLE.  POSSIBLE STUATION:  
*    1
*     2STOP 
  
 TOM=DUM  BSS    0
          GOTO   TOM=DUM
  
 NORMAL   TOGEL 
 TOM=BOS  BSS    0           ** BEGINNING OF STMT **
          ON EOL,0
          ON RESTART,0
  
  
 TOM=NXT  BSS    0           ** MAIN LOOP NODE ** 
 CONS     IFT (0..9)
            GROUP (0..9),CONS,SQZ 
 HLR        IFT (H) 
              CALT TOK=NOH   IF 'CHARACTER *', NO *HLR*...
              XEQ HLR          PROCESS *HLR* STRING 
 HLR        ENDT
 CONS     ENDT
  
 TOM=VAR  BSS    0
 VAR      IFT (A..Z)
            GROUP (A..Z0..9),VAR,SQZ
 VAR      ENDT
  
 .IP      IFEQ   IP.CSET,IP.C63 
          CASEOF (+..;) 
 .IP      ELSE
          CASEOF (+..:) 
 .IP      ENDIF 
            TOKEN PL                                        + 
            TOKEN MIN                                       - 
            TOKEN STAR                                      * 
              TOKEN EXP,(STAR,STAR)                           **
              TOKEN ILL,(BOS,VAR'CHARACT',VAR'ER',STAR),TOK=CHR 
            TOKEN SLASH                                     / 
              TOKEN CAT,(SLASH,SLASH)                         //
            TOKEN LP,,TOK=LP                                ( 
            TOKEN RP,,TOK=RP                                ) 
            TOKEN ILL                                       $ 
            TOKEN =,,TOK=EQL                                = 
            TOKEN ILL                                       BLANK 
            TOKEN COMMA,,TOK=CMA                            , 
            TOKEN PERIOD                                    . 
              TOKEN EQ,(PERIOD,VAR'EQ',PERIOD)                .EQ.
              TOKEN NE,(PERIOD,VAR'NE',PERIOD)                .NE.
              TOKEN GE,(PERIOD,VAR'GE',PERIOD)                .GE.
              TOKEN LT,(PERIOD,VAR'LT',PERIOD)                .LT.
              TOKEN GT,(PERIOD,VAR'GT',PERIOD)                .GT.
              TOKEN LE,(PERIOD,VAR'LE',PERIOD)                .LE.
              TOKEN OR,(PERIOD,VAR'OR',PERIOD)                .OR.
              TOKEN AND,(PERIOD,VAR'AND',PERIOD)              .AND. 
              TOKEN XOR,(PERIOD,VAR'XOR',PERIOD)              .XOR. 
              TOKEN NOT,(PERIOD,VAR'NOT',PERIOD)              .NOT. 
              TOKEN TRUE,(PERIOD,VAR'TRUE',PERIOD)            .TRUE.
              TOKEN FALSE,(PERIOD,VAR'FALSE',PERIOD)          .FALSE. 
              TOKEN EQV,(PERIOD,VAR'EQV',PERIOD)              .EQV. 
              TOKEN NEQV,(PERIOD,VAR'NEQV',PERIOD)            .NEQV.
            TOKEN   ILL,,TOK=ILL                            # 
            TOKEN   ILL,,TOK=ILL                            [ 
            TOKEN   ILL,,TOK=ILL                            ] 
 .IP      IFEQ   IP.CSET,IP.C63 
            TOKEN   COLON,,TOK=COL                          : 
 .IP      ELSE
            TOKEN   ILL,,TOK=ILL                            % 
 .IP      ENDIF 
            TOKEN   DQOT,,TOK=DQT                           " 
              TOKEN ILL,(VAR'L',DQOT),TOK=BOL               L"
              TOKEN OCT,(VAR'O',DQOT),TOK=BOO               O"
              TOKEN ILL,(VAR'R',DQOT),TOK=BOR               R"
              TOKEN HEX,(VAR'Z',DQOT),TOK=BOX               Z"
          TOKEN  ILL,(VAR'BACKSPA',VAR'CEL',DQOT),TOK=BBL  BACKSPACE L" 
          TOKEN  ILL,(VAR'REWINDL',DQOT),TOK=BRL           REWIND L"
          TOKEN  ILL,(VAR'BACKSPA',VAR'CER',DQOT),TOK=BBR  BACKSPACE R" 
          TOKEN  ILL,(VAR'REWINDR',DQOT),TOK=BRR           REWIND R"
          TOKEN  OCT,(VAR'BACKSPA',VAR'CEO',DQOT),TOK=BBO  BACKSPACE O" 
          TOKEN  OCT,(VAR'REWINDO',DQOT),TOK=BRO           REWIND O"
          TOKEN  HEX,(VAR'BACKSPA',VAR'CEZ',DQOT),TOK=BBZ  BACKSPACE Z" 
          TOKEN  HEX,(VAR'REWINDZ',DQOT),TOK=BRZ           REWIND Z"
            TOKEN   ILL,,TOK=ILL                            _ 
            TOKEN   ILL,,TOK=ILL                            ! 
            TOKEN   ILL,,TOK=ILL                            & 
            TOKEN   SQOT,,TOK=SQT                           ' 
            TOKEN   ILL,,TOK=ILL                            ? 
            TOKEN   ILL,,TOK=ILL                            < 
            TOKEN   ILL,,TOK=ILL                            > 
            TOKEN   ILL,,TOK=ILL                            @ 
            TOKEN   ILL,,TOK=ILL                            \ 
            TOKEN   ILL,,TOK=ILL                            ^ 
            TOKEN   ILL,,TOK=ILL
          IFNE   IP.CSET,IP.C63,1 
            TOKEN   COLON,,TOK=COL                          : 
          ELSC
            TOKEN   ILL,,TOK=ILL
          ENDC
  
          GOTO TOM=NXT
 TOM=DQT  SPACE  4,10 
**        TOM=DQT - HERE IF " STRING ENCOUNTERED. 
  
  
 TOM=DQT  BSS    0           ** ENTRY **
          XEQ    DQT         PROCESS DOUBLE QUOTE STRING
          GOTO TOM=NXT
 TOM=HEX  SPACE  4,10 
**        TOM=HEX - HERE IF X" ENCOUNTERED. 
  
  
 TOM=HEX  BSS    0           ** ENTRY **
          GROUP (-"),HEX,SQZ
          CALT TOK=EOO       PROCESS END OF OCTAL/HEX CONSTANT
          GOTO TOM=NXT       CONTINUE...
 TOM=OCT  SPACE  4,10 
**        TOM=OCT - HERE IF O" ENCOUNTERED. 
  
  
 TOM=OCT  BSS    0           ** ENTRY **
          GROUP (-"),OCT,SQZ
          CALT TOK=EOO       PROCESS END OF OCTAL/HEX CONSTANT
          GOTO TOM=NXT       CONTINUE...
 TOM=SQT  SPACE  4,10 
**        TOM=SQT - HERE IF ' STRING ENCOUNTERED. 
  
  
 TOM=SQT  BSS    0           ** ENTRY **
          XEQ    SQT         PROCESS SINGLE QUOTE STRING
          GOTO   TOM=NXT
  
 NORMAL   TOGEL 
 PROCS    SPACE  4,10 
 PROCS    TOGEL 
 DQT      SPACE  4,10 
**        DQT - PROCESS QUOTE DELIMITED STRING. 
* 
* 
*         *DQT* PROCESSES A QUOTE DELIMITED STRING OF THE FORM -- 
* 
*                "SSSS"  OR  "SSS""SSS" 
* 
*         WHERE  SSSS = THE CHARACTER STRING. 
*                "    = THE STRING DELIMITER. 
*                ""   = IS THE SPECIAL *EMBEDDED "* SYNTAX, 
*                       (I.E. WHERE 2 QUOTES ARE TREATED AS 1). 
* 
*         ENTRY  (X4) = THE LEADING DELIMITING ". 
*                ENTOKENING REGISTERS INTACT. 
* 
*         EXIT   (X4) = 1ST NON-BLANK (55B) CHARACTER FOLLOWING 
*                       THE TERMINATING ".
* 
*         CALTS  TOK=BOQ,TOK=EOQ,TOK=ITQ,TOK=QOQ
* 
*         XEQS   NONE 
  
  
 DQT      PROC               ** ENTRY/EXIT ** 
          ON EOL,TOK=QOL
          ON RESTART,TOK=REQ
          CALT TOK=BOQ      PROCESS BEGINNING OF QUOTE STRING 
 TOM=QOQ  GROUP (-"),BOS,NSQZ 
          CALT TOK=ITQ      IGNORE TERMINATING QUOTE
          IFT (") 
            CALT TOK=QOQ    PROCESS 2 QUOTES AS 1 QUOTE 
*           ** RETURNS TO TOM=QOQ **
          ENDT
          CALT TOK=EOQ      PROCESS END OF QUOTE STRING 
          ON EOL,0          RESTORE NORMAL EOL STATUS 
          ON RESTART,0      RESTORE NORMAL RESTART STATUS 
          IFT (/55) 
            GROUP (),BOS,SQZ
          ENDT
          GOTO EXIT.
 HLR      SPACE  4,10 
**        HLR - PROCESS *HLR* STRING. 
* 
* 
*         *HLR* PROCESS AN *HLR* CHARACTER STRING OF THE FORM --
* 
*                NN H SSSS
* 
*         WHERE  NN   = PROGRAMMER SPECIFIED COUNT WHICH DETERMINES 
*                       THE NR OF CHARACTERS IN THIS STRING.
*                SSSS = THE CHARACTER STRING OF LENGTH *NN*.
*                H    = STRING TYPE HOLLERITH (I.E. LEFT-JUSTIFIED, 
*                       SPACE-FILLED) 
* 
*         ENTRY  (X4) = *H* STRING TYPE CHARACTER 
*                ENTOKENING REGISTERS INTACT. 
* 
*         EXIT   (X4) = 1ST NON-BLANK (55B) CHARACTER FOLLOWING 
*                       THE -HLR- STRING. 
*                ENTOKENING REGISTERS INTACT. 
* 
*         CALTS  TOK=BOH,TOK=EOH
* 
*         XEQS   NONE 
  
  
 HLR      PROC               ** ENTRY/EXIT ** 
          ON EOL,TOK=HOL
          ON RESTART,TOK=REH
          CALT TOK=BOH       PROCESS BEGINNING OF *HLR* STRING
          GROUP (..),BOS,NSQZ 
          CALT TOK=EOH       PROCESS END OF *HLR* STRING
          ON EOL,0           RESTORE NORMAL EOL STATUS
          ON RESTART,0       RESTORE NORMAL RESTART STATUS
          IFT (/55) 
            GROUP (),BOS,SQZ
          ENDT
          GOTO EXIT.
 SQT      SPACE  4,10 
**        SQT - PROCESS QUOTE DELIMITED STRING. 
* 
* 
*         *SQT* PROCESSES A QUOTE DELIMITED STRING OF THE FORM -- 
* 
*                'SSSS'  OR  'SSS''SSS' 
* 
*         WHERE  SSSS = THE CHARACTER STRING. 
*                '    = THE STRING DELIMITER. 
*                ''   = IS THE SPECIAL *EMBEDDED '* SYNTAX, 
*                       (I.E. WHERE 2 QUOTES ARE TREATED AS 1). 
* 
*         ENTRY  (X4) = THE LEADING DELIMITING '. 
*                ENTOKENING REGISTERS INTACT. 
* 
*         EXIT   (X4) = 1ST NON-BLANK (55B) CHARACTER FOLLOWING 
*                       THE TERMINATING '.
* 
*         CALTS  TOK=BOC,TOK=EOC,TOK=ITQ,TOK=QOC
* 
*         XEQS   NONE 
  
  
 SQT      PROC               ** ENTRY/EXIT ** 
          ON EOL,TOK=QOL
          ON RESTART,TOK=REQ
          CALT TOK=BOC      PROCESS BEGINNING OF QUOTE STRING 
 TOM=QOC  GROUP (-'),BOS,NSQZ 
          CALT TOK=ITQ      IGNORE TERMINATING QUOTE
          IFT (') 
            CALT TOK=QOC    PROCESS 2 QUOTES AS 1 QUOTE 
*           ** RETURNS TO TOM=QOC **
          ENDT
          CALT TOK=EOC      PROCESS END OF QUOTE STRING 
          ON EOL,0          RESTORE NORMAL EOL STATUS 
          ON RESTART,0      RESTORE NORMAL RESTART STATUS 
          IFT (/55) 
            GROUP (),BOS,SQZ
          ENDT
          GOTO EXIT.
 PROCS    SPACE  4,10 
 PROCS    TOGEL 
 TOK=     TITLE  TOK= - FTN USER OWNCODE SUPPORT FOR *COMCTOK*. 
***       TOK= - FTN USER OWNCODE SUPPORT FOR *COMCTOK*.
* 
* 
*         THE FOLLOWING SECTION CONTAINS THE FTN USER OWNCODE PROCESSORS
*         FOR *COMCTOK*.  THESE OWNCODES/PROCESSORS ARE INVOKED AT
*         VARIOUS TIMES DURING TOKEN GENERATION WHEN SOMETHING SPECIAL
*         OR UNUSUAL (SOMETIMES I THINK EVERYTHING IN SCANNERS IS 
*         SPECIAL OR UNUSUAL) THAT *COMCTOK* CANNOT HANDLE ITSELF.
* 
*         THEREFORE, THE ONLY WAY TO GET AN OVERVIEW OF THESE OWNCODES
*         IS TO LOOK AT THE *TOGEL* PROGRAM THAT IS INVOKING THEM.
* 
*         *COMCTOK* SHOULD BE THE **ONLY** ONE WHO INVOKES THESE
*         PROCESSORS.  ANY OTHER EXECUTIVES ARE **UNAUTHORIZED** AND
*         **ILLEGAL**.  THIS IS TO KEEP THIS PROCESSING AS CLEAR AND
*         STRUCTURED AS POSSIBLE.  YOU CAN HELP.
* 
************************************************************************
 TOK=BOC  SPACE  4,10 
**        TOK=BOC - BEGINNING OF ' (TYPE *CHARACTER*) STRING. 
* 
*         HERE IF A ' IS ENCOUNTERED DURING TOKEN GENERATION.  THIS 
*         MARKS THE BEGINNING OF A ' DELIMITED *CHARACTER* STRING.
*         NEED TO PREPARE FOR GENERATION OF *O.CHAR* TOKEN -- 
* 
*           1. GENERATE A PREMATURE, INCOMPLETE *O.CHAR* TOKEN TO 
*              *T.TB*, AND SAVE ITS ADDRESS IN (CH=TAD).  WHEN *TOK*
*              FINISHES *GROUP*ING THIS '' STRING, *TOK=EOC* (END 
*              OF CHARACTER STRING) WILL GO BACK AND FILL IN THE
*              MISSING INFORMATION (E.G. STRING LEN) INTO THE INCOMPLETE
*              *O.CHAR* TOKEN AT (CH=TAD).
* 
*           2. SAVE THE CHARACTER STRING TYPE (I.E. '') IN (CH=TYPE). 
* 
*           3. SET *LEXFLG/QAC* TO INDICATE THAT A QUOTE STRING IS
*              ACTIVE.  SEE *LEXFLG/QAC* FOR MORE INFORMATION.
* 
*           4. RETURN TO *TOK=MN* (TOKEN GENERATOR MAIN LOOP NODE)
*              TO GROUP THIS '' STRING.  NOTE THAT THE REMAINDER OF 
*              *T.TB* IMMEDIATELY FOLLOWING THE INCOMPLETE/PREMATURE
*              *O.CHAR* TOKEN IS USED AS A SCRATCH AREA FOR GROUPING/ 
*              ASSEMBLING THIS CHARACTER STRING.
  
  
 TOK=BOC  BSS    0           ** ENTRY **
          SX6    O.CHAR 
          SX7    A6+B1       (X7) = ADDR IN *T.TB* OF *O.CHAR* TOKEN
          SA6    A6+B1       MARK *O.CHAR* TOKEN
          SA7    CH=TAD 
          SX7    CT.SQT 
          SA7    CH=TYPE     SET TO *'' STRING* 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SB5    -B1         (B5) = -(CHAR COUNT+1) 
          SX7    0
          SA7    TF=SQZ      SET TO *NO BLANK SQZ*
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          SA7    A1 
          EQ     TOK=MN 
 TOK=BOH  SPACE  4,10 
**        TOK=BOH - BEGINNING OF HOLLERITH STRING.
* 
*         HERE WHEN *O.CONS* TOKEN IS FOLLOWED BY -H- 
*         NEED TO PREPARE FOR GENERATION OF *O.HOLL* TOKEN -- 
* 
*           1. SAVE HOLLERITH STRING TYPE (-H-) IN (CH=TYPE). 
* 
*           2. CONVERT PRECEDING *O.CONS* TOKEN WHICH SPECIFIES 
*              THE CHARACTER COUNT TO BINARY SO THAT *TOK* CAN KNOW 
*              HOW MANY CHARACTERS ARE IN THIS STRING.
* 
*           3. GENERATE A PREMATURE, INCOMPLETE *O.HOLL* TOKEN TO 
*              *T.TB*, AND SAVE ITS ADDRESS IN (CH=TAD).  WHEN *TOK*
*              FINISHES *GROUP*ING THIS HOLLERITH STRING, *TOK=EOH* 
*              (END OF HOLLERITH) WILL GO BACK AND FILL IN THE
*              MISSING INFO INTO THE INCOMPLETE *O.HOLL* TOKEN
*              AT (CH=TAD). 
* 
*           4. RETURN TO *TOK=MN* TO GROUP THIS HOLLERITH STRING. 
*              NOTE THAT REMAINDER OF TOKEN BUFFER FOLLOWING INCOMPLETE 
*              *O.HOLL* TOKEN IS USED AS A SCRATCH AREA FOR ASSEMBLING/ 
*              GROUPING THIS HOLLERITH STRING.
  
  
 TOK=BOH  BSS    0           ** ENTRY **
          RJ     SER         SAVE ENTOKENING REGISTERS
          SX7    CT.H 
          SA7    CH=TYPE
          MX1    TB.TOCL
          SA5    A6          (X5) = PRECEDING *O.CONS* TOKEN
          SB7    B1          SET TO *DECIMAL CONVERSION*
          BX5    X1*X5       (X5) = NR TO CONVERT, -L- FMT
          CALL   DXB         CONVERT DECIMAL DPC TO BINARY
          IFEQ   TEST,ON,1
          NZ     X4,"BLOWUP" IF ERROR DURING CONVERSION 
          SB5    X6          (B5) = CHARACTER COUNT 
          =X2    O.HOLL 
          LX6    TB.CLCNP-0 
          BX6    X6+X2       MERGE *CLCN* AND *TOT* 
          SX7    A6 
          SA6    A6          OVERWRITE *O.CONS* TOKEN 
          SA7    CH=TAD      SAVE ADDR OF *O.HOLL* TOKEN
          RJ     RER         RESTORE ENTOKENING REGISTERS 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          BX7    X7-X7
          SA7    TF=SQZ      INDICATE *NO BLANK SQUEEZE*
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          EQ     TOK=MN 
 TOK=BOL  SPACE  4,8
**        TOK=BBL - BACKSPACE FOLLOWED BY L"STRING" 
          SPACE  2
 TOK=BBL  BSS    0            ** ENTRY ** 
          RJ     SER          SAVE ENTOKENING REGISTERS 
          SA4    BBLA         GET REPLACEMENT TOKEN 
  
 BBL1     BX6    X4 
          SA6    A6           OVERWRITE VAR TOKEN 
          =A6    A6+1         BUMP TOKEN POINTER
          RJ     RER          RESTORE ENTOKENING REGISTERS
          EQ     TOK=BOL
  
 BBLA     VFD    54/2LCE,6/O.VAR
          SPACE  4
**        TOK=BRL - REWIND FOLLOWED BY L"STRING"
          SPACE  2
 TOK=BRL  BSS    0            ** ENTRY ** 
          RJ     SER          SAVE ENTOKENING REGISTERS 
          SA4    BRLA         GET REPLACEMENT TOKEN 
          EQ     BBL1 
  
 BRLA     VFD    54/6LREWIND,6/O.VAR
          SPACE  4
**        TOK=BBR - BACKSPACE FOLLOWED BY R"STRING" 
          SPACE  2
 TOK=BBR  BSS    0            ** ENTRY ** 
          RJ     SER          SAVE REGISTERS
          SA4    BBLA         GET REPLACEMENT TOKEN 
  
 BBR1     BX6    X4 
          SA6    A6           OVERWRITE ILL TOKEN 
          =A6    A6+1         BUMP TOKEN POINTER
          RJ     RER          RESTORE REGISTERS 
          EQ     TOK=BOR
          SPACE  4
**        TOK=BRR - REWIND FOLLOWED BY R"STRING"
          SPACE  2
 TOK=BRR  BSS    0            ** ENTRY ** 
          RJ     SER          SAVE REGISTERS
          SA4    BRLA         GET REPLACEMENT TOKEN 
          EQ     BBR1 
          SPACE  4
**        TOK=BBO - BACKSPACE FOLLOWED BY O"STRING" 
          SPACE  2
 TOK=BBO  BSS    0            ** ENTRY ** 
          RJ     SER          SAVE REGISTERS
          SA4    BBLA         GET REPLACEMENT TOKEN 
  
 BBO1     BX6    X4 
          SA6    A6           STORE REPLACEMENT TOKEN 
          SA6    A6+B1        ADVANCE TOKEN PTR 
          RJ     RER          RESTORE REGISTERS 
  
          SA0    TOM=OCT      RESET PSEUDO P-REGISTER 
          SX7    CT.OCT 
          SA7    CH=TYPE
  
 BBO2     SA1    A6-1 
          EQ     BOO3         SKIP CHECK FOR VARIABLE TOKEN 
  
          SPACE  4
*         TOK=BRO - REWIND FOLLOWED BY O"STRING"
          SPACE  2
 TOK=BRO  BSS    0            ** ENTRY ** 
          RJ     SER
          SA4    BRLA         GET REPLACEMENT TOKEN 
          EQ     BBO1 
          SPACE  4
*         TOK=BBZ - BACKSPACE FOLLOWED BY Z"STRING" 
          SPACE  2
 TOK=BBZ  BSS    0            ** ENTRY ** 
          RJ     SER
          SA4    BBLA         GET REPLACEMENT TOKEN 
  
 BBZ1     BX6    X4 
          SA6    A6           STORE REPLACEMENT TOKEN 
          SA6    A6+B1        ADVANCE TOKEN PTR 
          RJ     RER
  
          SA0    TOM=HEX      RESET PSEUDO P-REGISTER 
          SX7    CT.HEX 
          SA7    CH=TYPE
          EQ     BBO2 
  
          SPACE  3
*         TOK=BRZ - REWIND FOLLOWED BY Z"STRING"
          SPACE  2
 TOK=BRZ  BSS    0            ** ENTRY ** 
          RJ     SER
          SA4    BRLA         GET REPLACEMENT TOKEN 
          EQ     BBZ1 
**        TOK=BOL - BEGINNING OF L"STRING"
  
  
 TOK=BOL  BSS    0           ** ENTRY **
          SA0    TOM=DQT
          SX7    CT.L 
          SA7    CH=TYPE
          =A1    A6-1 
          BX6    X1 
          SA6    A1 
          EQ     TOK=MN 
 TOK=BOR  SPACE  4,8
**        TOK=BOR - BEGINNING OF R"STRING"
  
  
 TOK=BOR  BSS    0           ** ENTRY **
          SA0    TOM=DQT
          SX7    CT.R 
          SA7    CH=TYPE
          =A1    A6-1 
          BX6    X1 
          SA6    A1 
          EQ     TOK=MN 
 TOK=BOO  SPACE  4,10 
**        TOK=BOO - BEGINNING OF OCTAL (O"") OR HEX (X"") CONSTANT. 
* 
* 
*         HERE AT THE BEGINNING OF AN OCTAL (O"") OR HEX (X"") CONSTANT.
*         NEED TO --
* 
*           1. RESET (A0), THE *COMCTOK* PSEUDO P REGISTER, TO *TOM=OCT*
*              SO THAT THIS OCTAL CONSTANT CAN BE PROPERLY ENTOKENED. 
* 
*              NOTE THAT IF THIS IS A HEX CONSTANT, THAT *TOK=BOX*
*              (BEGINNING OF HEX CONSTANT) HAS ALREADY SET (A0) TO
*              *TOM=HEX*, AND THAT ENTRY IS TO *BOO2* BELOW.
* 
*           2. CHECK TO MAKE SURE THAT THE TOKEN PRECEDING THIS O"" 
*              OR X"" IS **NOT** A *VAR* TOKEN.  THIS IS NECESSARY
*              BECAUSE *CASEOF* KEYS OFF OF THE TOKEN SEQUENCE -- 
* 
*                  VAR'O'  DQOT    OR    VAR'X'  DQOT 
* 
*              IT CAN BE SEEN THAT THE ABOVE SAYS **NOTHING** ABOUT 
*              THE TOKEN THAT **PRECEDES** THESE SEQUENCES, AND THAT
*              THIS CAN GET US INTO TROUBLE...
* 
*              CONSIDER THE FOLLOWING --
* 
*                  VAR'CARAMEL'  VAR'O'  DQOT 
* 
*              WHICH ERRONEOUSLY LOOKS LIKE THE BEGINNING OF AN OCTAL 
*              CONSTANT.  THIS PROBLEM OCCURS BECAUSE THERE IS NO 
*              WAY VIA THE *TOGEL* LANGUAGE TO SPECIFY *ALL TOKENS
*              BUT THIS TOKEN*.  I.E. WE WOULD LIKE TO WRITE -- 
* 
*                  CASEOF 
*                     . 
*                    TOKEN OCT,(.NOT.VAR,VAR'O',DQOT) 
* 
*              BUT BECAUSE WE CANT, WE HAVE TO CHECK FOR THE *.NOT.VAR* 
*              CASE WITH HARD-CODE. 
* 
*              NOTE THAT IF WE DECIDE THAT THIS IS **NOT** AN *OCT/HEX* 
*              THAT WE THEN TRANSFER CONTROL TO *TOK=DQT* (DOUBLE QUOTE)
*              PROCESSING SO THAT THIS " GETS TREATED AS THE BEGINNING
*              OF A "" (HOLL) STRING.  CLEVER IF I DO SAY SO MYSELF...
* 
*           3. BACK UP (A6), THE TOKEN BUFFER POINTER, SO THAT THE
*              *OCT* OR *HEX* TOKEN(S) TO BE GENERATED WILL OVERWRITE 
*              THE *VAR'O'* OR *VAR'X'* TOKEN.
* 
*           4. SAVE THE FWA OF THIS *OCT/HEX* CONSTANT IN (CH=TAD) SO 
*              THAT *LEX*S MAIN LOOP CAN DETERMINE WHETHER OR NOT TO
*              ISSUE AN ERROR MSG IF THE TERMINATING " IS MISSING.
*              SEE *DATA STRUCTURES/CH=TAD* FOR MORE INFORMATION. 
  
  
 TOK=BOO  BSS    0           ** ENTRY **
          SA0    TOM=OCT     RESET PSEUDO P REGISTER
          SX7    CT.OCT 
          SA7    CH=TYPE
 BOO2     SA1    A6-1 
          SX7    X1-O.VAR 
          NZ     X7,BOO3     IF NOT PRECEDED BY VAR TOKEN 
          BX6    X1          SAVE X1
          SA1    BOOA        GET VAR'ENDFILE' TOKEN 
          BX7    X6-X1       COMPARE TOKENS 
          SA1    A6-1        RESTORE X1 
          NZ     X7,TOK=DQT  IF NOT *OCT/HEX* TOKEN, MUST BE STRING...
  
 BOO3     BX6    X1 
          SX7    A6+B1       (X7) = FWA OF TO-BE-GENERATED *OCT/HEX*
          SA6    A1+
          SA7    CH=TAD 
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          EQ     TOK=CON     RETURN W/ NO STORE...
  
 BOOA     VFD    54/7LENDFILE,6/O.VAR 
 TOK=BOQ  SPACE  4,10 
**        TOK=BOQ - HERE TO PROCESS BEGINNING OF " DELIMITED STRING.
* 
*           1. GENERATE A PREMATURE, INCOMPLETE *O.HOLL* TOKEN TO 
*              FINISHES *GROUP*ING THIS '' STRING, *TOK=EOC* (END 
*              OF CHARACTER STRING) WILL GO BACK AND FILL IN THE
*              MISSING INFORMATION (E.G. STRING LEN) INTO THE INCOMPLETE
*              *O.HOLL* TOKEN AT (CH=TAD).
* 
*           2. SAVE THE CHARACTER STRING TYPE (I.E. "") IN (CH=TYPE). 
* 
*           3. SET *LEXFLG/QAC* TO INDICATE THAT A QUOTE STRING IS
*              ACTIVE.  SEE *LEXFLG/QAC* FOR MORE INFORMATION.
* 
*           4. RETURN TO *TOK=MN* (TOKEN GENERATOR MAIN LOOP NODE)
*              TO GROUP THIS "" STRING.  NOTE THAT THE REMAINDER OF 
*              *T.TB* IMMEDIATELY FOLLOWING THE INCOMPLETE/PREMATURE
*              *O.HOLL* TOKEN IS USED AS A SCRATCH AREA FOR GROUPING/ 
*              ASSEMBLING THIS CHARACTER STRING.
  
  
 TOK=BOQ  BSS    0           ** ENTRY **
          SX6    O.QHOLL
          SX7    A6+B1       (X7) = ADDR IN *T.TB* OF *O.HOLL* TOKEN
          SA6    A6+B1       MARK *O.HOLL* TOKEN
          SA7    CH=TAD 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SB5    -B1         (B5) = -(CHAR COUNT+1) 
          SX7    0
          SA7    TF=SQZ      SET TO *NO BLANK SQZ*
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          SA7    A1 
          EQ     TOK=MN 
 TOK=BOX  SPACE  4,10 
**        TOK=BOX - BEGINNING OF HEX CONSTANT.
* 
* 
*         SEE *TOK=BOO* (BEGINNING OF OCTAL CONSTANT) FOR DETAILS.
  
  
 TOK=BOX  BSS    0           ** ENTRY **
          SA0    TOM=HEX     RESET PSEUDO P REGISTER
          SX7    CT.HEX 
          SA7    CH=TYPE
          EQ     BOO2        CONTINUE WITH HEX/OCTAL CONSTANT...
 TOK=CHR  SPACE  4,10 
**        TOK=CHR - HERE IF 'CHARACTER *' ENCOUNTERED.
* 
* 
*         THE 'CHARACTER *' STATEMENT HAS TO BE SPECIAL-CASED 
*         BECAUSE OF AN AMBIGUITY IN THE FTN LANGUAGE SPECIFICATION.
*         THEREFORE, WE SET A FLAG *LEXFLG/CHR* TO INDICATE THAT
*         WE ARE IN A 'CHARACTER *' STATEMENT.
* 
*         SEE DATA STRUCTURES/LEXFLG/CHR AND *TOK=NOH* FOR
*         DETAILS.
  
  
 TOK=CHR  BSS    0           ** ENTRY **
          SA1    LEXFLG 
          CLAS=  X2,LF,(CHR)
          BX7    X1+X2       SET TO *WE ARE IN 'CHARACTER' STMT*
          SA7    A1 
          SX6    O.STAR 
          SA6    A6+1 
          EQ     TOK=CON     CONTINUE W/ NO STORE...
 TOK=CMA  SPACE  4,10 
**        TOK=CMA - HERE IF *,* ENCOUNTERED DURING TOKEN GENERATION.
* 
*         IF THIS *,* IS AT PAREN LEVEL ZERO, THEN SET UP *ZLCOMMA*.
  
  
 TOK=CMA  BSS    0           ** ENTRY **
          SA1    TB=PLVL
          SX7    A6+1        (X7) = ADDR OF ZERO LEVEL COMMA
          NZ     X1,TOK=COS  IF NOT AT PAREN LEVEL ZERO 
          SA7    ZLCOMMA
          EQ     TOK=COS     CONTINUE...
 TOK=COL  SPACE  4,10 
**        TOK=COL - HERE IF *:* ENCOUNTERED.
* 
*           1. IF THIS COLON IS NOT AT PAREN LEVEL 0, THEN SET
*              *TB.COL* BIT IN APPROPRIATE *O.LP* TOKEN TO INDICATE 
*              THAT THIS PAREN LEVEL CONTAINS AN *O.COLON* TOKEN. 
* 
*              E.G., CONSIDER --
* 
*                STIFF = SLEAZY(I)(3:10)
*                                 . . 
*                                 . ....... WE ARE HERE 
*                                 . 
*                                 ......... SET *TB.COL* IN THIS
*                                           *O.LP* TOKEN
* 
*              THIS INFORMATION WILL BE USED AS AN AID TO THE PARSER
*              IN MAKING THE DISTINCTION BETWEEN *SLEAZY* BEING 
*              A FUNCTION OR SUBSTRING REFERENCE. 
* 
*           2. SET UP (ZLCOLON).  SEE *CST* (CLASSIFY STMT) FOR DETAILS.
  
  
 TOK=COL  BSS    0           ** ENTRY **
          SA1    TB=LLP      (X1) = ADDR OF LAST (MOST RECENT) LP TOKEN 
  
 COL2     ZR     X1,COL3     IF END OF *LLP* CHAIN ENCOUNTERED
          SA2    X1          (A2,X2) = A+C OF LINKED LEFT PAREN 
          BX7    X2          SAVE (X2)
          LX2    0-TB.LLPP
          ERRNZ  18-TB.LLPL 
          SX1    X2          (X1) = ADDR OF PRIOR LINKED LEFT PAREN 
          LX2    0-TB.IOCPP+TB.LLPP-0 
          ERRNZ  18-TB.IOCPL
          SX3    X2          (X3) = ADDR OF MATCHING RIGHT PAREN, 
*                                   ELSE .ZR. IF NONE 
          NZ     X3,COL2     IF THIS LEFT PAREN HAS A MATCHING RT PAREN 
          MX1    1
          LX1    TB.COLP-59 
          BX7    X7+X1       SET TO *COLON AT THIS PAREN LEVEL* 
          SA7    A2 
  
*         SET UP (ZLCOLON), IF APPROPRIATE. 
  
 COL3     SA1    ZLCOLON
          SA2    TB=PLVL
          NZ     X1,TOK=COS  IF HAVE ALREADY SET *ZLCOLON*
          SX3    X2-1 
          NZ     X3,TOK=COS  IF NOT AT PAREN LEVEL 1
          SX7    A6+B1       (X7) = ADDR OF 1ST LEVEL 1 COLON 
          SA7    A1 
          EQ     TOK=COS     CONTINUE...
 TOK=DQT  SPACE  4,10 
**        TOK=DQT - HERE IF " ENCOUNTERED VIA *CASEOF*. 
* 
*         THIS OWNCODE EXISTS SOLEY BECAUSE OF AN UGLY/PROBLEM THAT 
*         ARISES IN USING *TOGEL* AS A HIGHER LEVEL LANGUAGE.  I THINK
*         THIS MIGHT BEST BE UNDERSTOOD VIA ILLUSTRATION... 
* 
*         *TOK=DQT* WAS INVOKED VIA THE *TOGEL* --
* 
*                CASEOF (+..:)
*                    .
*                  TOKEN DQOT,,TOK=DQT
*                    .
*                ENDC 
* 
*         WHAT WE WOULD **LIKE** TO HAVE WRITTEN IS --
* 
*                CASEOF (+..:)
*                    .
*                  TOKEN DQOT,,*TOM=DQT 
*                    .
*                ENDC 
* 
*         THAT IS, WE WOULD LIKE TO HAVE MERELY TRANSFERRED CONTROL 
*         OF *COMCTOK* TO THE SECTION OF THE *TOGEL* OBJECT MODULE (TOM)
*         THAT IS CONCERNED WITH PROCESSING THE "" DELIMITED STRING.
* 
*         WE **CANNOT** HOWEVER DO THIS BECAUSE *COMCTOK* IS AT THE 
*         CURRENT TIME (I.E. AT THE TIME OF THE *CASEOF*) IN *BLANK 
*         SQUEEZE* MODE; AND THIS IMPLIES THAT **BEFORE** THE FIRST 
*         *TOGEL* INSTRUCTION AT *TOM=DQT* IS EXECUTED/INTERPRETED, 
*         THAT BLANKS WILL BE SQUEEZED/STRIPPED.  THIS IS NO GOOD FOR 
*         CHARACTER STRINGS.
* 
*         THEREFORE, WE USE *TOK=DQT* TO CIRCUMVENT SOME NASTY AND
*         UNWANTED *COMCTOK* PROCESSING; AND TO GET US STARTED BACK 
*         IN THE *TOGEL* OBJECT MODULE AT *TOM=DQT*.
  
  
 TOK=DQT  BSS    0           ** ENTRY **
          SX7    CT.DQT 
          SA7    CH=TYPE
          SA0    TOM=DQT     RESET PSEUDO -P- REGISTER
          EQ     TOK=MN 
 TOK=EOC  SPACE  4,10 
**        TOK=EOC - END OF ' QUOTE (TYPE *CHARACTER*) STRING. 
* 
*         HERE WHEN THE TERMINATING QUOTE OF A ' QUOTE DELIMITED
*         STRING HAS BEEN FOUND/SENSED.  CALL *EOC* (END OF CHARACTER 
*         STRING PROCESSING) TO --
* 
*           1. SPACE-FILL THE FINAL/LAST WORD OF THE QUOTE STRING 
*              BECAUSE QUOTE STRINGS ARE -H- FORMAT.
* 
*           2. UPDATE THE INCOMPLETE *O.CHAR* TOKEN BY STORING THE
*              NR OF CHARACTERS IN THE STRING INTO IT.
* 
*           3. ENTER THE STRING THAT WAS TEMPORARILY STORED INTO *T.TB* 
*              IMMEDIATELY FOLLOWING THE *O.CHAR* TOKEN INTO *T.CHAR* 
*              VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         NOTE THAT UPON ENTRY TO *TOK=EOC* THAT (X4) IS POINTING TO THE
*         1ST CHARACTER IMMEDIATELY FOLLOWING THE ' MARK.  IF YOU ARE 
*         WONDERING WHY IT IS NOT POINTING TO THE ' MARK ITSELF, IT IS
*         BECAUSE THE *TOK=ITQ* (IGNORE TERMINATING QUOTE) PROCESSING 
*         ALREADY ADVANCED THE CHARACTER POINTER.  SEE PROC *SQT*.
* 
*         NOTE THAT WE HAVE TO CONVERT (TC=SOA)/SAVED (A5) FROM 
*         AN ADDR TO AN ORDINAL, AND THEN BACK TO AN ADDR ACROSS
*         THE *NCM* (ENTER CM) CALL.  THIS IS BECAUSE *NCM* CALLS 
*         THE TABLE MANAGER...AND THIS MEANS THAT (A5), WHICH 
*         POINTS INTO *T.STMT*, MAY NOT BE CORRECT IF THE TABLE 
*         MANAGER MOVES *T.STMT* (DUMB, UGLY BUG).
* 
*                ** WARNING **
* 
*         THIS CODE WILL **NOT** WORK IF ADDING STRING TO *T.CON* EVER
*         CAUSES TABLE MANAGER TO MOVE *T.TB*.
  
  
 TOK=EOC  BSS    0           ** ENTRY **
          RJ     SER         SAVE ENTOKENING REGISTERS
          SA1    T.STMT 
          SA2    TC=SOA      (X2) = SAVED (A5)
          IX7    X2-X1       (X7) = CURRENT *T.STMT* ORD
          SA7    A2 
          SX7    B5 
          SB3    A6+B1       (B3) = LWA+1 OF '' STRING
          SA7    CH=CNT      SAVE (B5) = -(CHAR COUNT+1)
          RJ     EOC         END OF CHARACTER STRING PROCESSING 
          SA1    T.STMT 
          SA2    TC=SOA      (X2) = SAVED *T.STMT* ORD
          IX7    X1+X2       (X7) = CURRENT *T.STMT* ADDR 
          SA7    A2 
          RJ     RER         RESTORE ENTOKENING REGISTERS 
          SX7    1
          SA7    TF=SQZ      SET TO *BLANK SQUEEZE, PLEASE* 
          EQ     TOK=MN 
 TOK=EOH  SPACE  4,10 
**        TOK=EOH - END OF *HLR* STRING.
* 
*         HERE WHEN END OF *HLR* STRING DETECTED.  CALL *EOH* (END
*         OF HOLLERITH STRING PROCESSING) TO -- 
* 
*           1. UPDATE INCOMPLETE *O.HOLL* TOKEN TO REFLECT WORD LEN 
*              AND *T.CONS* ORDINAL.
* 
*           2. FORMAT FINAL/LAST WORD OF STRING.
* 
*             A. IF -H- TYPE STRING, SPACE-FILL LAST WORD.
*             B. IF -R- TYPE STRING, RIGHT-JUSTIFY LAST WORD. 
*             C. IF -L- TYPE STRING, DONT NEED TO DO ANYTHING.
* 
*           3. ENTER THE STRING WHICH WAS TEMPORARILY STORED INTO *T.TB*
*              IMMEDIATELY FOLLOWING THE INCOMPLETE *O.HOLL* TOKEN INTO 
*              *T.CON* VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         NOTE THAT WE HAVE TO CONVERT (TC=SOA)/SAVED (A5) FROM 
*         AN ADDR TO AN ORDINAL, AND THEN BACK TO AN ADDR ACROSS
*         THE *NCM* (ENTER CM) CALL.  THIS IS BECAUSE *NCM* CALLS 
*         THE TABLE MANAGER...AND THIS MEANS THAT (A5), WHICH 
*         POINTS INTO *T.STMT*, MAY NOT BE CORRECT IF THE TABLE 
*         MANAGER MOVES *T.STMT* (DUMB, UGLY BUG).
* 
*                ** WARNING **
* 
*         THIS CODE WILL **NOT** WORK IF ADDING STRING TO *T.CON* EVER
*         CAUSES TABLE MANAGER TO MOVE *T.TB*.
  
  
 TOK=EOH  BSS    0           ** ENTRY **
          RJ     SER         SAVE ENTOKENING REGISTERS
          SA1    T.STMT 
          SA2    TC=SOA      (X2) = SAVED (A5)
          IX7    X2-X1       (X7) = CURRENT *T.STMT* ORD
          SA7    A2 
          SX7    B5 
          SB3    A6+B1       (B3) = LWA+1 OF *HLR* STRING 
          SA7    CH=CNT      SAVE (B5) = -(CHAR COUNT+1)
          RJ     EOH         END OF HOLLERITH STRING PROCESSING 
          SA1    T.STMT 
          SA2    TC=SOA      (X2) = SAVED *T.STMT* ORD
          IX7    X1+X2       (X7) = CURRENT *T.STMT* ADDR 
          SA7    A2 
          RJ     RER         RESTORE ENTOKENING REGISTERS 
          SX7    1
          SA7    TF=SQZ      SET TO *BLANK SQUEEZE, PLEASE* 
          EQ     TOK=MN 
 TOK=EOO  SPACE  4,10 
**        TOK=EOO - END OF OCTAL/HEX CONSTANT.
* 
*         NEED TO --
* 
*           1. CLEAR (CH=TAD) TO INDICATE THAT WE HAVE FOUND THE
*              TERMINATING " FOR THIS *OCT/HEX* CONSTANT. 
* 
*              SEE *DATA STRUCTURES/CH=TAD* FOR DETAILS.
* 
*           2. SET (X4) TO .MI. TO EFFECTIVELY IGNORE THE TERMINATING 
*              ". 
  
  
 TOK=EOO  BSS    0           ** ENTRY **
          BX7    X7-X7
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SA7    CH=TAD      SET TO *HAVE FOUND END OF STRING*
          EQ     TOK=MN 
 TOK=EOQ  SPACE  4,10 
**        TOK=EOQ - END OF QUOTE STRING.
* 
*         HERE WHEN THE TERMINATING QUOTE OF A QUOTE DELIMITED
*         STRING HAS BEEN FOUND/SENSED.  CALL *EOH* (END OF HOLLERITH 
*         STRING PROCESSING) TO --
* 
*           1. SPACE-FILL THE FINAL/LAST WORD OF THE QUOTE STRING 
*              BECAUSE QUOTE STRINGS ARE -H- FORMAT.
* 
*           2. UPDATE THE INCOMPLETE *O.HOLL* TOKEN BY STORING THE
*              STRING LENGTHS (NR OF WORDS OCCUPIED BY THE STRING, AND
*              NR OF CHARACTERS IN THE STRING) INTO IT. 
* 
*           3. ENTER THE STRING THAT WAS TEMPORARILY STORED INTO *T.TB* 
*              IMMEDIATELY FOLLOWING THE *O.HOLL* TOKEN INTO *T.CON*
*              VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         NOTE THAT UPON ENTRY TO *TOK=EOQ* THAT (X4) IS POINTING TO THE
*         1ST CHARACTER IMMEDIATELY FOLLOWING THE " MARK.  IF YOU ARE 
*         WONDERING WHY IT IS NOT POINTING TO THE " MARK ITSELF, IT IS
*         BECAUSE THE *TOK=ITQ* (IGNORE TERMINATING QUOTE) PROCESSING 
*         ALREADY ADVANCED THE CHARACTER POINTER.  SEE PROC *QOT*.
  
  
 TOK=EOQ  EQU    TOK=EOH
 TOK=EQL  SPACE  4,10 
**        TOK=EQL - HERE IF *=* ENCOUNTERED DURING TOKEN GENERATION.
* 
*           1. IF THIS *=* WAS AT PAREN LEVEL ZERO, THEN WE NEED TO MAKE
*              A NEW ENTRY IN THE *ZLEQUAL* CHAIN.
* 
*              FOR EXAMPLE, CONSIDER THE FOLLOWING LINE, AND ASSUME THAT
*              *TOK* IS INVOKING *TOK=EQL* FOR THE THIRD (LEFT-TO-RIGHT)
*              ZERO LEVEL *=* --
* 
*                A(I)  =  B(I)  =  C(I)  =  0 
*                      &       . &       &
*                      .       . .       .
*                      ......... .       ...... *TOK* IS HERE 
*                                .
*                                .............. *ZLEQUAL* POINTS HERE 
* 
*              AFTER *TOK=EQL* -- 
* 
*                A(I)  =  B(I)  =  C(I)  =  0 
*                      &       . &      . & 
*                      .       . .      . . 
*                      ......... ........ ..... *ZLEQUAL* POINTS HERE 
* 
*           2. IF THIS *O.=* TOKEN IS NOT AT PAREN LEVEL 0, THEN SET
*              *TB.EQL* BIT IN THE *O.LP* TOKEN THAT DENOTES/BEGINS 
*              THIS PAREN NEST LEVEL TO INDICATE THAT THIS PAREN LEVEL
*              CONTAINS AN *O.=* TOKEN. 
* 
*              E.G., CONSIDER --
* 
*                PRINT 100,(A(I),I=1,10)
*                          .      . 
*                          .      ....... WE ARE HERE 
*                          .
*                          .............. SET *TB.EQL* BIT IN THIS
*                                         *O.LP* TOKEN
  
  
 TOK=EQL  BSS    0           ** ENTRY **
          SA3    TB=PLVL
          SA2    ZLEQUAL
          SA1    TB=LLP      (X1) = ADDR OF LAST (MOST RECENT) LP TOKEN 
          NZ     X3,EQL2     IF NOT AT PAREN LEVEL ZERO 
          SX7    A6+B1       (X7) = ADDR OF THIS 0 LVL *=*
          LX2    WA.SYMP-0
          SA7    A2 
          BX6    X6+X2       MERGE *ZLEQUAL* POINTER
  
*         HERE TO SET *TB.EQL* BIT IN *O.LP* TOKEN. 
  
 EQL2     ZR     X1,TOK=COS  IF END OF *LLP* CHAIN ENCOUNTERED
          SA2    X1          (A2,X2) = A+C OF LINKED LEFT PAREN 
          BX7    X2          SAVE (X2)
          LX2    0-TB.LLPP
          ERRNZ  18-TB.LLPL 
          SX1    X2          (X1) = ADDR OF PRIOR LINKED LEFT PAREN 
          LX2    0-TB.IOCPP+TB.LLPP-0 
          ERRNZ  18-TB.IOCPL
          SX3    X2          (X3) = ADDR OF MATCHING RIGHT PAREN, 
*                                   ELSE .ZR. IF NONE 
          NZ     X3,EQL2     IF THIS LEFT PAREN HAS A MATCHING RT PAREN 
  
          MX1    1
          LX1    TB.EQLP-59 
          BX7    X7+X1       SET TO *EQUAL AT THIS PAREN LEVEL* 
          SA7    A2 
          EQ     TOK=COS     CONTINUE WITH TOKEN GENERATION...
 TOK=HOL  SPACE  4,10 
**        TOK=HOL - HERE IF EOL ENCOUNTERED DURING *HLR* STRING.
* 
* 
  
  
 TOK=HOL  BSS    0           ** ENTRY **
          LE     B5,B0,HOL3  IF *HLR* STRING IS COMPLETE/FINISHED 
          SX6    TOK=HOL
          SX7    B5+
          SA6    TC=EOL      RESET *ON EOL* ADDR TO *TOK=HOL* 
          SA7    CH=CNT      SAVE (B5)
          EQ     TOK         EXIT...
  
*         HERE IF *HLR* STRING IS COMPLETE AT EOL.
* 
*           1. NEED TO BACK UP (A6) BECAUSE *TOK=EOL* STORED AN EOS 
*              MARK, AND WE NEED TO IGNORE IT.
* 
*           2. SET UP (X4) WITH A DUMMY BLANK (55B) CHARACTER 
*              SO THAT THE TOGEL PROC *HLR* (PROCESS HLR STRING)
*              CAN FINISH UP PROCESSING THIS HLR STRING.
* 
*              THIS IS NECESSARY TO **TRICK** *COMCTOK* INTO
*              THINKING THAT HE HAS A CHARACTER TO PROCESS (WHEN
*              IN FACT HE DOES NOT) SO THAT ALL THE END-OF-HLR
*              STRING TYPE PROCESSING SPECIFIED IN PROC *HLR* 
*              CAN HAPPEN.  SEE PROC *HLR*. 
* 
*              THE PROBLEM IS THAT *COMCTOK* UNCONDITIONALLY MAKES
*              SURE THAT WE HAVE A CHARACTER TO PROCESS IN (X4) BY
*              ADVANCING THE CHARACTER POINTER IF (X4) ARE EMPTY, .MI.
*              UNDER NORMAL CIRCUMSTANCES, THIS IS THE APPROPRIATE THING
*              TO DO.  BUT UNDER OUR CURRENT HLR STRING AT EOL CIRCUM-
*              STANCE, THIS CAUSES *TOK* TO EXIT PREMATURELY BECAUSE WE 
*              ARE AT END-OF-LINE (I.E. *TOK*S EXIT CONDITION). 
  
 HOL3     SA1    A6-B1
          BX6    X1 
          SA6    A1+
          SX4    1R 
          EQ     TOK=MN      BACK TO OUR TOGEL PROGRAM... 
 TOK=ILL  SPACE  4,10 
**        TOK= ILL -         ILLEGAL FORTRAN CHARACTER ENCOUNTERED. 
* 
*         PLACE THE OFFENDING CHAR INTO THE UPPER 6 BITS OF ILL TOKEN 
  
  
 TOK=ILL  BSS    0
          BX1    X4 
          LX1    -CHAR
          BX6    X1+X6       MERGE OFFENDING CHARACTER
          EQ     TOK=COS
 TOK=ITQ  SPACE  4,10 
**        TOK=ITQ - IGNORE TERMINATING QUOTE. 
* 
* 
*         THIS PROCESSOR EXISTS FOR THE SOLE PURPOSE OF IGNORING
*         THE QUOTE THAT TERMINATES A QUOTE DELIMITED STRING.  THAT IS, 
*         *TOK* IS POINTING TO THE TERMINATING " AND WE NEED TO ADVANCE 
*         THE CHARACTER POINTER BEFORE MOVING ON... 
* 
*         SEE ALSO *CH=SB3* IN *DATA STRUCTURES* SECTION. 
  
  
 TOK=ITQ  BSS    0           ** ENTRY **
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SX7    B3 
          SA7    CH=SB3      SAVE (B3)
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    X2+X1      INDICATE TERMINAL DELIMITER ENCOUNTERED 
          SA7    A1 
          EQ     TOK=MN 
 TOK=LP   SPACE  4,10 
**        TOK=LP - HERE IF *(* ENCOUNTERED DURING TOKEN GENERATION. 
* 
*           1. INCREMENT (TB=PLVL), THE PAREN LEVEL INDICATOR.
* 
*           2. LINK THIS LEFT PAREN TO ITS PRIOR LEFT PAREN WITHIN
*              THIS PAREN NEST. 
* 
*              THIS IS ACCOMPLISHED BY MOVING THE CONTENTS OF *TB=LLP*
*              (WHICH CONTAINS THE ADDR OF THE PRIOR *O.LP* TOKEN)
*              TO THE *TB.LLP* FIELD OF THE *O.LP* TOKEN THAT WE ARE
*              ABOUT TO GENERATE, AND BY THEN MOVING THE ADDR OF OUR
*              ABOUT-TO-BE-GENERATED *O.LP* TOKEN TO (TB=LLP)...THUS
*              COMPLETING THE CYCLE.
* 
*              SEE *DATA STRUCTURES/TB=LLP* AND *TOK=RP* FOR MORE 
*              INFORMATION. 
  
  
 TOK=LP   BSS    0           ** ENTRY **
          SA1    TB=PLVL
          SX7    X1+B1
          SA7    A1 
          SA1    TB=LLP      (X1) = ADDR IN *T.TB* OF LAST LEFT PAREN,
*                                   ELSE .ZR. IF NONE 
          LX1    TB.LLPP-0
          BX6    X6+X1       MERGE *LLP*
          SX7    A6+B1       (X7) = ADDR IN *T.TB* OF THIS LEFT PAREN 
          SA7    A1 
          EQ     TOK=COS     CONTINUE...
 TOK=NOH  SPACE  4,10 
**        TOK=NOH - CHECK FOR OCCURENCE OF 'CHARACTER *'. 
* 
* 
*         *TOK=NOH* (NO HOLLERITH PROCESSING) EXISTS FOR THE PURPOSE
*         OF CHECKING TO SEE IF WE ARE IN A 'CHARACTER *' STATEMENT 
*         DURING THE PROCESSING OF -H-, -L-, OR -R- STRINGS.  IF SO,
*         WE CANNOT HONOR THE *HLR* STRING (I.E. WE TRANSFER
*         CONTROL OF THE TOKEN GENERATOR TO *TOM=VAR*). 
* 
*         SEE DATA STRUCTURES/LEXFLG/CHR FOR DETAILS. 
  
  
 TOK=NOH  BSS    0           ** ENTRY **
          SA1    LEXFLG 
          SBIT   X1,LF.CHRP 
          PL     X1,TOK=MN   IF NOT IN 'CHARACTER *' STMT, OK...
          SA0    TOM=VAR
          EQ     TOK=MN 
 TOK=QOC  SPACE  4,10 
**        TOK=QOC - HERE IF *''* ENCOUNTERED **WITHIN** A ' STRING. 
* 
*         THIS IS THE SPECIAL *2 QUOTES ARE 1 QUOTE* WITHIN A QUOTE 
*         STRING PROCESSOR.  WE HANDLE THIS AS FOLLOWS -- 
* 
*           1. WE RESET *TOK*S PSEUDO P REGISTER, (A0), BACK TO THE 
*              *GROUP,...,NSQZ* INSTRUCTION FOR THIS QUOTE STRING,
*              (I.E. BACK TO *TOM=QOC*).  THIS IS, IN EFFECT, A *GOTO*
*              BUT WE DO NOT USE A *GOTO* BECAUSE WE HAVE TO RESTART
*              THE *GROUP,...,NSQZ* INSTRUCTION.  THAT IS, IF WE HAD
*              USED A *GOTO TOM=QOC*, A **NEW** CHAR TOKEN WOULD BE 
*              GENERATED AND WE WANT TO CONTINUE GENERATING THE SAME
*              OLD CHAR TOKEN.
* 
*           2. MERGE THE ' CHARACTER, WHICH HAPPENS TO BE IN (X4), INTO 
*              THE CHAR/QUOTE TOKEN THAT WE ARE GENERATING.  IN THIS
*              WAY, THE '' SYNTAX BECOMES A SINGLE ' AS PART OF THE 
*              QUOTE STRING.
* 
*              NOTE THAT IN PERFORMING THIS, THAT A LITTLE CARE MUST BE 
*              TAKEN IF (X6) IS NOW EMPTY (I.E. WAS FULL AFTER THE LAST 
*              *GROUP,...,NSQZ*). 
* 
*           3. RESTART THE *GROUP,...,NSQZ* AT *TOM=QOC*. 
  
  
 TOK=QOC  BSS    0           ** ENTRY **
          SA0    TOM=QOC+1   RESET *TOGEL* P REGISTER 
 TOK=QOC1 SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE TERMINAL DELIMITER NOT ENCOUNTERED
          SA7    A1 
          SA1    CH=SB3      (X1) = SAVED (B3)
          SA2    A6          (X2) = CURRENT WORD OF '' STRING 
          SB2    BN.TOCP+BN.TOCL-CHAR 
          SB4    A6          (B4) = ADDR TO STORE TOKEN W/ INVENTED ' 
          SB3    X1          RESTORE (B3) 
          BX6    X2          RESTORE (X6) 
          NE     B3,B2,QOC2  IF LAST TOKEN NOT FULL 
          SB4    A6+1 
          SX6    0           CLEAR PACKING REGISTER 
 QOC2     LX3    X4,B3
          SB3    B3-CHAR
          BX6    X6+X3       MERGE INVENTED ' 
          SA6    B4 
          =A2    A0-1        (X2) = *GROUP* INST FOR STRING 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          SB5    B5-B1       (B5) = -(CHAR COUNT) 
          LX2    0-TG.TOFUP  INITIALIZE (X2)
          PL     B3,TOK=GN-1 IF THIS CHAR DID NOT FILL WORD 
          SB3    BN.TOCP+BN.TOCL-CHAR 
          EQ     TOK=GN-1    RESTART *GROUP*
 TOK=QOL  SPACE  4,10 
**        TOK=QOL - HERE IF EOL ENCOUNTERED DURING QUOTE STRING.
* 
* 
*         NEED TO SAVE THE ""/'' STRING CHARACTER COUNT, I.E. (B5), 
*         IN (CH=CNT).  SEE DATA STRUCTURES/CH=CNT. 
  
  
 TOK=QOL  BSS    0           ** ENTRY **
          SX7    B5+
          SA7    CH=CNT      SAVE (B5)
          EQ     TOK         EXIT...
 TOK=QOQ  SPACE  4,10 
**        TOK=QOQ - HERE IF *""* ENCOUNTERED **WITHIN** A QUOTE STRING. 
* 
*         THIS IS THE SPECIAL *2 QUOTES ARE 1 QUOTE* WITHIN A QUOTE 
*         STRING PROCESSOR.  WE HANDLE THIS AS FOLLOWS -- 
* 
*           1. WE RESET *TOK*S PSEUDO P REGISTER, (A0), BACK TO THE 
*              *GROUP,...,NSQZ* INSTRUCTION FOR THIS QUOTE STRING,
*              (I.E. BACK TO *TOM=QOQ*).  THIS IS, IN EFFECT, A *GOTO*
*              BUT WE DO NOT USE A *GOTO* BECAUSE WE HAVE TO RESTART
*              THE *GROUP,...,NSQZ* INSTRUCTION.  THAT IS, IF WE HAD
*              USED A *GOTO TOM=QOQ*, A **NEW** HOLL TOKEN WOULD BE 
*              GENERATED AND WE WANT TO CONTINUE GENERATING THE SAME
*              OLD HOLL TOKEN.
* 
*           2. MERGE THE " CHARACTER, WHICH HAPPENS TO BE IN (X4), INTO 
*              THE HOLL/QUOTE TOKEN THAT WE ARE GENERATING.  IN THIS
*              WAY, THE "" SYNTAX BECOMES A SINGLE " AS PART OF THE 
*              QUOTE STRING.
* 
*              NOTE THAT IN PERFORMING THIS, THAT A LITTLE CARE MUST BE 
*              TAKEN IF (X6) IS NOW EMPTY (I.E. WAS FULL AFTER THE LAST 
*              *GROUP,...,NSQZ*). 
* 
*           3. RESTART THE *GROUP,...,NSQZ* AT *TOM=QOQ*. 
  
  
 TOK=QOQ  BSS    0           ** ENTRY **
          SA0    TOM=QOQ+1   RESET *TOGEL* P REGISTER 
          EQ     TOK=QOC1 
 TOK=REH  SPACE  4,10 
**        TOK=REH - *RESTART* PROCESSING FOR *HLR* STRINGS. 
* 
* 
*         NEED TO RESTORE (B5), THE *HLR* STRING CHARACTER COUNTER. 
* 
*         ENTRY  (B2) = RESTART TOFU ADDRESS. 
*                (X2) = *TOGEL* INSTRUCTION TO XEQ. 
*                ENTOKENING REGISTERS SET UP. 
  
  
 TOK=REH  BSS    0           ** ENTRY **
          SA1    SB=LORD     (X1) = *T.STMT* ORD OF THIS CONTINUATN LINE
          RJ     XER         EXTRACT AND RESTORE ENTOKENING REGISTERS 
          SA1    CH=CNT      (X1) = SAVED CHARACTER COUNTER 
          SA2    A0-B1       RESTORE (A2) 
          SB5    X1 
          LX2    0-TG.TOFUP  RESTORE (X2) 
          JP     B2          CONTINUE...
 TOK=REQ  SPACE  4,10 
**        TOK=REQ - *RESTART* PROCESSING FOR QUOTE STRINGS. 
* 
* 
  
  
 TOK=REQ  =      TOK=REH
 TOK=RP   SPACE  4,10 
**        TOK=RP - HERE IF *)* ENCOUNTERED DURING TOKEN GENERATION. 
* 
*         NEED TO --
* 
*           1. DECREMENT (TB=PLVL), THE PAREN LEVEL INDICATOR.
* 
*           2. IF WE ARE A PAREN LEVEL 0, I.E. (TB=PLVL)=0, 
*              THEN IF THIS IS THE 1ST ZERO LEVELING *)* OF THIS STMT,
*              INDICATE SO VIA *ZLPAREN*. 
* 
*           3. LINK THIS RIGHT PAREN TO ITS MATCHING *O.LP* TOKEN 
*              BY STUFFING THE ADDR OF THIS *O.RP* TOKEN INTO THE 
*              *TB.IOCP* FIELD OF THE APPROPRIATE MATCHING *O.LP* 
*              TOKEN. 
  
  
 TOK=RP   BSS    0           ** ENTRY **
          SA1    TB=PLVL
          SA2    ZLPAREN
          SX7    X1-1 
          SA7    A1+
          NZ     X2,RIP2     IF HAVE ALREADY FOUND 1ST ZERO LVLING *)*
          NZ     X7,RIP2     IF NOT AT PAREN LEVEL 0
          SX7    A6+B1       (X7) = ADDR OF 1ST ZERO LVLING *)* 
          SA7    A2 
  
*         HERE TO LINK THIS RIGHT PAREN TO ITS MATCHING *O.LP* TOKEN. 
  
 RIP2     SA1    TB=LLP      (X1) = ADDR IN *T.TB* OF LAST LEFT PAREN,
*                                   ELSE .ZR. IF NONE 
  
 RIP3     ZR     X1,RIP4     IF END OF *LLP* CHAIN ENCOUNTERED
          SA2    X1          (A2,X2) = A+C OF LINKED LEFT PAREN 
          BX7    X2          SAVE (X2)
          LX2    0-TB.LLPP
          ERRNZ  18-TB.LLPL 
          SX1    X2          (X1) = ADDR OF PRIOR LINKED LEFT PAREN 
          LX2    0-TB.IOCPP+TB.LLPP-0 
          ERRNZ  18-TB.IOCPL
          SX3    X2          (X3) = ADDR OF MATCHING RIGHT PAREN, 
*                                   ELSE .ZR. IF NONE 
          NZ     X3,RIP3     IF THIS LEFT PAREN ALREADY MATCHED 
          SX2    A6+B1       (X2) = ADDR OF MATCHING RP TO BE STORED
          LX2    TB.IOCPP-0 
          BX7    X7+X2       MERGE *IOCP* 
          SA7    A2 
          NZ     X1,TOK=COS  IF NOT AT PAREN LEVEL ZERO 
  
*         HERE WHEN BACK AT PAREN LEVEL 0.  NEED TO CLEAR (TB=LLP)
*         TO INDICATE THAT WE ARE STARTING A NEW PAREN NEST.
  
 RIP4     SX7    0
          SA7    TB=LLP 
          EQ     TOK=COS     CONTINUE...
 TOK=SQT  SPACE  4,10 
**        TOK=SQT - HERE IF ' ENCOUNTERED VIA *CASEOF*. 
* 
*         SEE *TOK=DQT* FOR IMPORTANT INFORMATION.
  
  
 TOK=SQT  BSS    0           ** ENTRY **
          SA0    TOM=SQT     RESET PSEUDO -P- REGISTER
          EQ     TOK=MN 
 LEX      TTL    LEX - LEXICAL SCANNER/SUPPORTING SUBROUTINES.
          EJECT 
 BLL      SPACE  4
**        BLL - BREAK LONG LINE 
* 
* 
*         WHEN PRINT LINE IS .GT. PAGE WIDTH, BLL PRINTS FIRST PART OF
*         LINE AND LEFT JUSTIFIES REMAINDER.
* 
*         ENTRY  (A2) = ADDRESS OF LAST WORD OF 1ST PART
*                (X2) = LAST WORD OF 1ST PART 
*                (B2) = FWA OF LINE - 1 
*                (B5) = NUMBER OF BITS TO PRINT OF LAST WORD OF 1ST PART
*                (B6) = LWA OF LINE 
* 
*         EXIT   (X1) = FWA OF 2ND PART 
*                (X2) = LENGTH OF 2ND PART
*                (X6) = 0  IF NO LINE PRINTED 
*                1ST PART PRINTED 
* 
*         USES   A - 1-4, 6, 7
*                X - 1-4, 6, 7
*                B - 2, 3, 5, 6, 7
* 
*         PRESERVES  A0, X0, A5, X5, B4 
* 
*         CALLS  LSS, PLINE 
  
  
 BLL4     BX4    X1*X3
          BX6    X4+X2
          IX6    X3-X6
          NZ     X6,BLL2     IF NOT ALL BLANKS
          SX1    B2+B1       FWA OF LINE
          SX2    B6-B2       LENGTH OF LINE 
  
 BLL      SUBR   =           ENTRY/EXIT...
          MX1    0
          ZR     B5,BLL1     IF BREAK ON WORD BOUNDARY
          MX1    1
          SB7    B5-B1
          AX1    B7 
 BLL1     BX7    X1*X2       LEFT SIDE
          SB3    A2-B6
          SA3    =10H 
          BX4    -X1*X3      BLANK FILL FOR LEFT
          BX7    X4+X7
          BX2    -X1*X2      (X2) = RIGHT SIDE OF SPLIT WORD
          ZR     B3,BLL4     IF 2ND PART ONLY ONE PARTIAL WORD
 BLL2     RJ     LSS         LEFT SHIFT STRING
          SA6    BLLA        SAVE FIRST WORD OF SECOND LINE 
          SA7    A2          SET LEFT SIDE INTO BUFFER
          SA3    A2+B1
          BX7    X3 
          SA7    A6+B1       SAVE 2ND WORD  OF 2ND LINE 
          SB3    A2-B1
          SX6    B3 
          SA6    A7+B1       SAVE 2ND LINE FWA
          SB3    B3-B1
          SX7    B6-B3
          SA7    A6+B1       SAVE 2ND LINE LENGTH 
          SX2    A2-B2
          PLINE  B2+B1,X2 
          SA2    BLLA+3      LENGTH 
          SA1    A2-B1       FWA
          SA3    X1 
          SA4    =10H   >>>>
  
 .FIX     SET                LONG LINE DAP REQUIRES MOD HERE
          BX6    X4 
          SA6    A3 
          SA3    A1-B1       2ND WORD 
          SA4    A3-B1       1ST WORD 
          BX6    X4 
          SA6    A6+B1       RESET 1ST WORD 
          BX7    X3 
          SA7    A6+B1       RESET 2ND WORD 
          EQ     EXIT.
  
 BLLA     BSS    1           LINE 2 FIRST WORD
          BSS    1           LINE 2 SECOND WORD 
          BSS    1           LINE 2 FWA 
          BSS    1           LINE 2 LENGTH
*CALL     COMCBUB            BURST/BUILD CHARACTERS WITH BLANK SQUEEZE. 
          TITLE 
*CALL     COMCBUN            BURST/BUILD CHARACTERS - NO BLANK SQUEEZE. 
          TITLE 
 CAK      SPACE  4,10 
**        CAK - CHECK FOR AND ADJUST STATEMENT KEYWORD. 
* 
* 
*         THIS ROUTINE TRIES TO MATCH A GIVEN SEQUENCE OF TOKENS
*         IN THE TOKEN BUFFER WITH A KEYWORD ENTRY IN A SPECIFIED 
*         KEYWORD TABLE.  AND THEN IF A MATCH IS FOUND, ERASES ALL
*         TRACE OF THE FOUND KEYWORD FROM THE TOKEN BUFFER. 
* 
*         THIS PROCESS IS PERHAPS BEST UNDERSTOOD WITH AN EXAMPLE.
*         GIVEN THE KEYWORD STMT -- 
* 
*           COMMON EST(10)
* 
*         WHICH BECOMES IN *T.TB* --
* 
*           O.VAR'COMMONE'  O.VAR'ST'  O.LP  O.CONS'10'  O.RP  O.EOS
* 
*         *CAK* WILL SEARCH THE FTN STMT KEYWORD TABLE FOR *COMMON*,
*         AND THEN ADJUST THE TOKEN BUFFER TO --
* 
*           O.VAR'EST'  O.LP  O.CONS'10'  O.RP  O.EOS 
* 
*         IN THIS WAY, AFTER A *CAK* CALL, THE TOKEN BUFFER IS READY
*         TO BE PASSED OFF TO THE APPROPRIATE STMT PROCESSOR (I.E. THE
*         STMT KEYWORD HAS BEEN LOGICALLY REMOVED). 
* 
*                ** AN IMPORTANT MESSAGE ** 
* 
*         AS WILL BECOME EVIDENT BELOW, THIS CONCEPTUALLY TRIVIAL PIECE 
*         OF CODE LOCKS HORNS WITH A NUMBER OF NON-TRIVIAL PATHOLOGIES
*         THAT ARE CONCERNED WITH THE MASSAGING OF THE TOKEN BUFFER THAT
*         IS NECESSARY TO REMOVE THE KEYWORD.  THIS IS CLEARLY A
*         TRADE-OFF: TOKEN GENERATION WAS SIMPLIFIED BY NOT SPECIAL 
*         CASING KEYWORD ENTOKENING, BUT KEYWORDS DO NOT FIT CLEANLY
*         INTO THE TOKEN STRUCTURE.  THEREFORE, *CAK* IS THE ONE
*         RESPONSIBLE FOR CLEANING UP AND REMOVING ALL TRACES OF
*         A KEYWORD FROM THE *T.TB*.
* 
*         ALSO, BEWARE OF REGISTERS...THEY ARE DECEPTIVELY TIGHT. 
* 
*                          * * *
* 
*         ENTRY  (B4) = ADDR OF 1ST TOKEN CONTAINING CHARS
*                       TO TRY AND FIND A KEYWORD MATCH FOR.
*                (B6) = FWA OF KEYWORD TABLE TO SEARCH. 
*                (B7) = LEN OF KEYWORD TABLE TO SEARCH (IN WORDS).
* 
*         EXIT   (B7) = .NZ. IF A FIND, ELSE .ZR. 
* 
*                IF A FIND, (B7) .NZ. --
*                (B7) = KEYWORD TABLE ADDRESS IF SPELLED CORRECTLY, 
*                       ELSE .MI. 
*                (B4) = ADDR OF 1ST TOKEN FOLLOWING KEYWORD.
*                       I.E. POSSIBLY THE ADDR OF A TOKEN THAT WAS
*                       GENERATED BY *CAK* AFTER KEYWORD WAS REMOVED. 
*                (X6) = *KEYW* TABLE ENTRY FOR THIS KEYWORD.
* 
*         USES   ALL BUT A0,X0,A5,X5
* 
*         CALLS  NONE 
  
  
 CAK      SUBR   =           ** ENTRY/EXIT ** 
  
*         INITIALIZATION. 
  
          SA1    B4          (A1,X1) = A+C OF 1ST TOKEN IN STMT KEYWORD 
          MX4    4*CHAR 
          BX6    X4*X1
          LX6    4*CHAR      X6 = 1ST 4 CHARS OF POSSIBLE KEYWORD (0R)
  
**        BINARY SEARCH OF KEYWORD TABLE. 
  
 CAK2     ZR     B7,EXIT.    IF NOT IN TABLE
          SX7    B7 
          AX7    X7,B1
          SA3    B6+X7       (A3,X3) = A+C OF KEYWORD TABLE ENTRY 
          SB3    B7 
          SB7    X7 
          LX3    -KW.KEYP 
          SA2    X3          (X2) = 1ST 7 CHARS OF TABLE ENTRY
          SB2    X7          B2 = CURRENT LENGTH/2
          BX7    X2*X4
          LX7    4*CHAR 
          IX7    X7-X6
          ZR     X7,CAK3     IF FOUND IT
          PL     X7,CAK2     IF KEYWORD LIES IN TOP HALF
          SB7    B3-B2
          =B7    B7-1        ADJUST LENGTH
          SB6    B6+B2
          =B6    B6+1        POINT TO BOTTOM HALF 
          EQ     CAK2 
  
*         HERE IF A FIND IN KEYWORD TABLE.
* 
*           1. EXTRACT KEYWORD LENGTH FROM FOUND KEYWORD ENTRY. 
* 
*           2. SET UP *FILL.* AND *FILL.2* TO BE 1ST 14 CHARS 
*              OF KEYWORD ENTRY SO THAT IF WE HAVE TO ISSUE 
*              *MISSPELLED KEYWORD* ERR MSG, IT CAN INDICATE WHAT 
*              WE ASSUMED THE STMT KEYWORD TO BE. 
  
 CAK3     LX3    KW.KEYP-0
          BX6    X3 
          LX3    0-KW.LENP
          SA6    CAKA        SAVE FOUND *KEYW* ENTRY
          MX7    -KW.LENL 
          BX4    -X7*X3      EXTRACT *LEN*
          SB2    X4          (B2) = NR OF BITS IN KEYWORD 
          LX6    X2          (X6) = 1ST 7 CHARS OF KEYWORD ENTRY
          SB3    7*CHAR 
          SA4    A2+B1       (X4) = 2ND 7 CHARS OF KEYWORD ENTRY
          BX7    X7-X7
          SB7    A3          SET TO ADDRESS OF FOUND KEYWORD
          LE     B2,B3,CAK4  IF KEYWORD HAS .LE. 7 CHARS
          LX7    X4 
 CAK4     SA6    FILL.
          SA7    A6+B1
  
*         VERIFY THAT KEYWORD THAT WAS FOUND IS SPELLED CORRECTLY 
*         (NOTE: THIS IS NECESSARY BECAUSE KEYWORD SEARCH IS PERFORMED
*         USING ONLY THE 1ST 4 CHARACTERS OF KEYWORD).
* 
*         KEYWORD SPELLING VERIFICATION IS ACCOMPLISHED BY SIMPLY 
*         COMPARING THE *O.VAR* KEYWORD TOKENS IN THE TOKEN BUFFER
*         WITH THE KEYWORD LITERAL STRING SPECIFIED IN KEYWORD TABLE. 
* 
*         IN THE INTEREST OF MAKING THIS CODE A LITTLE SIMPLER, 
*         THE KEYWORD LITERAL STRING WAS GENERATED INTO TOKEN-SIZE
*         CHUNKS (7 CHARS PER WORD) AT ASSEMBLY-TIME (VIA *LITKEY*
*         MACRO IN *FTN5TXT*).
* 
*         THERE ARE 3 VARIANTS OF THIS SPELLING VERIFICATION, 
*         A DISCUSSION OF WHICH WILL MAKE THIS CODE EASIER
*         TO UNDERSTAND --
* 
*           1. VERIFYING FULL TOKENS, AS FOR -- 
* 
*                VAR'SUBROUT'  VAR'INEYWEE'  VAR'NY'
* 
*              THE 1ST TOKEN WILL BE CHECKED BY MERELY COMPARING
*              IT TO THE 1ST 7 CHARACTER KEYWORD LITERAL (7LSUBROUT)
*              SPECIFIED IN THE KEYWORD TABLE ENTRY FOR -SUBR-. 
* 
*           2. VERIFYING A PARTIAL TOKEN, AS FOR -VAR'INEYWEE'- IN
*              THE ABOVE EXAMPLE.  CLEARLY, A FULL TOKEN COMPARE
*              CANNOT BE USED BECAUSE THE SUBROUTINE NAME -YWEENY-
*              IS CONCATENATED WITH THE KEYWORD -SUBROUTINE-.  IN THIS
*              CASE, -INE- WILL BE EXTRACTED FROM -VAR'INEYWEE'-
*              BEFORE COMPARING (EXTRACTION IS PERFORMED BASED ON 
*              THE NUMBER OF BITS THAT SHOULD BE IN KEYWORD.  SEE 
*              *KW.LEN* FIELD). 
* 
*           3. WHEN KEYWORD IN TOKEN BUFFER IS TOO SHORT, AS IN --
* 
*                SUBROUT(P1)
* 
*              (I.E. PROGRAMMER FORGOT SOMETHING OR WAS BEING CUTE).
*              THEREFORE, THE TOKEN TYPE OF THE NEXT **EXPECTED** 
*              KEYWORD TOKEN MUST BE VERIFIED TO BE *O.VAR* BEFORE
*              CHECKING CHARS IN TOKEN. 
  
          SB5    X1          (B5) = TOKEN TYPE OF KEYWORD TOKEN, *O.VAR*
 CAK5     MX4    TB.TOCL
          BX3    X3-X3
          SB6    X1 
          BX1    X4*X1       (X1) = 1ST 7 CHARS OF TOKEN, -L- FMT 
          ZR     B2,CAK7     IF KEYWORD FELL ON A TOKEN BOUNDARY
          NE     B5,B6,CAK11 IF *TOT*S DO NOT MATCH, KEYWD TOO SHORT... 
          LT     B2,B3,CAK6  IF NR CHARS REMAINING TO CHECK .LT. 7
          IX7    X1-X2
          SA1    A1+B1       (A1,X1) = A+C OF NEXT TOKEN
          SA2    A2+B1       (A2,X2) = A+C OF NEXT KEYWORD LITERAL
          SB2    B2-B3
          ZR     X7,CAK5     IF KEYWORD SPELLED OK
          SB7    -B1         SET TO *KEYWORD MISSPELLED*
          EQ     CAK5 
  
*         HERE TO CHECK CHARACTERS IN FINAL/LAST KEYWORD TOKEN. 
  
 CAK6     SB3    B2-B1
          MX3    1
          AX3    B3          (X3) = MASK TO EXTRACT LAST CHARS
*                                   IN KEYWORD FROM KEYWORD TOKEN 
          BX6    X3*X1
          IX6    X6-X2
          BX1    -X3*X1 
          ZR     X6,CAK7     IF KEYWORD SPELLED OK
          SB7    -B1         SET TO *KEYWORD MISSPELLED*
  
*         HERE WHEN KEYWORD VALIDITY AND LENGTH IN TOKEN BUFFER 
*         HAVE BEEN DETERMINED.  READY TO MASSAGE *T.TB* IN ORDER 
*         TO LOGICALLY REMOVE KEYWORD FROM TOKEN BUFFER.
* 
*         THIS INVOLVES PERFORMING 2 DISTINCT FUNCTIONS --
* 
*           1. CONSIDER THAT, IN FORTRAN, A STMT KEYWORD CAN
*              SOMETIMES BE CONCATENATED WITH THE 1ST NON-KEYWORD 
*              TOKEN OF THE STMT (AS IN *PRINT100*).  NOW CONSIDER
*              THAT KEYWORDS ARE MERELY ALPHANUMERIC *O.VAR*
*              TOKENS.  AFTER REMOVING THE KEYWORD *PRINT* IN 
*              OUR EXAMPLE, THE REMAINING *100* STILL HAS THE 
*              TOKEN TYPE OF THE KEYWORD (I.E. *O.VAR*).
* 
*              THEREFORE, IF AFTER REMOVING THE STMT KEYWORD
*              THE REMAINING TOKEN BEGINS WITH A NUMERIC (0 THRU 9) 
*              CHARACTER, THE TOKEN TYPE MUST BE CHANGED TO *O.CONS*. 
* 
*           2. AFTER THE KEYWORD HAS BEEN REMOVED, IT MAY BE
*              NECESSARY TO ADJUST THE REMAINING EX-KEYWORD TOKEN(S). 
* 
*              CONSIDER THE FOLLOWING --
* 
*                SUBROUTINE DOGGY 
* 
*              WHICH BECOMES IN *T.TB* -- 
* 
*                O.BOS  O.VAR'SUBROUT'  O.VAR'INEDOGG'  O.VAR'Y'  O.EOS 
* 
*              AFTER REMOVING KEYWORD --
* 
*                O.VAR'DOGG'  O.VAR'Y'  O.EOS 
* 
*              NOW IT CAN BE SEEN THAT THE 1ST NON-KEYWORD TOKEN
*              IS SPLIT ACROSS 2 TOKENS AND THAT THE 1ST OF THESE 
*              ONLY CONTAINS 4 CHARACTERS.
* 
*              THIS IS A VIOLATION OF THE TOKEN STRUCTURE, AND
*              THEREFORE *T.TB* IS MASSAGED TO PRODUCE -- 
* 
*                O.VAR'DOGGY'  O.EOS
  
 CAK7     SB3    B4          SAVE ORIGINAL (B4) 
          SB4    A1 
          NE     B5,B6,CAK12 IF KEYWORD TOKEN IS EMPTY
          MX6    -CHAR
          LX7    X1,B2       (X7) = REMAINING NON-KEYWORD CHARS, -L- FMT
          LX7    CHAR 
          BX7    -X6*X7 
          SX6    X7-1R0 
          SX7    O.CONS 
          PL     X6,CAK8     IF NUMERIC (0 THRU 9)
          SX7    O.VAR
          ZR     B2,CAK12    IF ON TOKEN BOUNDARY .AND. ALREADY *O.VAR* 
  
*         HERE TO LEFT-SHIFT REMAINING NON-KEYWORD TOKENS 
*         IN TOKEN BUFFER.
* 
*         E.G.:     O.VAR'DOGG'  O.VAR'Y' 
* 
*         BECOMES:  O.VAR'DOGGY'
* 
*         IN THE INTEREST OF UNDERSTANDIBILTY, THE FOLLOWING CODE 
*         IS COMMENTED BY USING 2 EXAMPLES WHICH TYPIFY THE 2 WAYS
*         THIS CODE IS USED.
* 
*           1. EXAMPLE 1 SHOWS HOW A KEYWORD STRUCTURE OF THE FORM -- 
* 
*                O.VAR'KKKKKKK'  O.VAR'KKABCDE'  O.VAR'FGHIJKL' 
* 
*              IS PROCESSED.  *KKKKKKKKK* IS THE REMOVED KEYWORD, 
*              AND *ABCDEFGHIJKL* IS WHAT REMAINS.
* 
*           2. EXAMPLE 2 SHOWS HOW A KEYWORD STRUCTURE OF THE FORM -- 
* 
*                O.VAR'KKKKKKK'  O.VAR'MNOPQRS'  O.VAR'TUVWXYZ' 
* 
*              IS PROCESSED.
* 
*         THE FUNDAMENTAL DIFFERENCE BETWEEN THESE 2 EXAMPLES IS
*         THE FACT THAT IN EXAMPLE 2 NO LEFT SHIFT IS NECESSARY 
*         (ONLY THE TOKEN TYPE NEEDS TO BE CHANGED), WHEREAS FOR
*         EXAMPLE 1, BOTH A LEFT-SHIFT AND A TOKEN TYPE (TOT) 
*         CHANGE NEEDS TO BE PERFORMED. 
* 
*         OTHER ASPECTS OF THIS COMMENTING NOTATION ARE --
* 
*           --- = ORGINAL TOKEN TYPE (TO BE REPLACED WITH *+++*). 
*           +++ = NEW TOKEN TYPE. 
*           0   = 00B, I.E. A NULL CHARACTER BYTE.
*           7   = 77B, I.E. A CHARACTER EXTRACT MASK BYTE.
  
 CAK8     LX1    B2          (X1) = ABCDE00000  IF (B2) .NZ.
*                                 = MNOPQRS000  IF (B2) .ZR.
          BX2    X1 
          IX6    X1+X7       (X6) = ABCDE00+++  IF (B2) .NZ.
*                                 = MNOPQRS+++  IF (B2) .ZR.
          SA1    A1+B1       (X1) = FGHIJKL---  IF (B2) .NZ.
*                                 = TUVWXYZ---  IF (B2) .ZR.
          SB6    X1 
          BX1    X4*X1       (X1) = FGHIJKL000  IF (B2) .NZ.
*                                 = TUVWXYZ000  IF (B2) .ZR.
          ZR     B2,CAK9     IF JUST CHANGING TOKEN TYPE
          NE     B5,B6,CAK9  IF NEXT TOKEN NOT *VAR*, DONE... 
          BX2    X3*X1       (X2) = FG00000000
          BX1    -X3*X1      (X1) = 00HIJKL000
          LX2    TB.TOTL
          LX2    B2          (X2) = 00000FG000
          BX6    X6+X2       (X6) = ABCDEFG+++
          LX2    X1 
  
 CAK9     SA6    A1-1 
          EQ     B5,B6,CAK8  IF NEXT TOKEN IS *VAR*, CONTINUE...
  
*         IF LEFT-SHIFT IN TOKEN BUFFER CREATED A HOLE (I.E. AN EMPTY 
*         TOKEN), THEN WE NEED TO RIGHT-SHIFT EVERYTHING WE JUST GOT
*         THROUGH LEFT-SHIFTING TO FILL IN THE HOLE.
* 
*         E.G.:   O.VAR'DOGG'  O.VAR'Y'  EOS
* 
*         BECOMES: O.VAR'DOGGY'  **HOLE**  EOS
* 
*         NEED TO RIGHT-SHIFT TO: O.VAR'DOGGY' EOS
  
          NZ     X2,CAK12    IF NOT HOLE
  
          SB2    A6 
          SB4    B4+B1
 CAK10    SA1    B2-B1
          SB2    B2-B1
          BX6    X1 
          SA6    A1+B1
          GE     B2,B4,CAK10 IF MORE TO MOVE
          EQ     CAK12
  
*         SPECIAL PLACE FOR SETTING *MISSPELLED KEYWORD* ERR STATUS.
  
 CAK11    SB7    -1          SET TO *MISSPELLED KEYWORD*
  
*         SET UP EXIT CONDITIONS. 
  
 CAK12    SA3    CAKA        (X3) = KEYWORD TABLE ENTRY FOR THIS KEYWORD
          BX6    X3 
  
**        BEFORE LEAVING, ANY O.CONS TOKEN FOLLOWING THE KEYWORD MUST BE
*         CHECKED FOR IMBEDDED NON-DIGITS.
  
          SA1    B4          X1 = TOKEN FOLLOWING THE KEYWORD 
          SX2    X1-O.CONS
          NZ     X2,EXIT.    IF NOT O.CONS
          SA2    FILL.       X2 = KEYWORD 
          SA3    =0LASSIGN
          BX3    X2-X3
          ZR     X3,EXIT.    IF *ASSIGN* KEYWORD
          SA3    =0LDO
          BX3    X2-X3
          ZR     X3,EXIT.    IF *DO* KEYWORD
          MX3    TB.TOCL
          LX1    59-TB.TOCP+1-TB.TOCL 
          BX1    X3*X1       X1 = TOKEN ONLY
          BX7    X1 
          MX3    -CHAR
 CAK15    LX1    CHAR 
          BX2    -X3*X1 
          ZR     X2,EXIT.    IF END OF TOKEN
          SX2    X2-1R0 
          PL     X2,CAK15    IF NUMERIC (0 THRU 9)
          SX2    O.ILL
          BX7    X7+X2       CHANGE TO O.ILL
          SA7    B4          UPDATE *TB*
          EQ     EXIT.
  
  
 CAKA     BSSZ   1           SAVED FOUND *KEYW* ENTRY 
 EOC      SPACE  4,10 
**        EOC - END OF '' (TYPE *CHARACTER*) STRING PROCESSING. 
* 
*         HERE WHEN THE TERMINATING QUOTE OF A ' QUOTE DELIMITED
*         STRING HAS BEEN FOUND/SENSED.  NEED TO -- 
* 
*           1. SPACE-FILL THE FINAL/LAST WORD OF THE QUOTE STRING 
*              BECAUSE QUOTE STRINGS ARE -H- FORMAT.
* 
*           2. UPDATE THE INCOMPLETE *O.CHAR* TOKEN BY STORING THE
*              NR OF CHARACTERS IN THE STRING INTO IT.
* 
*           3. ENTER THE STRING THAT WAS TEMPORARILY STORED INTO *T.TB* 
*              IMMEDIATELY FOLLOWING THE *O.CHAR* TOKEN INTO *T.CHAR* 
*              VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         ENTRY  (B3) = LWA+1 OF CHARACTER STRING.
* 
*                (CH=CNT)  = CHARACTER STRING COUNT.
*                (CH=TYPE) = CHARACTER STRING TYPE. 
*                (CH=TAD)  = CHARACTER STRING TOKEN ADDRESS.
* 
*                SEE DATA STRUCTURES/CH=XXX CELLS FOR MORE INFORMATION. 
* 
*         EXIT   (A6) = ADDR OF *O.CHAR* TOKEN. 
* 
*         USES   ALL
* 
*         CALLS  NCM,SFN
  
  
 EOC      SUBR               ** ENTRY/EXIT ** 
  
          SA1    LEXFLG 
          MX2    1
          LX2    LF.TDEP-59 
          BX7    -X2*X1      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          SA7    A1 
          =A1    B3-1        (A1,X1) = A+C OF LAST WORD IN STRING 
          SA2    CH=CNT 
          =X2    X2+1 
          ZR     X2,EOC10    IF EMPTY STRING
          BX2    -X2
          RJ     SFT         SPACE FILL LAST WORD OF STRING 
          SA1    CH=TAD      (X1) = ADDR OF *O.HOL* TOKEN 
          SB2    X1+B1       (B2) = FWA OF STRING 
          SX2    B3-B2       (X2) = LEN OF STRING (IN WORDS)
          SA1    X1          (A1,X1) = A+C OF *O.CHAR* TOKEN
          LX2    TB.LCONP-0 
          BX7    X1+X2       MERGE *LCON* 
          SA2    CH=CNT      (X2) = -(CHAR COUNT+1) 
          SX3    X2+B1       (X3) = -(CHAR COUNT) 
          LX3    TB.CLCNP-0 
          BX7    -X3+X7      MERGE *CLCN* 
          SA7    A1          ENTER *O.CHAR* TOKEN W/O *T.CHAR* ORD
  
*         ENTER STRING INTO *T.CHAR*. 
* 
*         ENTRY  (B2) = FWA OF STRING 
*                (B3) = LWA+1 OF STRING.
  
          SA1    =XT.CON
          SB7    B0+         SET TO *IF NOT IN TABLE, GO ENTER IT...* 
          CALL   NCM         ENTER CM INTO TABLE
  
          IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF SOMETHING IS FISHY... 
  
*         MERGE *T.CHAR* ORDINAL INTO *O.CHAR* TOKEN. 
  
          SA1    CH=TAD 
          MX7    0
          SA7    A1          SET TO *'' STRING IS COMPLETE* 
          SA1    X1          (X1) = *O.CHAR* TOKEN
          SX2    B7          (X2) = *T.CHAR* ORD
          LX2    TB.SHCP-0
          BX6    X1+X2       MERGE *SHC*
          SA6    A1+
          EQ     EXIT.
  
 EOC10    SA1    CH=TAD 
          MX7    0
          SA7    A1          STRING COMPLETE
          =X7    O.ILL
          SA2    =2L''
          BX7    X7+X2
          SA7    X1          RESET TO *ILL* 
          FATAL  E.HC1
          EQ     EXIT.
 EOH      SPACE  4,10 
**        EOH - END OF HOLLERITH STRING PROCESSING. 
* 
*         ------------
*         *HLR* STRING
*         ------------
* 
*           1. UPDATE INCOMPLETE *O.HOLL* TOKEN TO REFLECT WORD LEN 
*              AND *T.CONS* ORDINAL.
* 
*           2. FORMAT FINAL/LAST WORD OF STRING IN *HOLLSKL*. 
* 
*             A. IF -H- TYPE STRING, SPACE-FILL LAST WORD.
*             B. IF -R- TYPE STRING, RIGHT-JUSTIFY LAST WORD. 
*             C. IF -L- TYPE STRING, DONT NEED TO DO ANYTHING.
* 
*           3. ENTER THE STRING WHICH WAS TEMPORARILY STORED INTO *T.TB*
*              IMMEDIATELY FOLLOWING THE INCOMPLETE *O.HOLL* TOKEN INTO 
*              *T.CON* VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         --------- 
*         "" STRING 
*         --------- 
* 
*           1. SPACE-FILL THE FINAL/LAST WORD OF THE QUOTE STRING 
*              BECAUSE QUOTE STRINGS ARE -H- FORMAT.
* 
*           2. UPDATE THE INCOMPLETE *O.HOLL* TOKEN BY STORING THE
*              STRING LENGTHS (NR OF WORDS OCCUPIED BY THE STRING, AND
*              NR OF CHARACTERS IN THE STRING) INTO IT. 
* 
*           3. ENTER THE STRING THAT WAS TEMPORARILY STORED INTO *T.TB* 
*              IMMEDIATELY FOLLOWING THE *O.HOLL* TOKEN INTO *T.CON*
*              VIA *NCM* (ENTER CM INTO TABLE). 
* 
*         ENTRY  (B3) = LWA+1 OF HOLLERITH STRING.
* 
*                (CH=CNT)  = CHARACTER STRING COUNT.
*                (CH=TYPE) = CHARACTER STRING TYPE. 
*                (CH=TAD)  = CHARACTER STRING TOKEN ADDRESS.
* 
*                SEE DATA STRUCTURES/CH=XXX CELLS FOR MORE INFORMATION. 
* 
*         EXIT   (A6) = ADDR OF *O.HOLL* TOKEN. 
* 
*         USES   ALL
* 
*         CALLS  NCM,SFN
  
  
 EOH      SUBR               ** ENTRY/EXIT ** 
          SA3    LEXFLG 
          MX4    1
          LX4    LF.TDEP-59 
          BX6    -X4*X3      INDICATE NO TERMINAL DELIMITER ENCOUNTERED 
          SA6    A3 
          SA3    CH=TAD      (X3) = ADDR OF *O.HOLL* TOKEN
          SA4    CH=TYPE
          SB2    X3+1        (B2) = FWA OF STRING 
          SX2    B3-B2       (X2) = LEN OF STRING 
          LX2    TB.LCONP-0 
          SA3    X3          (A3,X3) = A+C OF *O.HOLL* TOKEN
          BX6    X3+X2       MERGE *LCON* 
          LX2    -TB.LCONP
          SX7    X4-CT.H
          ZR     X7,EOH2     IF *H* STRING
          SX7    X4-CT.DQT
          ZR     X7,EOH1     IF *""* STRING 
          =X3    -O.QHOLL+O.RLCON 
          IX6    X6+X3       CONVERT THE TOKEN
  
 EOH1     SA1    CH=CNT      (X1) = -(CHAR COUNT+1) 
          =X2    X1+1        (X2) = -(CHAR COUNT) 
          LX2    TB.CLCNP-0 
          BX6    -X2+X6      MERGE *CLCN* 
          LX2    -TB.CLCNP
  
 EOH2     SA6    A3+         ENTER *O.HOLL* TOKEN W/O *T.CON* ORD 
          ZR     X2,EOH10    IF EMPTY STRING
  
*         FORMAT FINAL/LAST WORD OF STRING, IF NECESSARY. 
  
          SX7    X4-CT.L
          ZR     X7,EOH3     IF -L- STRING, ENTER IT INTO *T.CON*...
          SA1    B3-B1       (A1,X1) = A+C OF LAST WORD IN STRING 
          LX6    -TB.CLCNP
          MX0    -TB.CLCNL
          BX2    -X0*X6 
          RJ     SFT         SPACE FILL LAST WORD OF STRING 
          SX1    X4-CT.H
          ZR     X1,EOH3     IF -H- STRING, ENTER IT INTO *T.CON*...
          SX1    X4-CT.DQT
          ZR     X1,EOH3     IF "" STRING, ENTER IT INTO *T.CON*... 
  
          IFEQ   TEST,ON,2
          SX1    X4-CT.R
          NZ     X1,"BLOWUP" IF NOT -R- STRING, HWUMP...
          BX6    X7*X6       (X6) = LAST WORD OF STRING, -L- FMT AGAIN
          CX7    X7          (X7) = NR OF BITS IN LAST WORD 
          SB4    X7 
          LX6    B4          (X6) = LAST WORD OF STRING, -R- FMT
          SA6    A1+
  
*         ENTER STRING INTO *T.CON*.
* 
*         ENTRY  (B2) = FWA OF STRING 
*                (B3) = LWA+1 OF STRING.
  
 EOH3     SA1    T.CON
          SB7    B0+         SET TO *IF NOT IN TABLE, GO ENTER IT...* 
          CALL   NCM         ENTER CM INTO TABLE
          IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF SOMETHING IS FISHY... 
  
*         MERGE *T.CON* ORDINAL INTO *O.HOLL* TOKEN.
  
          SA1    CH=TAD 
          MX7    0
          SA7    A1          SET TO *"" STRING IS COMPLETE* 
          SA1    X1+         (X1) = *O.HOL* TOKEN 
          SX2    B7          (X2) = *T.CON* ORD 
          LX2    TB.SHCP-0
          BX6    X1+X2       MERGE *SHC*
          SA6    A1 
          EQ     EXIT.
  
 EOH10    SA1    CH=TAD 
          =X6    O.ILL
          SA2    =2L""
          NZ     X7,EOH15    IF "" STRING 
          SA2    =7LBAD-STR 
 EOH15    BX6    X6+X2       MERGE DPC WITH TOKEN TYPE
          MX7    0
          SA7    A1          STRING COMPLETE
          SA6    X1          RESET TO *ILL* 
          FATAL  E.HC1
          EQ     EXIT.
 ILX      SPACE  4,10 
**        ILX - INITIALIZE *LEX*. 
* 
* 
*         THIS ROUTINE PERFORMS MISCELLANEOUS INITIALIZATIONS NECESSARY 
*         AT STATEMENT BOUNDARIES (I.E. RIGHT AFTER *LEX* IS CALLED). 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         USES   X - 1,2,6,7
*                A - 1,6,7
*                B - NONE 
* 
*         CALLS  SHRINK 
  
  
 ILX      SUBR               ** ENTRY/EXIT ** 
          SX6    0
          SHRINK T=TB,X6
          SA6    CH=TAD 
          SA6    TC=TBA 
          SA6    TB=1ST 
          SA6    TB=CDF 
          SA6    TB=LABL
          SA6    TB=LABR
          SA6    TB=LLP 
          SA6    TB=NUML
          SA6    TB=NUMR
          SA6    TB=PLVL
          SA6    TB=TYPE
          SA1    LEXFLG 
          CLAS=  X2,LF,(LAC)
          BX7    X1+X2       SET TO *LEX ACTIVE*
          CLAS=  X2,LF,(CHR)
          BX7    -X2*X7      CLEAR *CHR*
          CLAS=  X2,LF,(TDE)
          BX7    -X2*X7      CLEAR *TDE*
          SA7    A1 
          LX1    59-LF.HDRP 
          SA6    SB=CONT
          MI     X1,EXIT.    IF IN *HEADER DELAY* MODE
          SHRINK T=STMT,X6
          SA6    SB=LINC
          SA6    SB=LORD
          EQ     EXIT.
 LDB      SPACE  4,10 
**        LDB - LIST DEFERRED BUFFER. 
* 
* 
*         THIS ROUTINE PERFORMS THE TASK OF LISTING THE CONTENTS
*         OF *T.STMT*, WHICH CONTAINS ALL THE SOURCE LINE IMAGES
*         FOR THE CURRENT STATEMENT (I.E. INITIAL LINE AND CONTINUATION 
*         LINES, PLUS POSSIBLY IMBEDDED COMMENT LINES IN *BEFORE HEADER*
*         MODE).
* 
*         THESE LINES WERE PLACED IN *T.STMT* BY *PLR* (PROCESS LISTING 
*         REQUEST), BUT MAY OR MAY NOT HAVE BEEN ACTUALLY LISTED. 
*         WHENEVER SOMEBODY INVOLVED IN THE COMPILERS LISTING LOGIC 
*         WISHES TO ENSURE THAT A STATEMENT (EMPHASIZE *STATEMENT*) HAS 
*         BEEN LISTED, THEY CALL *LDB* TO DO THIS.  *LDB*, THEREFORE, 
*         CONSTITUTES A FOCAL POINT FOR MAKING SURE THAT A STMT DOES NOT
*         GET ACCIDENTLY LISTED TWICE, OR THREE TIMES, OR...
* 
*         EACH LINE IN *T.STMT* IS PREFIXED WITH A *LINE INFORMATION* 
*         HEADER WORD BY *PLR*, WHICH CONTAINS THE LENGTH OF THIS 
*         *T.STMT* ENTRY, THE *LINE TYPE* OF THIS LINE, AND A BIT 
*         THAT INDICATES WHETHER THIS LINE HAS ALREADY BEEN LISTED. 
*         THIS *LINE INFO* WORD IS DEFINED VIA *SB.* STRUCTURE
*         DEFINITIONS.  SEE *SB./SB=* SYMBOLS.
* 
*         NOTE THAT *LDB* DOES **NOT** CHANGE THE LENGTH OF *T.STMT*. 
*         THIS IS BECAUSE *T.STMT* IS USED FOR TOKEN GENERATION AS
*         WELL AS LISTING.
* 
*         EXAMPLE OF *T.STMT* FORMAT -- 
* 
*           FOR THE SOURCE STATEMENT BEGINNING AT LINE 10 --
*             COL 1     7 
*                       DIMENSIONS(1),
*                      , OF(2), 
*                      , THE(3),MIND(4) 
* 
*           *T.STMT* WOULD BE --
* 
* WORD        0       1         2         3         4         5 
*      LT.INIT/LEN=6  .......10.................DIMENSIONS(1),0000000000
* 
* WORD        6       7         8         9        10        11 
*      LT.CONT/LEN=6  .......11................,.OF(2),.......0000000000
* 
* WORD       12      13        14        15        16        17 
*      LT.CONT/LEN=7  .......12................,.THE(3),MIND(4).........
* 
* WORD               18 
*                     0000000000
* 
*           WHERE .=BLANK(55B),0=EOL BITS(00B)
* 
*         ENTRY  *T.STMT* PROPERLY SET UP BY *PLR* (PROCESS 
*                         LISTING REQUEST). 
*                *SB=* (STMT BUFFER) INFORMATION CELLS
*                         ALL IN ORDER. 
*                *LEXFLG/LF.LAC* INDICATING WHETHER OR NOT
*                         *LEX* IS ACTIVE.
*                *LEXFLG/LF.HDR* INDICATING WHETHER OR NOT
*                         WE ARE IN *HEADER DELAY* MODE.
* 
*                SEE *DATA STRUCTURES/SB= AND LEXFLG*.
* 
*         EXIT   *LEXFLG/LF.HDR* CLEARED TO *NOT HEADER DELAY*
* 
*         USES   ALL BUT A0,A5,X5  (INCLUDES ALL CALLS) 
* 
*         CALLS  LSL,SHRINK 
  
  
 LDB      SUBR   =           ** ENTRY/EXIT ** 
          SA1    T.STMT 
          SA2    SB=LINC     (X2) = NR OF LINES IN *T.STMT* 
  
 .T       IFEQ   TEST,ON
          SA3    T=STMT 
          SA4    SB=LORD
          IX6    X3-X4
          MI     X6,"BLOWUP" IF LINE ORDINAL .GT. STMT BUFFER LEN 
          NZ     X3,LDB1     IF STMT BUFFER NOT EMPTY 
          NZ     X2,"BLOWUP" IF LINE COUNT CONFLICT 
  
 LDB1     BSS    0
 .T       ENDIF 
  
          SB4    X1 
          BX6    X2 
          SA6    LDBA        INITIALIZE LOCAL LINE COUNTER
  
 LDB2     SA2    LDBA        (X2) = NR OF LINES REMAINING IN *T.STMT* 
          SA3    B4          (A3,X3) = A+C OF *LINE INFO* HEADER WORD 
          MX7    1
          ZR     X2,LDB3     IF FINISHED LISTING *T.STMT* 
  
          IFEQ   TEST,ON,1
          MI     X2,"BLOWUP" IF SOMETHING TERRIBLE HAS HAPPENED...
          LX3    0-SB.LENP
          SX4    X3          (X4) = NR OF WORDS IN THIS LINE
          LX3    59-SB.LOUTP+SB.LENP-0
  
*         USE SB.LERR IF LISTING TO E-FILE. 
  
          ERRNZ  SB.LOUTP-SB.LERRP-1
          SA1    =XWOF=ERR   LIST TO E-FILE FLAG
          SB6    X1 
          LX3    B6 
          SX1    B4+B1       (X1) = FWA OF LISTABLE LINE
          SX6    X2-1 
          BX7    X3+X7       SET TO *THIS LINE HAS BEEN LISTED* 
          SB6    -B6
          SB6    60+B6
          LX7    B6          RESTORE WORD 
          SA6    A2 
          SB4    B4+X4       (B4) = ADDR OF NEXT *LINE INFO* WORD 
          LX7    SB.LOUTP-59
          SA7    A3 
          MI     X3,LDB2     IF THIS LINE ALREADY LISTED
          SX4    X4-2        LENGTH FOR LSL 
          RJ     LSL         LIST SOURCE LINE 
          EQ     LDB2 
  
 LDB3     SA1    LEXFLG 
          MX2    1
          LX2    LF.HDRP-59 
          BX7    -X2*X1      CLEAR *HDR*
          SA7    A1+
          EQ     EXIT.
  
  
 LDBA     BSSZ   1           CONTAINS LOCAL COUNT OF REMAINING LINES
*                            IN *T.STMT*. 
 LSL      SPACE  4,10 
**        LSL -  LIST SOURCE LINE.
* 
*         IF INPUT IS UNCOMPRESSED, WILL PRINT FROM WHEREVER THE CARD 
*         CURRENTLY RESIDES.
* 
*         ENTRY  (X1)+2  =  FWA AREA TO FIND CARD.
*                (X4)= LENGTH OF LINE 
*                (AMODE) = INPUT FORMAT.
*                LINE IMAGE IS IN (AMODE) FORMAT. 
* 
*         EXIT   (B6) = LWA + 1 THAT WAS LISTED.
* 
*         USES   ALL BUT  A0,A5  B4  X0,X5. 
  
  
 LSL      SUBR   =           ** ENTRY/EXIT ** 
          SA2    WOF=ERR
          SA3    CO.PW+X2    FLAG FOR PW MODE ON THIS FILE (E OR L) 
          SX3    X3-126 
          SX2    X4          LINE LENGTH
          SX6    B4 
          SA4    =10H 
          SA6    LSLA        SAVE (B4)
          PL     X3,LSL6     IF NOT PW MODE 
          =B2    X1+1        FWA OF LINE (PAST LINE NUMBER) 
          SB3    B0 
          SB6    B2+B1
  
 LSL2     SA2    B2+B3       (X2) = NEXT WORD OF LINE 
          SB3    B3+B1
          IX6    X2-X4
          ZR     X6,LSL2     IF BLANK WORD
          ZR     X2,LSL3     IF EOL 
          SB6    A2+B1
          EQ     LSL2 
  
 LSL3     =X2    B2+1        FWA
          SX3    PWBUF+1     DESTINATION
          SB5    B6-B2       LENGTH 
          =X1    B5-1        COUNT FOR MOVE (LESS NEW LINE NUMBER)
          SA4    B2-1        LINE NUMBER
          BX6    X4 
          SA6    PWBUF       TO LIST BUFFER 
          IX4    X1+X3
          SB6    X4          1 BEYOND LAST WORD IN BUFFER 
          MOVE   X1,X2,X3    LINE TO PWBUF
          SA3    WOF=ERR
          SA3    CO.WPL+X3   GET WIDTH CONTROL WORD 
          SX1    PWBUF
          SB2    PWBUF
          SX2    B5 
          SB7    B5 
  
 LSL4     SB5    X3+B1       PAGE WIDTH IN WORDS + 1
          SB3    B7-B5
          LT     B3,LSL5     IF LINE LENGTH .LE. PAGE WIDTH 
          SA2    B2+X3
          AX3    30          REMAINDER OF PAGE WIDTH MOD 10 IN BITS 
          SB5    X3 
          SB2    B2-B1
          SB6    B6-B1
          RJ     BLL         BREAK LONG LINE
          SA3    WOF=ERR
          SA3    CO.WPL+X3   GET WIDTH CONTROL WORD 
          SB2    X1          FWA OF LINE
          SB7    X2-1        LENGTH - 1 OF LINE 
          SB6    X1+B7       LWA OF LINE
          NZ     X6,LSL4     IF STILL POSSIBLE LONG LINE
  
 LSL5     PLINE  X1,X2
          SA1    LSLA 
          SB4    X1          RESTORE (B4) 
          EQ     EXIT.
  
 LSL6     LX6    X4 
          =A6    X1+1 
          PLINE  X1,X2
          SA1    LSLA 
          SB4    X1          RESTORE (B4) 
          EQ     EXIT.
  
 LSLA     BSS    1           (B4) SAVE
 LSS      SPACE  4
**         LSS - LEFT SHIFT STRING
* 
*                SHIFTS A STRING OF GIVEN LENGTH UP TO 10 CHARACTERS
*                LEFT END AROUND. 
* 
*         ENTRY  (X1) = MASK OF SHIFT COUNT 
*                (X2) = FIRST WORD OF STRING
*                (X3) = WORD OF BLANKS
*                (A2) = FWA OF STRING 
*                (B5) = SHIFT COUNT 
*                (B6) = LWA OF STRING - 1 
*         EXIT   (X6) = NEW FIRST WORD OF STRING
*                STRING SHIFTED.
* 
*         USES   B3, B7 
*                X1, X2, X3, X4, X6 
*                A4, A6 
*         PRESERVES          A0, A2, A5, A7, X5, X7, B2, B4, B5, B6 
* 
  
 LSS      SUBR   =           ENTRY/EXIT...
          BX6    X2 
          ZR     B5,EXIT.    IF NO SHIFT NEEDED 
          SB7    A2 
          SB3    B6 
          BX3    X1*X3
 LSS10    SA4    B3 
          BX2    X1*X4
          BX4    -X1*X4 
          BX6    X3+X4
          LX6    B5 
          SA6    A4 
          SB3    B3-B1
          BX3    X2 
          GE     B3,B7,LSS10 IF SHIFT NOT FINISHED
          EQ     EXIT.
 SFT      SPACE  4,8
**        SFT - SPACE FILL LAST WORD OF STRING TOKEN. 
* 
*         ENTRY  (A1, X1) - LAST WORD OF STRING.
*                (X2) - STRING COUNT. 
* 
*         EXIT   (X6) = BLANK-FILLED WORD.
*                (X7) = CHARACTER MASK. 
* 
*         USES   A2-3,6.  X0,2-3,6-7.  B4.
  
  
 SFT      SUBR
          MX7    60 
          BX6    X1 
          WX3    X2,X0       GET REMAINDER
          ZR     X0,EXIT.    IF NO PARTIAL WORD 
          SA2    =1H
          LX6    B1,X0
          MX7    1
          LX0    B1,X6
          IX6    X6+X0       6 * REMAINDER
          SB4    X6-1 
          AX7    B4,X7       CONSTRUCT MASK 
          BX0    -X7*X2 
          BX6    X0+X1       BLANK FILL 
          SA6    A1 
          EQ     EXIT.
 TTB      SPACE  4,8
**        TTB - TERMINATE TOKEN BUFFER. 
* 
* 
*         CALLED TO SHRINK TOKEN BUFFER OF STRAY CHARACTERS FROM
*         UNTERMINATED CHARACTER/HOLLERITH CONSTANT 
* 
*         ENTRY  (A6) - POINTS TO LAST TOKEN (O.ILL)
  
 TTB      SUBR
          SA1    T.TB 
          =X6    O.EOS
          =A6    A6+1        TERMINATE T.TB 
          =X2    A6+1 
          IX6    X2-X1
          SHRINK T=TB,X6
          EQ     EXIT.
 XER      SPACE  4,10 
**        XER - EXTRACT AND RESTORE ENTOKENING REGISTERS. 
* 
* 
*         THIS ROUTINE EXTRACTS THE SAVED ENTOKENING REGISTER 
*         INFORMATION FROM A DESIGNATED *T.STMT* LINE INFORMATION 
*         HEADER, RESETS THE *COMCTOK* ENTOKENING REGISTERS 
*         ACCORDINGLY.
* 
*         SEE *DATA STRUCTURES/LN=FEN* FOR DETAILS. 
* 
*         ENTRY  (X1) = ORD IN *T.STMT* OF STMT TO RESTORE FOR. 
* 
*         EXIT   (B6) = NR OF BITS REMAINING IN (X5). 
*                (B7) = NR OF BITS REMAINING IN SOURCE LINE.
*                (A5) = ADDR OF WORD CONTAINING 1ST ENTOKENABLE . 
*                       CHARACTER.
*                (X5) = WORD CONTAINING 1ST ENTOKENABLE CHARACTER,
*                       1ST CHARACTER TO ENTOKEN LEFT-SHIFTED TO
*                      LEFT-MOST CHARACTER POSITION (BITS 59-54). 
*                (X4) = .MI. TO INDICATE *NO USEABLE CHARACTER*,
*                            I.E. NEED TO EXTRACT A CHARACTER FROM (X5).
* 
*         USES   X - 1,2,3,4,5,7
*                A - 1,2,5
*                B - 4,5,6,7
* 
*         LOCKED (A6,X6),(B3),(A0)
* 
*         CALLS  NONE 
  
  
 XER      SUBR               ** ENTRY/EXIT ** 
          SA2    T.STMT 
          MX3    -SB.FENBL
          MX4    -SB.FENLL
          IX7    X2+X1       (X7) = ADDR OF *LINE INFO HEADER*
          SA1    X7          (X1) = LINE INFORMATION HEADER 
          LX1    0-SB.FENBP 
          BX7    -X3*X1      EXTRACT *FENB* 
          SB6    X7          RESTORE (B6) 
          LX1    0-SB.FENLP+SB.FENBP-0
          BX7    -X4*X1      EXTRACT *FENL* 
          SB7    X7          RESTORE (B7) 
          LX1    0-SB.FENP+SB.FENLP-0 
          MX3    -SB.FENL 
          BX7    -X3*X1      EXTRACT *FEN*
          SB5    X7          (B5) = ORD OF WORD CONTAINING 1ST ENTKNABLE
          SA5    X2+B5       (A5,X5) = A+C OF 1ST WORD TO ENTOKEN 
          SB4    60D
          SB5    B4-B6       (B5) = LEFT-SHIFT COUNT FOR (X5) 
  
          IFEQ   TEST,ON,2
          LE     B6,B0,"BLOWUP" IF (B6) IS TOO SMALL
          MI     B5,"BLOWUP"    IF (B6) IS TOO BIG
  
          LX5    B5 
          MX4    -1          SET TO *NO USEABLE CHAR IN (X4)* 
          EQ     EXIT.
 LEX      SPACE  4,10 
          LIST   D
          END 
