         TITLE    'CS-B00,08/22/73,DWG702985'                                   
         SYSTEM   SIG7F                                                         
         CSECT    1                                                             
         PCC      0                 CONTROL CARDS NOT PRINTED.                  
CS@      RES      0                 ORIGIN OF CODESTRINGER MODULE.              
*                                                                               
*  REF'S  AND  DEF'S                                                            
*                                                                               
         DEF      CS@               = START OF CS MODULE.                       
         DEF      CS1               ENTER TO CODESTRING ALL OF IMAGE.           
         DEF      CSN               ENTER TO CODESTRING PART OF IMAGE.          
         DEF      CSZ               ENTER TO FINISH CODESTRING.                 
         DEF      ERLSCAN           ENTER TO PRODUCE LINE-SCAN ERROR.           
         DEF      RESXTEND          RESUME AFTER CALLING INPXTEND.              
 SPACE 3                                                                        
*                               REFS TO PROCEDURE:                              
         REF      GIVEBACK          TO GIVE BACK UNUSED WDS OF DATA BLK.        
         REF      CMDREC            COMMAND RECOGNIZER.                         
         REF      DELCK             ON DEL, GO TO FUNDEF MODULE FOR CKS.        
         REF      LSCANERR          LINE-SCAN ERROR ROUTINE.                    
         REF      ERXEQ             LINE-SCAN ERR ATTEMPTING 'EXECUTE'.         
         REF      CSERRH            HANDLE CODESTRING ERROR.                    
         REF      DREF              DE-REFERENCES BAD CODESTRING BLK.           
         REF      ACQNXCC           ACQUIRE NEXT CHAR AND ITS CODE.             
         REF      ACQNB             ACQUIRE NON-BLANK CHAR AND ITS CODE.        
         REF      ACQNXNB           ACQ NEXT NON-BLANK & ITS CODE.              
         REF      ACQCONST          TRIES TO ACQUIRE A CONSTANT.                
         REF      ACQNAME           ACQUIRES A NAME.                            
         REF      ALOCNONX          ALLOCS DATA BLK, HEADER + N WDS.            
         REF      GARBCOLL          GARBAGE COLLECTOR.                          
         REF      BCONTOFF          EXIT IN CASE OF HANG-UP DURING              
         REF      INPXTEND            INPUT FOR LINE EXTENSION.                 
 SPACE 2                                                                        
*                               REFS TO CONTEXT:                                
         REF      LINKCS            LINKAGE TO CODESTRINGER.                    
         REF      MODE              INPUT MODE.                                 
         REF      CURRCS            CODESTRING DATA BLOCK PTR (HDR+2).          
         REF      STATEPTR          PTS AT TOP STATE-ENTRY IN STACK.            
         REF      IMAGE             INTERNAL CHAR IMAGE OF INPUT LINE.          
         REF      BREAKFLG          SET NEG. IF HANG-UP OCCURS.                 
         REF      ERRCOL            BYTE ADDR.OF ERR DETECTION COLUMN.          
         REF      HICOL             BYTE ADDR.OF NEWLINE'S COL. IN IMAGE        
         REF      OFFSETK           PTR TO CODE DESIG BEFORE CONSTANT.          
         REF      OFFSET            PTR TO CODE DESIG (USUALLY LATEST).         
         REF      CONSTKEY          BYTE ADDR.OF 1ST CHAR OF CONSTANT.          
         REF      CONSTBUF          CONSTANT BUFFER.                            
         REF      CONSTTYP          TYPE OF CONSTANT.                           
         REF      QCNT              ODD IF 1ST IMAGE HAS UNBALANCED 'S.         
         REF      FREETBL           PTS AT 1ST FREE LOC FOR NEW DATA BLK        
         REF      BLKWANTD          ACTUAL SIZE ALLOCATED FOR LATEST DB.        
         REF      SYMT              PTS AT 1ST WD OF SYMBOL TABLE.              
         REF      SYMTSIZE          NO.OF SYMBOL TABLE ENTRIES.                 
 SPACE                                                                          
*                               REFS TO CONSTANTS:                              
         REF      X1FFFF            X'1FFFF'                                    
         REF      F0F9              '0','9'                                     
         REF      NONAME            10,138  = CODE DESIGS NOT NAME-CHARS        
 SPACE                          REFS TO ERROR I.D. EQU'S:                       
*                                                                               
 SPACE                                                                          
         REF      IDSYMFUL          SYM TBL FULL.                               
         REF      IDWSFULL          WS FULL.                                    
*                                                                               
*  STANDARD EQU'S                                                               
*                    REGISTERS                                                  
R1       EQU      1                                                             
R2       EQU      2                                                             
R3       EQU      3                                                             
R4       EQU      4                                                             
R5       EQU      5                                                             
R6       EQU      6                                                             
R7       EQU      7                                                             
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
*                                                                               
*  CODESTRING DESIGNATORS                                                       
*                                                                               
BYNCODE  EQU      10                BYTE-FORM INTEGER SCALAR (10 - 255).        
INTGCODE EQU      11                WORD-FORM INTEGER SCALAR.                   
REALCODE EQU      12                REAL SCALAR.                                
TEXTCODE EQU      13                TEXT SCALAR.                                
VLCODE   EQU      14                LOGICAL VECTOR.                             
VICODE   EQU      15                INTEGER VECTOR.                             
VRCODE   EQU      16                REAL VECTOR.                                
VTXCODE  EQU      17                TEXT VECTOR.                                
VTXLCODE EQU      18                LONG TEXT VECTOR (EXCEEDS 255 CHARS)        
ERRCODE  EQU      19                ERROR.                                      
LAMPCODE EQU      20                COMMENT                                     
NAMECODE EQU      23                NAME (BUT NOT STOP OR TRACE NAME).          
BOSCODE  EQU      37                BEGINNING-OF-STMT.                          
MONADIC  EQU      50                1ST MONADIC OPERATOR.                       
DOMCODE  EQU      80                DOMINO OPERATOR.                            
DYADIC   EQU      DOMCODE           1ST DYADIC OPERATOR.                        
BANGCODE EQU      101               EXCLAMATION POINT OPERATOR.                 
COLNCODE EQU      135               COLON.                                      
DMYCODE  EQU      138               DUMMY.                                      
*                                                                               
*  OTHER EQU'S                                                                  
*                                                                               
NEWLINE  EQU      X'15'             END MARK.                                   
EFLAG    EQU      X'10000'          'EXECUTE' FLAG FOR QUAD-STATE.              
TYPECS   EQU      7                 CODESTRING TYPE OF DATA BLOCK.              
*                                                                               
*  DOUBLEWORD CONSTANTS                                                         
*                                                                               
         BOUND    8                                                             
