      SKP 
**                          **
***  PROCESS ARRAY SYMBOL  ***
**                          **
* qq
*  ENTER WITH AN ARRAY NAME IN STMP1.  IF A MATCHING
*  SYMBOL TABLE ENTRY EXISTS, PROCEED AS IN SSYMT.  ELSE IF 
*  THE ARRAY IS SINGLY OR DOUBLY SUBSCRIPTED (LAST FOUR 
*  BITS OF NAME ARE 0001 OR 0010): EXIT IS TO ERROR ON
*  FINDING A CONFLICTING ENTRY; ON FINDING ONLY A "DON'T
*  KNOW" ENTRY (LAST FOUR BITS 0011), PROCEED AS IN SSYMT,
*  PLACING THE APPROPRIATE ENTRY IN THE TWO WORDS ABOVE 
*  THE "DON'T KNOW" ENTRY AND SETTING A POINTER TO ITS
*  SECOND WORD INTO THE SECOND WORD OF THE "DON'T KNOW" 
*  ENTRY.  IF THE SYMBOL IS AN UNMATCHED "DON'T KNOW" 
*  ARRAY NAME, APPEND A SYMBOL TABLE ENTRY: IF A SINGLY 
*  OR DOUBLY SUBSCRIPTED VERSION OF THE ARRAY HAS BEEN
*  PREVIOUSLY FOUND, PLACE A POINTER TO THE SECOND WORD 
*  OF THE PREVIOUS ENTRY INTO THE SECOND WORD OF THE NEW
*  "DON'T KNOW" ENTRY; OTHERWISE LEAVE TWO WORDS ABOVE
*  THE NEW ENTRY. .
* 
#ASYM LDA ASYMT     SET RETURN
      STA SSYMT       ADDRESS 
      CCA           SET MATCH 
      STA STMP2       FLAG FALSE
      LDA APTR1     INTIALIZE 
      STA ASYMT       SEARCH LOOP 
      LDA .+4       INSURE SPACE
      JSB CUSP        FOR NEW ENTRY 
      LDB SYMTB 
      LDA STMP1     RETRIEVE SYMBOL 
      IOR .+3       SET ARRAY SYMBOL
      JMP SYMT7+3     TO "DON'T KNOW" 
SYMT6 ADA .-2       MATCH AS
      CPA 1,I         'SINGLE SUBSCRIPT'? 
      JMP SYMT8     YES 
      INA           NO, MATCH AS
      CPA 1,I         'DOUBLE SUBSCRIPT'? 
      JMP SYMT8     YES 
      INA           NO, MATCH AS
SYMT7 CPA 1,I         "DON'T KNOW"? 
      JMP SYMT9     YES 
      ADB .+2       NO, MORE SYMBOL 
      CPB PBPTR       TABLE ENTRIES?
      JMP SYMT2     NO
      JMP ASYMT,I   YES 
SYMT8 CPA STMP1     DOES ENTRY MATCH SYMBOL?
      JMP SYMT5     YES Sk
      IOR .+3       NO, IS SYMBOL OF
      CPA STMP1       TYPE "DON'T KNOW"?
      JMP *+3       YES 
      JSB DCMPL     NO, DECOMPILE 
      JSB RERRS+11,I  SUBSCRIPT CONFLICT
      STB STMP2     SAVE POINTER TO ENTRY 
      LDB APTR2     CONTINUE SEARCH 
      STB ASYMT       FOR POSSIBLE
      LDB STMP2         "DON'T KNOW"
      JMP SYMT7+2         ENTRY 
SYMT9 CPA STMP1     DOES ENTRY MATCH SYMBOL?
      JMP SYMT5     YES 
      INB           NO, NEW ENTRY TO BE MADE
      LDA 1         SET POINTER TO
      ADB .-2         NEW ENTRY INTO
      STB 0,I           "DON'T KNOW" ENTRY
      CLA           MAKE NEW
      JMP SYMT4+1     ENTRY 
      HED ABORT CHECK 
* *q
**    CHECK FOR ABORT ATTEMPT 
* 
ABCHK NOP 
      LDB MLINK+1   LOAD TTY STATUS WORD. 
      ADB .-?LINK+?TSTA 
      LDA UNABT     CLEAR UNABORT 
      CMA             CONDITION 
      CLF 0         I.E.
      AND 1,I       ALLOW 
      STA 1,I         ABORTS
      STF 0             AGAIN.
      AND ABTRY     DID THIS GUY TRY
      SZA,RSS         TO ABORT? 
      JMP ABCHK,I   NOPE. 
      CLF 0         YES.
      LDA B,I       RELOAD TTY STATUS.
      AND ABSCL     REMOVE OLD STATUS.
      IOR IOBT      ADD NEW STATUS. 
      STA B,I IA
      ADB .-?TSTA+?MASK 
      LDA MPCOM     SET COMMUNICATIONS
      IOR B,I         FLAG FOR
      STA MPCOM         THIS USER.
      LDA CMSK      CLEAR 
      AND CHNFG       CHAIN 
      STA CHNFG         FLAG. 
      CLA           BLOCK CLOCK.
      STA DCLC1,I 
      ADB .+?STAT-?MASK 
      CCA 
      STA B,I       SET STATUS TO ABORTING. 
      STF 0 
      JMP *+1,I ,,
      DEF SCH1
* qq
ABSCL OCT 70002 
* 
      HED TELETYPE POINTER TABLE
* qq
**   TELETYPE POINTER TABLE 
* 
TTPT  EQU * 
      DEF TTY00 
      DEF TTY01 1L
      DEF TTY02 
      DEF TTY03 
      DEF TTY04 
      DEF TTY05 
      DEF TTY06 
      DEF TTY07 
      DEF TTY10 
      DEF TTY11 
      DEF TTY12 2
      DEF TTY13 
      DEF TTY14 
      DEF TTY15 5b
      DEF TTY16 
      DEF TTY17 
* 
* 
      HED  MISC. FORMULAS  (MOVED HERE IN REV D)
* 
**
***   FETCH A FORMULA VALUE  ***                      (D) 
**   %
* qq
*     RETURN WITH THE RESULT IN (A) AND (B)           (D) 
* 
#FTCH JSB FORMX     EVALUATE THE FORMULA         (D)
      JSB OPCHK     UNSTACK ADDRESS              (D)
      DLD 1,I       LOAD RESULT                  (D)
      JMP FETCH,I                                (D)
* *q
**                                                    (D) 
***  INITIALIZE FOR PROGRAM MODIFICATION              (D) 
**A 
#SINI CCA           SET LOCAL                    (D)
      ADA LBUFA,I   CHARACTER                    (D)
      STA BADDR     POINTER                      (D)
      LDA .+40B     TURN ON                      (D)
      STA BLANK     BLANK SUPPRESSION            (D)
      STA GFLAG     TURN OFF INTEGER ERROR      (D) 
      JMP SINIT,I   SUPPRESSION                 (D) 
**                                                    (D) 
***  CHECK OVER/UNDERFLOWS                            (D) 
**                                                    (D) 
*                                                     (D) 
*     EXIT TO (P+1) IF STATUS IS NOT SYNTAX.  ELSE    (D) 
*     EXIT TI (P+2), SETTING SYMTB=4 IF IN KEYBOARD  (D)  
*     MODE.  THESE ERRORS ARE NOT REPORTED IF IN      (D) 
*     TAPE MODE.                                      (D) 
*                                                     (D) 
#CHOU LDA LNAME     COMPUTE STATUS               (D)
      ADA .+?STAT-?ID                            (D)
      LDB 0,I                                    (D)
      CPB .+4       SYNTAX?                      (D)
      RSS           YES                          (D)
      JMP CHOU1     NO                           (D)
      LDA TAPEF                                  (D)
      AND LMSK                                   (D)
      SZA,RSS                                    (D)
      STB SYMTB                                  (D)
      ISZ CHOUF                                  (D)
      JMP CHOUF,I                                (D)
CHOU1 ISZ ENOUF     ARE WE EXECUTING "ENTER"?    (D)
      RSS           NO                           (D)
      ISZ CHOUF     YES-SUPPRESS                 (D)
      JMP CHOUF,I                                (D)
*                                                     (D) 
**                                                    (D) 
***  CHECK THAT (A) (THE STATEMENT LENGTH) IS        (D)  
***  BETWEEN 3 AND 105.  IF NOT, EXIT TO ERROR.       (D) 
**                                                    (D) 
*                                                     (D) 
#SLCK ADA .-3                                    (D)
      SSA                                        (D)
      JSB RERRS+44,I   TOO SMALL                (D) 
      ADA M103                                   (D)
      SSA                                        (D)
      JMP STLCK,I    OK                          (D)
      JSB RERRS+44,I   TOO LARGE                (D) 