ZEROONE  DATA     0,1                                                           
ZERONINE DATA     0,9                                                           
POSSMON  DATA     DOMCODE,BANGCODE  CODESTR.OPS CONVERTIBLE TO MONADICS.        
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* EASY AND SPECIAL DEFINITIONS FOR CODESTRINGING.                      *        
*                                                                      *        
*        THESE DEFINE A VALUE FOR EACH 'IN2CODE' CHARACTER IN THE      *        
*          RANGE BETWEEN -- COMMENT (LAMP) AND COLON.                  *        
*        THE VALUES ARE ORDERED AND ARE ASSOCIATED WITH:               *        
*                 LC4TBL -- LEFT CONTEXT ASSIGNMENTS                   *        
*                 ITEMCNTX -- SCAN ITEM CONTEXT (FOR CONTACT ANALYSIS) *        
*                 CSV -- A VECTORED TABLE WITHIN THE CODESTRING        *        
*                        ROUTINE.                                      *        
*                                                                      *        
EASY     EQU      0                 EASILY HANDLED SCAN ITEMS                   
QUADS    EQU      EASY                                                          
SEMICOLN EQU      QUADS+1                                                       
LBRACKET EQU      SEMICOLN+1                                                    
RBRACKET EQU      LBRACKET+1                                                    
LPAREN   EQU      RBRACKET+1                                                    
RPAREN   EQU      LPAREN+1                                                      
BRANCH   EQU      RPAREN+1                                                      
ASSIGN   EQU      BRANCH+1                                                      
SMCIRCLE EQU      ASSIGN+1                                                      
SPECIAL  EQU      SMCIRCLE+1        SPECIALLY HANDLED SCAN ITEMS                
BLANK    EQU      SPECIAL                                                       
DEL      EQU      BLANK+1                                                       
NEGATIVE EQU      DEL+1                                                         
QUOTE    EQU      NEGATIVE+1                                                    
COMMENT  EQU      QUOTE+1                                                       
ENDMARK  EQU      COMMENT+1                                                     
DOT      EQU      ENDMARK+1                                                     
COP      EQU      DOT+1             (OP MAY TAKE COORDINATE SPECIFICTN.)        
OP       EQU      COP+1                                                         
BAD      EQU      OP+1              BAD SCAN ITEMS                              
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* SCANITEM -- A TABLE OF BYTES.  THERE IS A BYTE CORRESPONDING TO      *        
*        EACH 'IN2CODE' CHARACTER VALUE BETWEEN COMMENT (LAMP) AND     *        
*        COLON.  IT IS CONSIDERED IMPOSSIBLE TO OBTAIN SCAN ITEMS      *        
*        OUTSIDE THIS RANGE (DIGITS AND NAME-START CHARS ARE DEALT     *        
*        WITH SEPARATELY).  NOT ALL VALUES WITHIN THIS RANGE ARE       *        
*        POSSIBLE EITHER--SUCH ENTRIES ARE MARKED WITH AN ASTERISK     *        
*        IN THE COMMENTS FIELD.                                        *        
*        THE VALUE CONTAINED IN EACH BYTE OF THE TABLE IS DEFINED      *        
*        BY THE EASY AND SPECIAL DEFINITIONS ABOVE.                    *        
*                                                                      *        
*                           HEX OF                                     *        
*                 VALUE     INTERNAL    INTERNAL CHARACTER             *        
*                             FORM                                     *        
*                 --------     ---  ---------------------------------- *        
*                                                                      *        
SCANITEM DATA,1   COMMENT     @ 20  COMMENT (LAMP)                              
         DATA,1   BAD         @ 21  *                                           
         DATA,1   BAD         @ 22  *                                           
         DATA,1   BAD         @ 23  *                                           
         DATA,1   BAD         @ 24  UNUSED                                      
         DATA,1   QUADS       @ 25  QUAD+0                                      
         DATA,1   QUADS       @ 26  QUAD-1                                      
         DATA,1   QUADS       @ 27  QUAD-2                                      
         DATA,1   QUADS       @ 28  QUAD-3                                      
         DATA,1   QUADS       @ 29  QUAD-4                                      
         DATA,1   QUADS       @ 30  QUAD-5                                      
         DATA,1   QUADS       @ 31  QUAD-6                                      
         DATA,1   QUADS       @ 32  QUAD-7                                      
         DATA,1   QUADS       @ 33  QUAD-8                                      
         DATA,1   QUADS       @ 34  QUAD-9                                      
         DATA,1   QUADS       @ 35  QUAD                                        
         DATA,1   QUADS       @ 36  QUOTE-QUAD                                  
         DATA,1   BAD         @ 37  *                                           
         DATA,1   SEMICOLN    @ 38  SEMICOLON                                   
         DATA,1   LBRACKET    @ 39  LEFT BRACKET                                
         DATA,1   RBRACKET    @ 40  RIGHT BRACKET                               
         DATA,1   LPAREN      @ 41  LEFT PAREN                                  
         DATA,1   RPAREN      @ 42  RIGHT PAREN                                 
         DATA,1   BRANCH      @ 43  BRANCH ARROW                                
         DATA,1   ASSIGN      @ 44  ASSIGN ARROW                                
         DATA,1   DOT         @ 45  DOT OR DECIMAL PT                           
         DATA,1   SMCIRCLE    @ 46  SMALL CIRCLE                                
         DATA,1   BAD         @ 47  UNUSED                                      
         DATA,1   BAD         @ 48  UNUSED                                      
         DATA,1   BAD         @ 49  UNUSED                                      
         DATA,1   ENDMARK     @ 50  END-OF-INPUT       (KEY CHAR)               
         DATA,1   BLANK       @ 51  BLANK              (KEY CHAR)               
         DATA,1   QUOTE       @ 52  QUOTE              (KEY CHAR)               
         DATA,1   BAD         @ 53  *                                           
         DATA,1   BAD         @ 54  *                                           
         DATA,1   BAD         @ 55  *                                           
         DATA,1   BAD         @ 56  *                                           
         DATA,1   BAD         @ 57  *                                           
         DATA,1   BAD         @ 58  *                                           
         DATA,1   BAD         @ 59  *                                           
         DATA,1   BAD         @ 60  *                                           
         DATA,1   BAD         @ 61  *                                           
         DATA,1   BAD         @ 62  *                                           
         DATA,1   BAD         @ 63  *                                           
         DATA,1   BAD         @ 64  *                                           
         DATA,1   BAD         @ 65  *                                           
         DATA,1   BAD         @ 66  *                                           
         DATA,1   BAD         @ 67  *                                           
         DATA,1   BAD         @ 68  *                                           
         DATA,1   BAD         @ 69  *                                           
         DATA,1   BAD         @ 70  *                                           
         DATA,1   BAD         @ 71  BAD CHAR           (KEY CHAR)               
         DATA,1   BAD         @ 72  UNUSED                                      
         DATA,1   BAD         @ 73  UNUSED                                      
         DATA,1   OP          @ 74  I-BEAM                                      
         DATA,1   OP          @ 75  GRADE-UP                                    
         DATA,1   OP          @ 76  GRADE-DOWN                                  
         DATA,1   OP          @ 77  NOT                                         
         DATA,1   OP          @ 78  UNUSED                                      
         DATA,1   OP          @ 79  UNUSED                                      
         DATA,1   OP          @ 80  MATRIX-DIVIDE                               
         DATA,1   OP          @ 81  ROLL OR DEAL                                
         DATA,1   OP          @ 82  T-BAR                                       
         DATA,1   OP          @ 83  COMPRESS OR REDUCE ON 1ST COORD             
         DATA,1   COP         @ 84  COMPRESS OR REDUCE                          
         DATA,1   OP          @ 85  IOTA                                        
         DATA,1   OP          @ 96  RHO                                         
         DATA,1   COP         @ 87  COMMA                                       
         DATA,1   OP          @ 88  REVERSE OR ROTATE ON 1ST COORD              
         DATA,1   COP         @ 89  REVERSE OR ROTATE                           
         DATA,1   OP          @ 90  TRANSPOSE                                   
         DATA,1   OP          @ 91  PLUS                                        
         DATA,1   OP          @ 92  MINUS                                       
         DATA,1   OP          @ 93  TIMES                                       
         DATA,1   OP          @ 94  DIVIDE                                      
         DATA,1   OP          @ 95  EXPONENT                                    
         DATA,1   OP          @ 96  LOG                                         
         DATA,1   OP          @ 97  CIRCLE                                      
         DATA,1   OP          @ 98  MAX OR CEILING                              
         DATA,1   OP          @ 99  MIN OR FLOOR                                
         DATA,1   OP          @100  ABSOLUTE OR RESIDUE                         
         DATA,1   OP          @101  EXCLAMATION PT                              
         DATA,1   OP          @102  LESS THAN                                   
         DATA,1   OP          @103  LESS THAN OR EQUAL                          
         DATA,1   OP          @104  GREATER THAN                                
         DATA,1   OP          @105  GREATER THAN OR EQUAL                       
         DATA,1   OP          @106  NOT EQUAL                                   
         DATA,1   OP          @107  EQUAL                                       
         DATA,1   OP          @108  AND                                         
         DATA,1   OP          @109  OR                                          
         DATA,1   OP          @110  NAND                                        
         DATA,1   OP          @111  NOR                                         
         DATA,1   OP          @112  UNUSED                                      
         DATA,1   OP          @113  UNUSED                                      
         DATA,1   OP          @114  DECODE                                      
         DATA,1   OP          @115  ENCODE                                      
         DATA,1   OP          @116  TAKE                                        
         DATA,1   OP          @117  DROP                                        
         DATA,1   OP          @118  EXPAND ON 1ST COORD                         
         DATA,1   COP         @119  EXPAND                                      
         DATA,1   OP          @120  EPSILON                                     
         DATA,1   BAD         @121  UNUSED                                      
         DATA,1   BAD         @122  UNUSED                                      
         DATA,1   BAD         @123  DIERESIS                                    
         DATA,1   NEGATIVE    @124  NEGATIVE SIGN                               
         DATA,1   BAD         @125  UNDERSCORE                                  
         DATA,1   BAD         @126  DOLLAR SIGN                                 
         DATA,1   BAD         @127  ALPHA                                       
         DATA,1   BAD         @128  OMEGA                                       
         DATA,1   DEL         @129  DEL                                         
         DATA,1   DEL         @130  LOCKED DEL                                  
         DATA,1   BAD         @131  LEFT CUP                                    
         DATA,1   BAD         @132  RIGHT CUP                                   
         DATA,1   BAD         @133  CAP                                         
         DATA,1   BAD         @134  CUP                                         
         DATA,1   BAD         @135  COLON                                       