M103  DEC -103                                   (D)
      HED COMPILATION AND DECOMPILATION 
**                        **
***  BACKSPACE IN BUFFER  **
**                        **
* qq
#BKSP LDB BADDR       SET THE BUFFER
      CPB PRBFA,I          POINTER
      LDB PRBFE,I              BACK 
      ADB .-1 
      STB BADDR 
      JMP BCKSP,I 
**                         ** 
***  GET DIGIT TO OUTPUT  *** 
**                         ** 
* *q
*  COMPUTE NEXT DECIMAL DIGIT AND RETURN WITH IT IN (A).
*  SUBTRACT IT OUT OF THE NUMBER. 
* *q
#GTDG JSB MBY10     MULTIPLY BY 10
      LDB EXP       GET EXPONENT IN (B) 
      CMB,INB         AS NEGATIVE 
      AND HMASK     RETAIN HIGH 5 BITS
      RAL           NORMALIZE TO BIT 15 
      SSB,INB       ROTATE INTEGER
      JMP *-2         INTO (A)
      AND B377      EXTRACT 
      STA FD0         DIGIT 
      LDB EXP       ROTATE
      CMB,INB 
      RAR             BACK
      SSB,INB 
      JMP *-2 
      XOR MANT1     REMOVE
      LDB MANT2       DIGIT 
      JSB NORML     NORMALIZE REMAINDER 
      LDA FD0       LOAD (A) WITH DIGIT 
      JMP GETDG,I 
**                                 ** 
***  FETCH NEXT BUFFER CHARACTER  *** 
**                                 ** 
* qq
*  THE NEXT CHARACTER FROM THE INPUT BUFFER IS FETCHED. NORMAL
*  EXIT IS TO (P+2) WITH THE CHARACTER IN (A). BLANKS ARE SKIPPED 
* IF 'BLANK' = 40 OCTAL. A 'CARRIAGE RETURN' EXITS TO (P+1) 
* 
#GTCR LDB BADDR    INCREMENT                     X] 
      INB            CHARACTER ADDRESS           X] 
      CPB PRBFE,I  OUT OF PHYSICAL BUFFR?        X] 
      LDB PRBFA,I  YES, WRAP AROUND              X] 
      STB BADDR    NO                            X] 
      CLE,ERB      LOAD CORRECT                  X] 
      LDA 1,I        BUFFER WORD                 X] 
      SEZ,RSS      EXTRACT                       X]   
      ALF,ALF        DESSIRED                     X]  
      AND B377         CHARACTER                 X] 
      CPA BLANK    BLANK?                        X] 
      JMP #GTCR        YES, IGNORE IT    [X]
      CPA .+15B    NO, CARRIAGE REUTRN?          X] 
      JMP GETCR,I  YES                           X] 
      LDB 0     COPY CHAR TO B                        [B] 
      ADA M96                                        [B]
      SSA,RSS   NO SKIP IF LOWER CASE               [B] 
      ADA M32   MAKE INTO UPPER CASE                  [B] 
      ADA .140  RESTORE CHARACTER                     [B] 
      ISZ GETCR    NO, EXIT                      X] 
      JMP GETCR,I    TO P+2 
UPMA1 OCT 5116
      ASC 6,OT USER DISC
SYSAA ASC 3,SYSTEM
* 
NUSE3 BSS 8         NOT USED                     [E]
      SKP 
**                           ** 
***  BUILD THE VALUE TABLE  *** 
**                           ** 
* 
*  IF NO VALUE TABLE EXISTS, ONE IS BUILT FROM THE SYMBOL 
*  TABLE AND INITIALIZED; IF IT ALREADY EXISTS, IT IS 
*  INITIALIZED.  IN BUILDING THE VALUE TABLE, EACH ENTRY
*  IN THE SYMBOL TABLE IS CHECKED: FOR FUNCTIONS THE
*  EXISTENCE OF A DEFINING FORMULA IS CHECKED; FOR SIMPLE 
*  VARIABLES TWO WORDS ARE ALLOCATED AND SET TO 'UNDEFINED' 
*  AND A POINTER TO THEM IS PLACED IN THE SECOND WORD OF
*  THE SYMBOL TABLE ENTRY; FOR ARRAYS FOUR WORDS ARE
*  ALLOCATED FOR THE DECLARED AND DYNAMIC DIMENSIONS, 
*  THE DIMENSIONS ARE INITIALIZED EITHER FROM A 
*  <DIM STATEMENT> IN THE PROGRAM OR THE DEFAULT
*  DIMENSIONS, ARRAY SPACE IS ALLOCATED AT TWO WORDS PER
*  ARRAY ELEMENT CONTIGUOUS WITH THE DIMENSIONS,  THE 
*  ELEMENTS ARE INITIALIZED TO 'UNDEFINED,' AND A 
*  POINTER TO THE FIRST ELEMENT IS PLACED IN THE SECOND 
*  WORD OF THE SYMBOL TABLE ENTRY; FOR STRINGS FOLLOW THE 
*  PATTERN FOR ARRAYS WITH ONE WORD HOLDING THE PHYSICAL
*  DIMENSION IN BITS 15-8 AND THE DYNAMIC DIMENSION IN
*  BITS 7-0 (DIMENSION HERE MEANS LENGTH AS NUMBER OF 
*  CHARACTERS), STRING SPACE IS ALLOCATED ONE WORD PER
*  TWO CHARACTERS, AND THE DYNAMIC LENGTH IS INITIALIZED
*  TO ZERO.  FOR "DON'T KNOW" ARRAY ENTRIES, THE SECOND 
*  WORD OF THE SYMBOL TABLE ENTRY IS COPIED FROM THE
*  ASSOCIATED SINGLY OR DOUBLY SUBSCRIPTED ENTRY (OR
*  EXIT TO ERROR IF NONE EXISTS). 
*  FOR VARIABLES WHICH HAVE BEEN DECLARED IN A <COM 
*  STATEMENT>, STORAGE IS ALLOCATED IN THE COMMON AREA
*  WHICH RESIDES AHEAD OF THE PROGRAM. FOR ARRAYS AND 
*  STRINGS, THIS AREA IS LEFT UNDISTURBED IF THE DIMENSIONS 
*  DECLARED IN THE <COM STATEMENT> MATCH THOSE FOUND IN 
*  THE COMMON AREA, AND THE DYNAMIC DIMENSIONS ARE CONSISTENT 
*  IF A VALUE TABLE ALREADY EXISTS, VARIABLES IN COMMON ARE 
*  LEFT UNTOWHED, VALUES OF SIMPLE VARIABLES AND ARRAY  
*  ELEMENTS ARE SET TO 'UNDEFINED' AND DYNAMIC ARRAY
*  DIMENSIONS ARE SET TO DECLARED DIMENSIONS; THE DYNAMIC 
*  LENGTHS OF STRINGS ARE SET TO ZERO.  EXIT TO XEC IF
*  PROCESSING IS SATISFACTORILY COMPLETED.
* 
VALUE LDB FCORE     INSURE CORRECT
      STB PBPTR       SETTING FOR PBPTR 
VALU0 LDB PBUFF     INITIALIZE
      STB COMPT       COMMON POINTER
      LDB SYMTB     SET (B) TO
      RSS             SYMBOL TABLE
VALU1 INB           SYMBOL TABLE
      CPB FILTB       EXHAUSTED?
      JMP VAL99     YES 
      LDA 1,I       NO, LOAD SYMBOL 
      INB           POINT (B) TO VALUE TABLE POINTER
      SZA,RSS       NULL SYMBOL?
      JMP VAL14     YES 
      AND .+17B     NO
      CPA .+17B     FUNCTION? 
      JMP VALU4     YES 
      SZA,RSS       NO, STRING VARIABLE?
      JMP VAL15     YES 
      ADA .-4       NO, 
      SSA             ARRAY?
      JMP VALU5     YES 
*                                *
**  INITIALIZE SIMPLE VARIABLE  **
*                                *
      LDA VLFLG     SIMPLE VARIABLE 
      SZA,RSS       STORAGE ALLOCATED?
      JMP VALU3     NO
      LDA 1,I       YES 
      CMA,INA       VARIABLE
      ADA 1           IN
      SSA,RSS           COMMON? 
      JMP VALU1     YES 
      LDA 1,I       NO