*                                                                               
         BOUND    4                 INSURE WORD BOUNDARY AFTER SCANITEM         
*                                                                               
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* LCBITS -- LEFT CONTEXT BITS.  EACH ENTRY SIGNIFIES A LEFT CONTEXT    *        
*        ASSOCIATED WITH AN ITEM DESCRIBED IN THE COMMENTS FIELD.      *        
*        BIT ENTRY (FOR M -- WHICH MUST BE MOST SIGNIFICANT).          *        
*                                                                      *        
*        NOTE -- IT IS ESSENTIAL THAT NO LEFT CONTEXT BIT REACH        *        
*                BIT POSITION 16.                                      *        
LCBITS   EQU      1                 LEFT CONTEXT BIT SETTINGS                   
D        EQU      LCBITS            DOT                                         
B        EQU      D**1              BRANCH                                      
A        EQU      B**1              ASSIGN                                      
RO       EQU      A**1              RPAREN OR SMALL CIRCLE                      
LB       EQU      RO**1             LBRACKET                                    
RB       EQU      LB**1             RBRACKET                                    
ZC       EQU      RB**1             ENDMARK OR COMMENT                          
S        EQU      ZC**1             SEMICOLN                                    
LQ       EQU      S**1              LPAREN OR QUADS                             
CN       EQU      LQ**1             CONSTANT OR NAME                            
O        EQU      CN**1             OPERATOR                                    
M        EQU      O**1              MONADIC IMPLIED (M MUST HAVE THE            
*                                     HIGHEST BIT SETTING)                      
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* 'LC4' DEFINITIONS                                                    *        
*        DEFINES A LEFT CONTEXT FOR ITEMS DESCRIBED IN THE COMMENTS    *        
*        FIELD.                                                        *        
*                                                                      *        
*        THE PRESENCE OF A PARTICULAR BIT INDICATES THAT LEFT CONTEXT  *        
*        IS CORRECT FOR A SCAN ITEM (SEE ALSO 'ITEM' DEFINITIONS,      *        
*        BELOW) HAVING MATCHING BIT SET.                               *        
*                                                                      *        
*        THE M BIT POSITION IMPLIES THAT THE SCAN ITEM IS A MONADIC    *        
*        OPERATOR IF IT HAPPENS TO BE AN OPERATOR AT ALL.              *        
*                                                                      *        
LC4STNAM EQU      A                              STOPNAME OR TRACENAME          
LC4NAME  EQU      O+CN+LQ+S+ZC+RB+LB+RO+A        ORDINARY NAME                  
LC4RB    EQU      O+CN+LQ+S+ZC+RB+LB+RO+A        RIGHT BRACKET                  
LC4QUADS EQU      O+CN+S+ZC+RB+LB+RO+A           QUADS                          
LC4CONST EQU      O+CN+S+ZC+RB+LB+RO             CONSTANT                       
LC4RP    EQU      O+CN+S+ZC+RB+LB+RO             RIGHT PAREN                    
LC4SEMI  EQU      M+O+CN+LQ+S+ZC+RB+B            SEMICOLON                      
LC4BOS   EQU      M+O+CN+LQ+S+ZC+B               BEGINNING-OF-STMT              
LC4BRNCH EQU      M+O+CN+LQ+S+ZC                 BRANCH                         
LC4LB    EQU      M+O+CN+LQ+S+RB                 LEFT BRACKET                   
LC4COP   EQU      M+O+CN+LQ+LB                   COORDINATIBLE OPERATOR         
LC4OP    EQU      M+O+CN+LQ+D                    OPERATOR                       
LC4ASS   EQU      M+O+CN+LQ                      ASSIGN                         
LC4LP    EQU      M+O+CN+LQ                      LEFT PAREN                     
LC4DOT   EQU      O                              DOT (NOT DEC.PT.)              
LC4SMCRC EQU      D                              SMALL CIRCLE                   
LC4ALL   EQU      X'7FFF'           BAD CHAR (ALL SCAN ITEMS ACCEPTED)          
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* LC4TBL -- ORDERED TABLE OF HALFWORDS USED TO ASSIGN A LEFT CONTEXT   *        
*        SETTING FOR THE ITEM DESCRIBED IN THE COMMENTS FIELD.         *        
*        (SEE 'EASY' AND 'SPECIAL' DEFINITIONS FOR ASSOCIATION OF      *        
*        THE CHOSEN ORDERING.)                                         *        
*                                                                      *        
LC4TBL   DATA,2   LC4QUADS        @ QUADS                                       
         DATA,2   LC4SEMI         @ SEMICOLON                                   
         DATA,2   LC4LB           @ LEFT BRACKET                                
         DATA,2   LC4RB           @ RIGHT BRACKET                               
         DATA,2   LC4LP           @ LEFT PAREN                                  
         DATA,2   LC4RP           @ RIGHT PAREN                                 
         DATA,2   LC4BRNCH        @ BRANCH                                      
         DATA,2   LC4ASS          @ ASSIGN                                      
         DATA,2   LC4SMCRC        @ SMALL CIRCLE                                
         DATA,2   0               @ (BLANK DOESN'T AFFECT LEFT CONTEXT)         
         DATA,2   0               @ DEL (SHOULD OPEN OR CLOSE FUNCTION)         
         DATA,2   0               @ NEGATIVE SIGN (CONTEXT SET SPECIAL)         
         DATA,2   LC4CONST        @ QUOTE (I.E. TEXT CONSTANT)                  
         DATA,2   ITEMEND         @ COMMENT (ENDMARK GUARANTEED NEXT)           
         DATA,2   LC4ALL          @ (ENDMARK DOESN'T HAVE LEFT CONTEXT)         
         DATA,2   LC4DOT          @ DOT                                         
         DATA,2   LC4COP          @ COP                                         
         DATA,2   LC4OP           @ OP                                          
*                                                                               
         BOUND    4                 INSURE WORD BOUNDARY AFTER LC4TBL           
*                                                                               
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* 'ITEM' DEFINITIONS                                                   *        
*        DEFINES A CURRENT CONTEXT FOR A SCAN ITEM DESCRIBED IN THE    *        
*        COMMENTS FIELD.                                               *        
*                                                                      *        
*        THE SCAN ITEM IS IN PROPER CONTEXT (I.E. CONTACT ANALYSIS     *        
*        FOR CODESTRINGING) IF A MATCHING BIT OCCURS IN THE LEFT       *        
*        CONTEXT SETTING MOST RECENTLY ESTABLISHED.                    *        
*                                                                      *        
*        THE M BIT POSITION IS USED TO DETERMINE IF LEFT CONTEXT       *        
*        IMPLIES THAT AN OPERATOR (ITEMOPER) IS MONADIC.               *        
*                                                                      *        
ITEMOPER EQU      M+O               ANY OPERATOR                                
ITEMCNST EQU      CN                CONSTANT                                    
ITEMNAME EQU      CN                NAME                                        
ITEMQUAD EQU      LQ                QUADS                                       
ITEMLP   EQU      LQ                LEFT PAREN                                  
ITEMSEMI EQU      S                 SEMICOLON                                   
ITEMEND  EQU      ZC                END-OF-INPUT                                
ITEMLAMP EQU      ZC                COMMENT                                     
ITEMRB   EQU      RB                RIGHT BRACKET                               
ITEMLB   EQU      LB                LEFT BRACKET                                
ITEMSMCR EQU      RO                SMALL CIRCLE                                
ITEMRP   EQU      RO                RIGHT PAREN                                 
ITEMASS  EQU      A                 ASSIGN                                      
ITEMBRCH EQU      B                 BRANCH                                      
ITEMDOT  EQU      D                 DOT                                         
ITEMBAD  EQU      0                 BAD CHAR (NO LEFT CONTEXT MATTERS)          
ITEMDEL  EQU      ZC                DEL                                         
ITEMBLNK EQU      X'7FFF'           BLANK (ANY LEFT CONTEXT IS OK)              
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* ITEMCNTX -- ORDERED TABLE OF HALFWORDS USED TO ESTABLISH CURRENT     *        
*        CONTEXT FOR A SCAN ITEM DESCRIBED IN THE COMMENTS FIELD.      *        
*        (SEE 'EASY' AND 'SPECIAL' DEFINITIONS FOR ASSOCIATION OF      *        
*        THE CHOSEN ORDERING.)                                         *        
*                                                                      *        
ITEMCNTX DATA,2   ITEMQUAD          QUADS                            @          
         DATA,2   ITEMSEMI          SEMICOLON                        @          
         DATA,2   ITEMLB            LEFT BRACKET                     @          
         DATA,2   ITEMRB            RIGHT BRACKET                    @          
         DATA,2   ITEMLP            LEFT PAREN                       @          
         DATA,2   ITEMRP            RIGHT PAREN                      @          
         DATA,2   ITEMBRCH          BRANCH                           @          
         DATA,2   ITEMASS           ASSIGN                           @          
         DATA,2   ITEMSMCR          SMALL CIRCLE                     @          
         DATA,2   ITEMBLNK          BLANK                            @          
         DATA,2   ITEMDEL           DEL OR LOCKED DEL                @          
         DATA,2   ITEMCNST          NEGATIVE SIGN                    @          
         DATA,2   ITEMCNST          QUOTE                            @          
         DATA,2   ITEMLAMP          COMMENT                          @          
         DATA,2   ITEMEND           ENDMARK                          @          
         DATA,2   ITEMDOT|ITEMCNST  DOT OR DECIMAL PT                @          
         DATA,2   ITEMOPER          COP                              @          
         DATA,2   ITEMOPER          OP                               @          
         DATA,2   ITEMBAD           BAD                              @          
*                                                                               
         BOUND    4                 INSURE WORD BOUNDARY AFTER ITEMCNTX         
*                                                                               
CSTEXT   STW,R7   OFFSET            SAVE POS OF LATEST CODE DESIGNATOR.         
CSTCHAR  AI,R1    1                 PT AT NEXT INTERNAL CHAR.                   
         LB,R2    0,R1              GET IT.                                     
         CI,R2    ''''              CK FOR QUOTE MARK.                          
         BNE      CSTXMARK          NO.                                         
         AI,R1    1                 YES, LOOK AHEAD IN CASE DBL-QUOTE.          
         LB,R2    0,R1                                                          
         CI,R2    ''''                                                          
         BE       CSTXMARK          DBL-QUOTE, USE 2ND QUOTE.                   
         LI,R3    TEXTCODE          END TEXT, ASSUME TEXT SCALAR.               
         LW,R12   R7                = POS OF LAST ITEM STRUNG.                  
         SW,R12   OFFSET            = SIZE OF TEXT STRUNG.                      
         CI,R12   1                 JUST ONE MARK...                            
         BE       CSTEXIT           YES, IT IS A TEXT SCALAR.                   
         LI,R3    VTXCODE           NO, ASSUME (ORDINARY) TEXT VECTOR.          
         CI,R12   X'FF'             IS SIZE BYTE-SIZE...                        
         BLE      CSLENGTH          YES.                                        
         LI,R3    VTXLCODE          NO, USE LONG TEXT VECTOR DESIGNATOR.        
         SCS,R12  -8                GET MOST SIGNIFICANT BYTE                   
         AI,R7    1                   AND PUT IT IN                             
         STB,R12 *CURRCS,R7             CODESTRING.                             
         SCS,R12  8                 THEN GET LEAST SIGNIFICANT BYTE.            
CSLENGTH AI,R7    1                 PUT LENGTH BYTE IN CODESTRING.              
         STB,R12 *CURRCS,R7                                                     
CSTEXIT  BDR,R1   CSSETLC           BACK UP ONE CHAR POS AND GO SET             
*                                     LEFT CONTEXT AND SO FORTH.                
CSTXMARK AI,R7    1                 STRING LATEST TEXT MARK.                    
         STB,R2  *CURRCS,R7                                                     
         CI,R2    NEWLINE           WAS IT END-OF-CURRENT LINE...               
         BNE      CSTCHAR           NO, TRY NEXT CHAR.                          
         LI,R11   0                 YES, EXTENSION NEEDED.                      
         STW,R11  CONSTKEY          RESET PTR TO KEY CHAR OF CONSTANT.          
         STW,R7   OFFSETK           SAVE CURRENT CODESTRING OFFSET.             
         B        INPXTEND          INPUT THE NEXT IMAGE FOR EXTENSION;         
RESXTEND LW,R11   BREAKFLG           AFTER RESUMING, TEST FOR HANG-UP...        
         BLZ      HANGUP              YES.                                      
         LW,R11   HICOL               NO.                                       
         AI,R11   1-BA(IMAGE)       = NO.OF CHARS TO CODESTRING.                
         SLS,R11  1                 DBL TO GET NO.OF WDS FOR THAT STUFF.        
         LW,R2    CURRCS            PT AT CURRENT CODESTRING OFFSET WD.         
         INT,R3   -2,R2             = CURRENT SIZE OF DATA BLK.                 
         LI,R12   X'7FFFC'          COMPUTE APPROXIMATE NO.OF WDS               
         AND,R12  OFFSETK             ACTUALLY USED SO FAR.                     
         SLS,R12  -2                                                            
         SW,R12   R3                = - APPX. AMT LEFT OVER IN THAT BLK.        
         AW,R11   R12               = APPX. NEW AMT NEEDED.                     
         BLEZ     RESUME            RESUME IF WE ALREADY HAVE ENUF.             
         AW,R3    R2                PT AT 2ND WD AFTER CURRENT CS BLOCK.        
         SW,R3    FREETBL           = (2 - NO.OF WDS BETWEEN CURRENT CS         
*                                          DATA BLK & 1ST FREE LOC) OR          
*                                   = 2 - SIZE OF LONG-NAME DATA BLKS           
*                                         THAT FOLLOW CURRENT CODESTR.          
*  NOTE -- ONLY LONG-NAME DATA BLKS COULD FOLLOW SINCE THE ODD QCNT             
*          FORCED GARBAGE COLLECTION PRIOR TO CODESTRING DB ALLOCATION          
*          AND THEY ARE THE ONLY DATA BLKS ALLOCATED WHILE CODESTRINGING        
*                                                                               
         BAL,R14  ALOCNONX          ALLOC NEW AMT, IF POSSIBLE...               
         B        WSFULLN             OOPS -- WS FULL.                          
         LW,R11   BLKWANTD            OK, GET SIZE ACTUALLY ADDED.              
         AWM,R11  -2,R2             ADD THAT TO CODESTR. DATA BLK HDR.          
         AI,R3    -2                = - SIZE OF ANY LONG-NAME DATA BLKS.        
         BEZ      RESUME            NONE BARRING CODESTRING EXTENSION.          
         STW,R4   CONSTBUF+1        SOME, SAVE PTR TO WD AFTER LAST ONE.        
         AW,R4    R3                PT AT 1ST WD OF 1ST LONG NAME DATA          
*                                     BLK BARRING CODESTRING EXTENSION.         
         STW,R4   CONSTBUF          NOW CONSTBUF IS A DBLWD THAT BOUNDS         
*                                     THE LONG NAME DATA BLOCK BARRIER.         
*                                   ALSO, CONSTBUF ITSELF ACTS AS A             
*                                     SOURCE-BOUNDARY FOR MOVING THE BAR        
         AW,R4    BLKWANTD          COMPUTE THE DESTINATION-BOUNDARY FOR        
         STW,R4   CONSTBUF+2          MOVING THE BARRIER & SAVE IT.             
         LCW,R3   R3                = SIZE OF BARRIER.  READY TO MOVE           
*                                       THE LONG-NAME DATA BLOCKS TO THE        
*                                       END OF THE NEW ALLOCATION, WORK         
*                                       FROM HI END TO LO END OF THE            
*                                       BARRIER WHEN MOVING IT.                 
MOVEQ    AI,R3    -15               DO 15 WDS REMAIN TO MOVE...                 
         BGEZ     MOVE15              YES, MOVE THE HI 15 STILL REMAININ        
         AI,R3    15                  NO, GET SMALL AMT LEFT; SHIFT FOR         
         SCS,R3   -4                    ADDR = 0 & AMT IN BITS 0-3, AND         
         LC       R3                    PUT AMT IN CONDITION CODE.              
         B        MOVE                                                          
MOVE15   LCI      15                SET TO MOVE HIGHEST 15 REMAINING.           
MOVE     LM,R4   *CONSTBUF,R3       GET WDS ACCORDING TO SOURCE-BOUND.          
         STM,R4  *CONSTBUF+2,R3     STORE ACCORDING TO DESTINATION-BOUND        
         AND,R3   X1FFFF            TEST FOR ANY AMT REMAINING TO MOVE.         
         BGZ      MOVEQ             KEEP MOVING IF ANY REMAIN.                  
         LW,R1    SYMT              DONE.  PT AT 1ST WD OF SYMBOL TBL.          
         LI,R6    0                 SET FOR SELECTIVE LOADS.                    
         LI,R7    X'1FFFF'                                                      
         LW,R11   BLKWANTD          GET SIZE ADDED (FOR DISPLACEMENTS).         
         LI,R14   20                = MAX NO. OF WDS PER NAME.                  
         LW,R2    SYMTSIZE          = NO.OF SYMBOL TABLE ENTRIES.               
         AI,R1    1                 PT AT 1ST NAME-INDICATOR WD ON SYMT.        
SYMLOOK  CB,R14  *R1                IS THIS A LONG OR SHORT NAME...             
         BL       NEXTSYM             SHORT, SKIP IT.                           
         LS,R6    0,R1                LONG, GET ITS LONG-NAME PTR.              
         CLM,R6   CONSTBUF          IN RANGE OF LONG-NAME BLKS JUST HIT.        
         BCS,9    NEXTSYM             NO, GO ON TO NEXT SYM TBL ENTRY.          
         AWM,R11  0,R1                YES, DISPLACE BY SIZE ADDED.              
NEXTSYM  AI,R1    2                 PT AT NEXT SYMBOL TABLE ENTRY               
         BDR,R2   SYMLOOK             AND LOOP TILL DONE.                       
RESUME   LI,R1    BA(IMAGE)-1       PT JUST BEFORE 1ST NEW IMAGE CHAR.          
         LW,R7    OFFSETK           RESTORE CODESTRING OFFSET.                  
         LI,R5    QUOTE             RESTORE SCAN ITEM INDICATOR.                
         LI,R4    CSACQCK           RESET R4 FOR LATER CHAR ACQUISITIONS        
         B        CSTCHAR           RESUME ADDING TO THE TEXT VECTOR.           
SYMFULL  LI,R8    IDSYMFUL          = ERROR I.D. FOR 'SYM TBL FULL'.            
CSERROUT LI,R7    CSERRH            HANDLE CODESTRING ERROR                     
         B        THROWOUT            AFTER THROWING CODESTRING AWAY.           
WSFULLN  LI,R8    IDWSFULL          = ERROR I.D. FOR 'WS FULL'.                 
         B        CSERROUT                                                      
WSFULLC  LI,R8    IDWSFULL          = ERROR I.D. FOR 'WS FULL'.                 
         B        CSERRH            HANDLE CODESTRING ERR (NONE ALLOC'D)        
HANGUP   BAL,R7   THROWOUT          THROW CODESTRING AWAY.                      
         B        BCONTOFF          DO LIKE A )CONTINUE CMD.                    
ERLSCAN  STW,R1   ERRCOL            = BYTE ADDR.OF ERROR PT IN IMAGE.           
         LW,R14   MODE              CK FOR FUNCTION DEFINITION MODE.            
         BEZ      ERLSCANF          YES, COMPLETE (MAYBE FIX) CODESTRING        
         AI,R14   -2                CK FOR EVAL-INPUT MODE.                     
         BNEZ     ERLSCAND          NO.                                         
         LI,R14   EFLAG             MAYBE, CK FOR 'EXECUTE'.                    
         CW,R14  *STATEPTR                                                      
         BANZ     ERLSCANX          YES, PRETEND THAT WE CAN EXECUTE,           
*                                     BUT WE WILL HIT SYNTAX ERR THEN.          
ERLSCAND LI,R7    LSCANERR          DISPLAY -- LINE-SCAN ERROR -- SOON.         
THROWOUT LI,R4    0                 THROW OUT CURRENT CODESTRING:               
         XW,R4    CURRCS              ELIMINATE REFERENCE TO DATA BLK,          
         AI,R4    -2                  PT AT ITS HEADER, AND                     
         B        DREF              GO TO ERR ROUTINE AFTER DE-REFING.          
ERLSCANF LI,R14   LSCANERR          EXIT VIA 'LINKCS' TO 'LSCANERR',            
         STW,R14  LINKCS              FORGETTING ORIGINAL LINKAGE.              
ERLSCANX LW,R14   CONSTKEY          HAS CONSTANT BEEN STARTED...                
         BEZ      ERLSCANT            NO, LAST CODE DESIGNATOR IS OK.           
         LW,R1    CONSTKEY            YES, PT AT KEY (START) OF LATEST          
*                                       CONSTANT; WE'LL BACK UP THAT FAR        
         LW,R7    OFFSETK               FORGETTING ANY CODESTRING FROM          
*                                       THAT POINT ON (GOOD OR BAD).            
ERLSCANT AI,R1    -1                BACK UP 1 CHAR TO COUNTER 'CSCOMC'.         
         LI,R3    ERRCODE           = CODESTRING DESIGNATOR FOR ERROR.          
         LI,R5    ENDMARK           THIS PREVENTS LOOPING INDEFINITELY          
*                                     FOR CONTACT ERROR AT THE ENDMARK          
*                                     (THE ENDMARK IS RE-ACQ'D AND ITS          
*                                     CONTEXT CK'D BEFORE EXIT BY 'CSZ')        
         LI,R4    CSACQCK           RE-SET RETURN FROM 'ACQNXCC'.               
CSCOMMNT STW,R7   OFFSET            SAVE PTR TO LAST ACCEPTED DESIGNATOR        
CSCOMC   AI,R1    1                 PEEK AT NEXT CHAR IN IMAGE.                 
         LB,R2    0,R1                                                          
         CI,R2    NEWLINE           CK FOR END MARK...                          
         BE       CSCOMNL             YES                                       
         AI,R7    1                   NO, PLANT IT IN CODESTRING.               
         STB,R2  *CURRCS,R7                                                     
         B        CSCOMC                                                        
CSCOMNL  CI,R3    ERRCODE           WAS THIS A LINE-SCAN ERROR...               
         BNE      CSCOMEND            NO, END THE COMMENT.                      
         LW,R12   R1                  YES, CALC. NO.OF CHARS TO THE RT          
         SW,R12   ERRCOL                OF THE ERROR PT. (INCL. ENDMARK)        
         AI,R7    1                 PLANT THIS 'ERROR-POINTER' AT THE           
         STB,R12 *CURRCS,R7           SPOT THE END MARK WOULD OCCUPY.           
CSCOMEND LW,R12   R7                CALC. LENGTH OF CODESTRING SINCE            
         SW,R12   OFFSET              LAST ACCEPTED CODESTRING DESIG.           
         B        CSLENGTH                                                      
CSDOTPT  AI,R1    1                 PEEK AHEAD FOR DIGIT...                     
         LB,R13   0,R1                                                          
         AI,R1    -1                                                            
         CLM,R13  F0F9                                                          
         BCR,9    CSPT                YES, FRACTION CONSTANT.                   
         CI,R12   ITEMDOT             NO, CK CONTEXT FOR A DOT.                 
         BANZ     CSSETLC           OK, SET LEFT CONTEXT, STRING, GO ON.        
         B        ERLSCAN           BAD -- LINE-SCAN ERROR.                     
CSPT     RES      0               @                                             
CSNEG    RES      0               @  (ASSUME CONSTANT COMING UP).               
CSNUM    CI,R12   ITEMCNST        @ CK CONTEXT FOR A CONSTANT ITEM...           
         BANZ     CSCNST              OK, TRY FOR A CONSTANT.                   
         B        ERLSCAN             BAD -- LINE-SCAN ERROR.                   
CSCNST   STW,R7   OFFSETK           SAVE CODESTRING OFFSET.                     
         STW,R1   CONSTKEY          SAVE POS OF 1ST CHAR OF CONST.              
         BAL,R4   ACQCONST        @ ACQUIRE CONSTANT (UNLESS FALSE-STRT)        
         BDR,R1   ERLSCAN         @ OVERFLOW, PT AT THE LAST CHAR (PROB.        
*                                 @   A DIGIT) OF NO. -- LINE-SCAN ERROR        
         LW,R7    OFFSETK         @ NO O'FLO -- RESTORE OFFSET.                 
         AI,R6    -1                TEST LENGTH OF CONSTANT...                  
         BEZ      CSS                 1 -- SCALAR.                              
         BLZ      ERLSCAN             0 -- FALSE START (NOT NUMBER).            
         AI,R6    1                   >1-- VECTOR, R6 = LENGTH AGAIN.           
         LI,R5    0                 SET ELEMENT COUNTER.                        
         LW,R13   CONSTTYP          WHAT TYPE OF VECTOR...                      
         CLM,R13  ZEROONE           (0 OR 1 MEANS LOGICAL)                      
         BCS,9    CSVIR               INTEGER OR REAL.                          
         LI,R13   VLCODE              LOGICAL -- VECTOR-LOGL CODE DESIG.        
CSLV     AI,R7    1                 PT AT NEXT BYTE FOR CODESTRING.             
         LI,R14   8                 8 BITS PER LOGICAL BYTE VALUE.              
CSLVN    SLS,R8   1                 SHIFT TO MAKE ROOM FOR EACH BIT.            
         OR,R8    CONSTBUF,R5       PLUG IN THAT BIT.                           
         AI,R5    1                 PT AT NEXT ELEMENT, IF ANY.                 
         AI,R6    -1                DECR LENGTH.                                
         BEZ      CSLVD             DONE -- LENGTH IS IN R5 NOW.                
         BDR,R14  CSLVN             LOOP TILL BYTE FULL.                        
         STB,R8  *CURRCS,R7         FULL -- STRING BYTE.                        
         B        CSLV              START A NEW ONE.                            
CSLVS    SLS,R8   1                 SHIFT TO LEFT JUSTIFY LAST LOGL BYTE        
CSLVD    BDR,R14  CSLVS             FINAL LOOP.                                 
         STB,R8  *CURRCS,R7         STRING LAST LOGL BYTE VALUE.                
         B        CSCLEN            PLUG IN NO.OF ELEMS. & CODE DESIG.          
CSDMY    LI,R8    DMYCODE           DUMMY CODESTRING DESIGNATOR USED TO         
         STB,R8  *CURRCS,R7           FILL OUT TO A WD BOUNDARY.                
CSWSET   AI,R7    1                 PT AT NEXT BYTE OF CODESTRING.              
         CI,R7    3                 TEST FOR WD BOUND...                        
         BANZ     CSDMY               NOT YET.                                  
         SLS,R7   -2                  NOW -- SHIFT TO WD RESOLUTION.            
         B       *R14               EXIT FROM CSWSET.                           
CSVIR    BAL,R14  CSWSET            SET TO WD BOUNDARY CODESTRING.              
         LW,R13   CONSTTYP          WHICH TYPE OF NUMERIC CONSTANT...           
         BGZ      CSIV                INTEGER VECTOR.                           
         LI,R13   VRCODE              REAL VECTOR -- CODE DESIGNATOR.           
         LI,R14   CSRVN             RETURN FROM 'CSRIWD' TO 'CSRVN'.            
CSRVN    LD,R8    CONSTBUF,R5       GET REAL NUMBER.                            
         STW,R8  *CURRCS,R7         STRING MOST SIGNIFICANT WD.                 
         AI,R7    1                 PT TO NEXT WD IN CODESTRING.                
         B        CSRIWD            STRING IT AND TEST FOR LAST ELEMENT.        
CSIV     LI,R13   VICODE            CODESTRING DESIGNATOR--VECTOR INTG.         
         LI,R14   CSIVN             RETURN FROM 'CSRIWD' TO 'CSIVN'.            
CSIVN    LW,R9    CONSTBUF,R5       GET INTEGER.                                
CSRIWD   STW,R9  *CURRCS,R7         STRING NUMBER IN R9.                        
         AI,R7    1                 PT TO NEXT WD OF CODESTRING.                
         AI,R5    1                 PT AT NEXT ELEMENT, IF ANY.                 
         BDR,R6  *R14               LOOP TILL LAST (THEN R5 = LENGTH).          
         SLS,R7   2                 RESUME BYTE BOUNDARY FOR STRINGING.         
         B        CSCLENB           STRING LENGTH & NO.OF ELEMENTS.             
CSS      LW,R13   CONSTTYP          REAL NUMBER...                              
         BGEZ     CSI               NO, INTEGER (INCLUDES LOGICAL).             
         LI,R13   REALCODE          SCALAR REAL CODESTRING DESIGNATOR.          
         BAL,R14  CSWSET            SET TO WORD BOUNDARY IN CODESTRING.         
         LD,R8    CONSTBUF          GET THE REAL NO.                            
         STW,R8  *CURRCS,R7         STRING MOST SIGNIFICANT WD.                 
         AI,R7    1                 PT TO NEXT WD IN CODESTRING.                
CSSWD    STW,R9  *CURRCS,R7         STRING NUMBER IN R9.                        
         AI,R7    1                 PT TO NEXT WD IN CODESTRING.                
         SLS,R7   2                 RESUME BYTE BOUNDARY FOR STRINGING.         
         B        CSCCD0            STRING CONSTANT'S CODE DESIGNATOR.          
CSI      LW,R13   CONSTBUF          GET THE INTEGER.                            
         CLM,R13  ZERONINE          IF 0 THRU 9, INTEGER IS ITS OWN             
         BCR,9    CSCCD               CODESTRING DESIGNATOR.                    
         CI,R13   X'FFF00'          WELL, DOES INTG ONLY OCCUPY 1 BYTE          
         BAZ      CSIBYTE             YEP.                                      
         LI,R13   INTGCODE            NOPE, INTEGER CODE DESIGNATOR.            
         LW,R9    CONSTBUF          GET IT AGAIN.                               
         LI,R14   CSSWD             GO TO 'CSSWD' AFTER                         
         B        CSWSET              SETTING CODESTRING TO WD BOUNDARY.        
CSIBYTE  LI,R13   BYNCODE           BYTE-NUMBER CODESTRING DESIGNATOR.          
         LW,R5    CONSTBUF          GET THE NO. THAT FITS IN 1 BYTE.            
CSCLEN   AI,R7    1                 PT TO NEXT BYTE OF CODESTRING.              
CSCLENB  STB,R5  *CURRCS,R7         PLUG IN LENGTH BYTE OR SMALL INTG.          
CSCCD    AI,R7    1                 PT TO NEXT BYTE OF CODESTRING.              
CSCCD0   STB,R13 *CURRCS,R7         PLUG IN CODESTRING DESIGNATOR.              
         LI,R12   LC4CONST          SET LEFT CONTEXT FOR CONSTANT.              
         B        CSARSET           REGS WERE PREPARED EARLIER, CK THE          
*                                     NON-BLANK CHAR THAT TERMINATED            
*                                     THE CONSTANT.                             
CSZ      STH,R7  *CURRCS            SET OFFSET--TO LAST CODESTRING BYTE.        
         SLS,R7   -2                CALC ACTUAL SIZE OF DATA BLK NEEDED         
         AI,R7    3                   FOR THIS CODESTRING.                      
         LW,R4    CURRCS            PT AT THE DATA BLOCK HEADER.                
         AI,R4    -2                                                            
         INT,R11  0,R4              GET SIZE FIELD.                             
         SW,R11   R7                = AMT THAT COULD BE GIVEN BACK TO           
         LW,R7    LINKCS              THE FREE TABLE.  EXIT VIA LINK            
         B        GIVEBACK          AFTER GIVING BACK EVEN AMOUNT.              
CSNON    LB,R5    SCANITEM-(LAMPCODE**-2),R3  CONTACT CK THE SCAN ITEM          
         CH,R12   ITEMCNTX,R5       R12 CONTAINS LEFT CONTEXT.                  
         BANZ     CSSPECCK          OK.                                         
         B        ERLSCAN           BAD, LINE-SCAN ERROR.                       
CSSPECCK CI,R5    SPECIAL           IS THIS A SPECIAL CHAR...                   
         BGE      CSV-SPECIAL,R5      YES, BRANCH INTO CSV-RANGE.               
CSSETLC  LH,R12   LC4TBL,R5         SET NEW LEFT CONTEXT.                       
         AI,R7    1                 STRING NEW CODESTRING DESIGNATOR.           
         STB,R3  *CURRCS,R7                                                     
*        B        %+1               FALLS INTO CSV-RANGE FOR NEXT CHAR          
*                                     ACQ.  NOTE THAT R4 STILL PTS TO           
*                                       'CSACQCK'.                              
CSV      B        ACQNXCC   CSV-RANGE--BRANCH TBL:  @  BLANK                    
         B        DELCK        *                    @  DEL                      
         B        CSNEG        *                    @  NEGATIVE-SIGN            
         B        CSTEXT       *                    @  TEXT CONSTANT            
         B        CSCOMMNT     * (SEE ALSO THE      @  COMMENT                  
         B        CSZ          * 'SPECIAL'          @  END-OF-CODESTRING        
         B        CSDOTPT      * DEFINITIONS--      @  DOT OR DEC.PT            
         B        CSOP         * I.E. EQU-CARDS)    @  COORDINATIBLE OP         
CSOP     AI,R12   -M           *                    @  ORDINARY OP              
         BLZ      CSSETLC           BRANCH IF NOT MONADIC CONTEXT.              
         CLM,R3   POSSMON           MONADIC CONTEXT.  CONVERT OP...             
         BCS,9    CSSETLC             NO, LEAVE IT ALONE.                       
         AI,R3    MONADIC-DYADIC      YES, MAKE IT A MONADIC OPERATOR.          
         B        CSSETLC                                                       
 PAGE                                                                           
************************************************************************        
*                                                                      *        
* THE CODESTRINGER                                                     *        
*                                                                      *        
* CS1--ENTRY PT TO START CODESTRINGING AT THE BEGINNING OF IMAGE BUF.  *        
* CSN--ENTRY PT TO START CODESTRING AT A GIVEN POSITION IN IMAGE BUF.  *        
*        REGS FOR CSN ENTRY:                                           *        
*                 R1  PTS AT THAT POSITION.                            *        
*                 R2  CONTAINS THAT CHAR.--REQUIRED TO BE NON-BLANK.   *        
*                 R3  CONTAINS ITS CODE.                               *        
*        REGS FOR CS1 AND CSN ENTRY:                                   *        
*                 R12 LINK REGISTER.  EXIT VIA SAVED LINK (IN LINKCS)  *        
*        REGS AT NORMAL EXIT (EXIT FROM CODESTRINGER NORMALLY OCCURS   *        
*                 BY ENTERING 'GIVEBACK' TO RETURN ANY UNUSED WORDS    *        
*                 FOR THE CODESTRING DATA BLOCK):                      *        
*                 R4  PTS AT DATA BLOCK HEADER.                        *        
*                 R11 CONTAINS AMOUNT OF UNUSED WORDS.                 *        
*                 R7  LINKAGE TO CS1 OR CSN.                           *        
*                 ALL OTHER REGS CAN BE PRESUMED VOLATILE.             *        
*        (ERROR EXIT IS TO 'LSCANERR' -- LINE-SCAN ERROR -- ALSO TAKES *        
*        PLACE VIA 'GIVEBACK' FOR FUNCTION LINES.  FOR THESE LINES, A  *        
*        PORTION OF THE LINE IS CODESTRUNG AS AN ERROR DESCRIPTION:    *        
*        TEXT,ERROR-PTR,LENGTH,ERROR-CODESTRING-DESIGNATOR.  FOR NON-  *        
*        FUNCTION LINES, CODESTRING IS THROWN AWAY.  SEE 'ERLSCAN'.)   *        
*                                                                      *        
CS1      LI,R1    BA(IMAGE)         PT AT 1ST BYTE OF INTERNAL IMAGE.           
         BAL,R4   ACQNB             ACQ NON-BLANK CHAR. AND CODE.               
CSN      CI,R2    ')'               IF 1ST 'CODESTRINGABLE' CHAR IS RT.         
         BE       CMDREC              PAREN, GO TO CMND. PROCESSOR.             
         STW,R12  LINKCS            SAVE LINK TO CODESTRINGER.                  
         LI,R12   1                 DOES IMAGE CONTAIN AN ODD NO. OF            
         AND,R12  QCNT                QUOTES...                                 
         BEZ      ONELINER              NO.                                     
         BAL,R8   GARBCOLL              YES, TAMP SO CS DATA BLK CAN GRO        
ONELINER LI,R12   0                                                             
         STW,R12  CONSTKEY          RESET PTR TO KEY CHAR OF CONSTANT.          
         LW,R11   HICOL             = LOC OF ENDMARK IN INTERNAL IMAGE.         
         SW,R11   R1                                                            
         AI,R11   1                 = NO.OF CHARS TO CODESTRING.                
         SLS,R11  1                 DBL THAT = NO.OF WDS TO ALLOCATE            
*                                     FOR CODESTRING; IT IS UNLIKELY            
*                                     THAT THIS MANY WDS WILL BE USED.          
         BAL,R14  ALOCNONX          ALLOC THOSE WDS PLUS DATA BLK HDR.          
         B        WSFULLC             YUCK -- WS FULL BEFORE ANY CS.            
         LI,R11   TYPECS            SET DATA BLK TYPE FIELD--CODESTRING.        
         STB,R11 *R4                                                            
         AI,R4    2                 PT AT 1ST WD TO RECEIVE CODESTRING.         
         STW,R4   CURRCS            = PTR TO CODESTRING BLOCK, CURRCS           
*                                     WILL BE OK EVEN IF DATA BLK MOVES.        
         LI,R7    2                 CODESTR STARTS AT BYTE 2.                   
CSBOS    LI,R13   BOSCODE           PUT BEGINNING-OF-STMT CODESTRING            
         STB,R13 *CURRCS,R7           DESIGNATOR INTO CODESTR. BLOCK.           
         LI,R12   LC4BOS            = LEFT CONTEXT FOR BEGINNING-OF-STMT        
CSARSET  LI,R4    CSACQCK           SET RETURN FROM 'ACQNXCC'.                  
CSACQCK  CLM,R3   NONAME            CK LATEST ACQUISITION...                    
         BCR,9    CSNON               NOT A NAME OR NUMBER START                
         BCS,1    CSNUM               DIGIT, STARTS NUMBER                      
*                                     NAME-START CHAR                           
         STW,R7   OFFSET            SAVE POS OF LATEST CODESTR DESIGNATR        
         CI,R12   ITEMNAME          CK FOR CONTACT ERROR FOR NAME.              
         BANZ     CSANAME           OK.                                         
         B        ERLSCAN           OOPS -- LINE-SCAN ERROR.                    
CSANAME  BAL,R12  ACQNAME           ACQUIRE THE NAME--PTR AND TYPE.             
         B        SYMFULL           (SYM TBL FULL RETURN)                       
         B        WSFULLN           (WS FULL RETURN, DUE TO LONG NAME)          
         LW,R7    OFFSET            RESTORE CODESTRING PTR.                     
         CI,R2    ':'               DID NAME END ON A COLON...                  
         BNE      CSNAME            NO.                                         
         CI,R7    2                 YES, HAS CODESTRING REALLY BEGUN...         
         BNE      ERLSCAN           YEP -- LINE-SCAN ERROR.                     
         LW,R4    MODE              NOPE -- FUNCTION DEFN MODE...               
         BNEZ     ERLSCAN             NO -- LINE-SCAN ERROR.                    
         CI,R13   NAMECODE            YES, AN ORDINARY NAME...                  
         BNE      ERLSCAN           YUCK, STOP OR TRACE -- LINE-SCAN ERR        
         LI,R13   COLNCODE          GET COLON CODESTRING DESIGNATOR.            
         B        CSLBLN            START LABEL NAME OVER BOSCODE.              
CSUNLBL  LI,R12   LC4NAME           SET LEFT CONTEXT FOR ORDINARY NAME.         
         AI,R13   -NAMECODE         IS IT...                                    
         BEZ      CSARSET           YES, RESUME WITH CHAR AFTER NAME.           
         LI,R12   LC4STNAM          NO, STOP OR TRACE NAME.                     
         B        CSARSET                                                       
CSNAME   AI,R7    1                 UPDATE CODESTRING PTR.                      
CSLBLN   SCS,R6   -8                CODESTRING THE NAME PTR--                   
         STB,R6  *CURRCS,R7           MOST SIGNIFICANT BYTE                     
         AI,R7    1                   FOLLOWED BY                               
         SCS,R6   8                                                             
         STB,R6  *CURRCS,R7           LEAST.                                    
         AI,R7    1                 UPDATE CODESTRING PTR.                      
         STB,R13 *CURRCS,R7         ENTER NAME TYPE (OR COLON CODE).            
         CI,R13   COLNCODE          WAS IT A LABEL...                           
         BNE      CSUNLBL           NO.                                         
         LI,R13   NAMECODE          YES, REPLACE COLON CODE WITH                
         STB,R13 *CURRCS,R7           ORDINARY NAME CODE.                       
         AI,R7    1                                                             
         LI,R13   COLNCODE          THEN PLUG IN THE COLON CODE.                
         STB,R13 *CURRCS,R7                                                     
         AI,R7    1                 PREPARE TO RESTART CODESTRINGING            
         LI,R4    CSBOS               BY PUTTING BEGINNING-OF-STMT CODE         
         B        ACQNXNB             AFTER THE COLON.  EXIT TO CSBOS           
*                                       AFTER GETTING NEXT NON-BLANK.           
 PAGE                                                                           
************************************************************************        
 SPACE 2                                                                        
Z        SET      %-CS@             SIZE OF CS IN HEX.                          
 SPACE                                                                          
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536  SIZE IN DECIMAL.               
 SPACE 2                                                                        
         END                                                                    