VALU2 STA VTMP1     SAVE POINTER TO VALUE 
      CCA           SET 
      STA VTMP1,I     VALUE TO
      JMP VALU1         UNDEFINED 
VALU3 LDA 1,I       VARIABLE
      SSA             IN COMMON?
      JMP VAL31     YES 
      LDA .+2       NO--ALLOCATE
      JSB CUSP        STORAGE 
      STA PBPTR         FOR VALUE 
      ADA .-2       PUT VALUE POINTER 
      STA 1,I         INTO SYMBOL TABLE 
      JMP VALU2 
VAL31 LDA COMPT     ALLOCATE STORAGE
      STA 1,I         IN COMMON 
      ADA .+2       UPDATE COMMON 
      STA COMPT       POINTER 
      JMP VALU1 
*                    *
**  CHECK FUNCTION  **
*                    *
VALU4 LDA 1,I       WAS FUNCTION
      SZA             DEFINED?
      JMP VALU1     YES 
      JSB DCMPL     NO, DECOMPILE 
      JSB RERRS+7,I UNDEFINED FUNCTION
*                      *
**  INITIALIZE ARRAY  **
*                      *
VALU5 CPA .-1       IS ARRAY TYPE "DON'T KNOW" ?
      JMP VAL13     YES 
      STB VTMP1     NO, SAVE POINTER TO SYMBOL TABLE
      INA           SAVE INFORMATION ON 
      STA VTMP2       NUMBER OF DIMENSIONS
      LDA VLFLG     STORAGE 
      SZA             ALLOCATED?
      JMP VAL12     YES 
      LDA 1,I       NO
      SSA           IN COMMON?
      JMP VAL51     YES 
      LDB VTMP1,I   NO, LOAD POINTER TO DIMENSIONS
      LDA PBPTR     SET POINTER TO
      STA VTMP3       DIMENSION ENTRY 
      LDA .+4       ALLOCATE
      JSB CUSP        SPACE 
      STA PBPTR         FOR ENTRY 
      STA VTMP1,I   SYMBOL TABLE POINTER TO ARRAY 
      SZB,RSS       DEFAULT DIMENSIONS? 
      JMP VAL11     YES 
      LDA 1,I       NO, LOAD ROW DIMENSION
      ADB .+2       BUMP POINTER
VALU6 ISZ VTMP2     TWO DIMENSIONAL?
      CLB,INB,RSS   NO, SET COLUMN DIMENSION TO 1 
      LDB 1,I       YES, LOAD COLUMN DIMENSION
      STA VTMP3,I   PUT 
      ISZ VTMP3       DECLARED DIMENSIONS 
      STB VTMP3,I       IN VALUE TABLE
VALU7 ISZ VTMP3     PUT 
      STA VTMP3,I     DYNAMIC DIMENSIONS
      ISZ VTMP3         IN
      STB VTMP3,I         VALUE TABLE 
      MPY VTMP3,I   COMPUTE NUMBER OF ARRAY ELEMENTS
      SZB,RSS       TOO 
      SSA             LARGE?
      JMP VAL10     YES 
      STA VTMP4     SAVE POSITIVE 
      CMA,INA         AND NEGATIVE
      STA VTMP2         COUNT 
      LDB VTMP3     HAS 
      INB             ARRAY BEEN
      CPB PBPTR         ALLOCATED?
      JMP VALU9     NO
VALU8 CCA           INITIALIZE
      STA 1,I         ARRAY ELEMENT 
      ADB .+2           TO 'UNDEFINED'
      ISZ VTMP2     DONE? 
      JMP VALU8     NO
      LDB VTMP1     YES 
      JMP VALU1 
VALU9 ADA .2500     ARRAY 
      SSA             TOO LARGE?
      JMP VAL10     YES 
      LDA VTMP4     NO
      ALS           ALLOCATE
      JSB CUSP        SPACE 
      STA PBPTR         FOR ARRAY 
      JMP VALU8 
VAL10 JSB DCMPL     DECOMPILE 
      JSB RERRS+8,I ARRAY TOO LARGE 
VAL11 LDA .+10      LOAD (A) WITH 10
      LDB A.10      LOAD (B) WITH 
      JMP VALU6       ADDRESS OF 10 
VAL12 LDA 1,I       IS ARRAY
      CMA,INA 
      ADA 1           IN COMMON?
      SSA,RSS S
      JMP VALU1     YES 
      LDA VTMP1,I   NO--LOAD
      ADA .-4 
      STA VTMP3       DECLARED
      LDA VTMP3,I 
      ISZ VTMP3         DIMENSIONS
      LDB VTMP3,I 
      JMP VALU7 
VAL51 LDB VTMP1,I   SET 
      CMB,INB         DIMENSION 
      STB VTMP5         POINTER 
      STB VTMP1,I         POSITIVE
      LDA COMPT     SET 
      STA VTMP3       POINTER 
      ADA .+4           IN SYMBOL 
      STA VTMP1,I         TABLE 
      LDA 1,I       PHYSICAL ROW DIMENSION
      CPA VTMP3,I     SAME AS DECLARED DIMENSION? 
      RSS           YES 
      JMP VAL52     NO
      ADB .+2       B=> SECOND DIMENSION
      LDA VTMP2     TWO 
      CPA .-2         DIMENSIONAL?
      CLB,INB,RSS   NO--SET COLUMN DIMENSION TO 1 
      LDB 1,I       YES--LOAD COLUMN DIMENSION
      ISZ VTMP3     PHYSICAL COLUMN DIMENSION 
      CPB VTMP3,I     SAME AS DECLARED DIMENSION
      RSS           YES 
      JMP VAL52     NO
      LDA COMPT,I   COMPUTE SIZE OF 
      MPY VTMP3,I     ARRAY AS DECLARED 
      SZB,RSS       TOO 
      SSA             LARGE?
      JMP VAL52     YES 
      STA VTMP4     NO--SAVE SIZE 
      ADA .2500     TOO 
      SSA             LARGE?
      JMP VAL52     YES 
      ISZ VTMP3     NO
      LDA VTMP3,I   COMPUTE SIZE
      ISZ VTMP3       AS SPECIFIED BY 
      MPY VTMP3,I       DYNAMIC DIMENSIONS
      SZB,RSS       TOO 
      SSA             LARGE?
      JMP VAL52     YES 
      CMA,INA,SZA,RSS 
      JMP VAL52     CHEESE IT! DYNAMIC DIMENSION = 0
      ADA VTMP4     DYNAMIC SIZE
      SSA             > DECLARED SIZE 
      JMP VAL52     YES 
      LDA VTMP1,I   = COMPT+4 
      ADA VTMP4 
      ADA VTMP4     UPDATE
      STA COMPT       COMMON POINTER
      LDB VTMP1     RESTORE (B) 
      JMP VALU1 
VAL52 LDB VTMP5     => ROW DIMENSION
      LDA 1,I 
      ADB .+2       => COLUMN DIMENSION 
      ISZ VTMP2     TWO-DIMENSIONAL?
      CLB,INB,RSS   NO--LOAD DEFAULT DIMENSION
      LDB 1,I       PUT 
      STA COMPT,I     DECLARED
      ISZ COMPT         DIMENSIONS IN 
      STB COMPT,I         COMMON AREA 
      ISZ COMPT     PUT 
      STA COMPT,I     DYNAMIC 
      ISZ COMPT         DIMENSIONS IN 
      STB COMPT,I         COMMON AREA 
      MPY COMPT,I   COMPUTE NUMBER OF ARRAY ELEMENTS
      SZB,RSS       TOO 
      SSA             LARGE?
      JMP VAL10     YES 
      CMA,INA       NO--SAVE COMPLEMENT 
      STA VTMP2       OF NUMBER OF ELEMENTS 
      CMA,INA       ARRAY 
      ADA .2500       TOO 
      SSA               LARGE?
      JMP VAL10     YES 
      ISZ COMPT     NO
      LDB COMPT     INITIALIZE
      CCA             ALL 
VAL53 STA 1,I           ELEMENTS
      ADB .+2             TO
      ISZ VTMP2             UNDEFINED 
      JMP VAL53 
      STB COMPT     UPDATE COMMON POINTER 
      LDB VTMP1     RESTORE (B) 
      JMP VALU1 1
VAL13 LDA VLFLG     STORAGE 
      SZA             ALLOCATED?
      JMP VALU1     YES 
      LDA 1,I       NO, GET 
      LDA 0,I         AND STORE 
      STA 1,I           POINTER TO
      JMP VALU1           VALUE TABLE 
VAL14 JSB DCMPL     DECOMPILE 
      JSB RERRS+9,I NUMBER OF DIMENSIONS NOT KNOWN
*                                *
**  INITIALIZE STRING VARIABLE  **
*                                *
VAL15 STB VTMP1     SAVE (B)
      LDA VLFLG     STORAGE 
      SZA             ALLOCATED?
      JMP VAL17     YES 
      LDA 1,I       NO
      SSA           IN COMMON?
      JMP VAL18     YES 
      LDB VTMP1,I   NO, SAVE LENGTH POINTER 
      LDA PBPTR     SET POINTER TO
      STA VTMP3       LENGTH ENTRY
      INA           MORE
      CPA LWAUS       USER SPACE? 
      JSB RERRS+10,I  NO
      STA PBPTR     YES, SET POINTER TO STRING
      STA VTMP1,I     INTO SYMBOL TABLE ENTRY 
      SZB,RSS       DEFAULT LENGTH? 
      CLA,INA,RSS   YES, SET (A) = 1
      LDA 1,I       NO, LOAD DECLARED LENGTH
      ALF,ALF       STORE PHYSICAL LENGTH 
      STA VTMP3,I     ALONG WITH ZERO 
      ALF,ALF           LOGICAL LENGTH
      INA           ALLOCATE
      ARS             SPACE 
      JSB CUSP          FOR 
      STA PBPTR           STRING
VAL16 LDB VTMP1     RESTORE 
      JMP VALU1       (B) 
VAL17 LDA 1,I 
      CMA,INA       STRING
      ADA 1           IN
      SSA,RSS           COMMON? 
      JMP VALU1     YES 
      CCB           NO--RESET 
      ADB VTMP1,I 
      LDA 1,I         LOGICAL LENGTH
      AND M256
      STA 1,I           TO ZERO 
      JMP VAL16 6j
VAL18 CMA,INA       SET POINTER POSITIVE
      STA VTMP3     => DIMENSION INFORMATION
      LDA COMPT     SET VALUE 
      INA             POINTER IN
      STA 1,I           SYMBOL TABLE
      LDA COMPT,I   EXTRACT PHYSICAL
      ALF,ALF         LENGTH FROM 
      AND B377          COMMON AREA 
      CPA VTMP3,I   SAME AS DECLARED LENGTH?
      RSS           YES 
      JMP VAL20     NO
      LDA COMPT,I   LOGICAL 
      AND B377
      CMA,INA         LENGTH <= 
      ADA VTMP3,I 
      SSA               PHYSICAL LENGTH?
      JMP VAL20     NO
      LDA VTMP3,I   LOAD PHYSICAL LENGTH
      JMP VAL19 yK
VAL20 LDA VTMP3,I   RESET PHYSICAL LENGTH TO
      ALF,ALF         DECLARED LENGTH AND 
      STA COMPT,I       LOGICAL LENGTH TO ZERO
      ALF,ALF 
VAL19 INA           UPDATE
      ARS 
      INA             COMMON
      ADA COMPT 
      STA COMPT         POINTER 
      JMP VALU1 
VAL99 CLA,INA       SAY STORAGE HAS 
      STA VLFLG       BEEN ALLOCATED
      JMP XEC 
      SKP Pl
**                          **
***  ALLOCATE COM STORAGE  ***
**                          **
* 
* THE BEGINNING OF THE PROGRAM IS SCANNED FOR <COM STATEMENTS>. THE 
* AMOUNT OF COM STORAGE NEEDED IS COMPUTED. A POINTER (SPROG) TO
* THE START OF THE PROGRAM IS CREATED AND THE PROGRAM IS SHIFTED TO 
* HIGHER CORE TO ALLOW FOR THE COM STORAGE. 
* qq
#ALCO CLB           SAY NO COMMON 
      STB DEST        ALLOCATED YET.
      LDB PBUFF 
      STB STPTR     POINTER TO FIRST STATEMENT
ALCO1 LDA STPTR,I   SAVE STATEMENT
      STA .LNUM       NUMBER
      ISZ STPTR 
      ADB STPTR,I 
      STB NSPTR     POINTER TO NEXT STATEMENT 
      ISZ STPTR 
      LDA STPTR,I   EXTRACT 
      AND OPMSK       OPERATOR
      CPA COMOP     COM STATEMENT?
      JMP ALCO2     YES 
ALCO6 LDA DEST      GET TOTAL COMMON ALLOCATED
      SZA,RSS       EXIT IF THERE WERE
      JMP ALCOM,I     NO COM STATEMENTS 
      ADA PBUFF     PROGRAM BEGINNING MOVES BY
      STA SPROG       AMOUNT OF COMMON ALLOCATED. 
      CCB           POINTER TO FIRST
      ADB PBPTR       WORD TO BE MOVED
      LDA 1         POINTER TO
      ADA DEST        FIRST DESTINATION 
      STA DEST          LOCATION
      INA           RESET END OF
      STA PBPTR       PROGRAM POINTER 
ALCO0 LDA 1,I       MOVE A
      STA DEST,I      WORD
      CPB PBUFF     DONE? 
      JMP ALCOM,I   EXIT
      ADB .-1       NO--BUMP
      CCA 
      ADA DEST        POINTERS
      STA DEST
      JMP ALCO0         AND LOOP
ALCO2 LDA STPTR,I   EXTRACT 
      AND .+17B       OPERAND 
      SZA           STRING? 
      JMP ALCO3     NO
      ISZ STPTR     YES-- 
      ISZ STPTR       EXTRACT 
      LDA STPTR,I       LENGTH
      INA           COMPUTE 
      ARS             STORAGE 
      INA               REQUIRED
      ISZ STPTR     BUMP PAST RIGHT BRACKET 
      JMP ALCO7+1 
ALCO3 ADA .-4 
      SSA           SIMPLE VARIABLE?
      JMP ALCO4     NO
      CLA,INA       YES-- ALLOW TWO WORDS 
      JMP ALCO7 
ALCO4 ISZ STPTR     MUST BE ARRAY 
      ISZ STPTR 
      LDB STPTR,I   EXTRACT LENGTH
      ISZ STPTR 
      LDA STPTR,I   GET NEXT
      AND OPMSK       OPERATOR
      CPA SCOMM     SUBSCRIPT COMMA?
      JMP *+3       YES 
      LDA 1         NO
      JMP ALCO5+1 
      LDA 1         COMPUTE 
      ISZ STPTR       ARRAY 
      MPY STPTR,I       SIZE
      SZB           TOO BIG?
      JMP CUS1A,I   YES 
ALCO5 ISZ STPTR     BUMP PAST 
      CLE,ELA 
      SEZ,SSA,RSS   TOO BIG?
      SLA,ERA       NO
      JMP CUS1A,I   YES 
      ADA .+2       ALLOW 4 WORDS FOR DIMENSIONS
ALCO7 ALS          DOUBLE EVERYTHING  
      ADA DEST      UPDATE
      STA DEST        POINTER 
      ADA .100
      JSB CUSP      CHECK FOR ENOUGH ROOM 
      ISZ STPTR 
      LDB STPTR R>
      CPB NSPTR     END OF STATEMENT
      RSS           YES 
      JMP ALCO2     NO
      CPB PBPTR     END OF PROGRAM? 
      JMP ALCO6     YES 
      JMP ALCO1     NO
* 
CUS1A DEF CUSP1 
**                                   ** 
***  ADVANCE SYNTAX BUFFER POINTER  *** 
**                                   ** 
* 
*  (A) AND (B) REMAIN AS UPON E^RY  
* qq
#SBPU STA SBT0      SAVE (A)
      ISZ SBPTR     ADVANCE POINTER 
      LDA SBPTR     BUFFER
      CPA SYNTQ       OVERFLOW? 
      JSB SERRS+31,I  YES 
      LDA SBT0      NO, RETRIEVE (A)
      JMP SBPUD,I 
**                               ** 
***  DEMAND A LEFT PARENTHESIS  *** 
**                               ** 
* *q
*  INSIST CHARACTER IN (A) BE '(' OR ''.  RECORD IT 
*  AS A '('.
* 
#LPCK LDB .-2       '(' 
      JSB SYMCK       OR
      DEF LBRAC-1       '' ?
      JSB SERRS+22,I  NO
      LDA LPOP      YES, RECORD 
      STA SBPTR,I     A '(' 
      JMP LPCK,I,6
