
**                          **
***  PROCESS ARRAY SYMBOL  ***
**                          **
* 
*  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 
      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 
**                                   ** 
***  RESTORE SYMBOL TABLE POINTERS  *** 
**                                   ** 
* 
*  USED BY CSAVE TO RESTORE THE SYMBOL TABLE TO ITS APPEARAMCE
*  BEFORE VALUE HAS BEEN RUN, I.E. THE POINTERS TO DIM AND COM
*  STATEMENTS ARE PLACED IN THE SECOND WORD OF ARRAY AND STRING 
*  ENTRIES IN THE SYMBOL TABLE, 'DON'T KNOW' ENTRIES ARE LINKED 
*  TO THE CORRESPONDING KNOWN ONE AND THE SECOND WORD OF DEFAULT
*  ENTRIES IS SET TO ZERO.
* 
#RSTP LDB SPROG     INITIALIZE PROGRAM
      STB SPTR        POINTER 
      CPB SYMTB     FINISHED PROGRAM SCAN?
      JMP RSTP5     YES 
      ISZ SPTR      NO--COMPUTE 
      ADB SPTR,I      NEXT STATMENT 
      STB NSPTR         POINTER 
      ISZ SPTR
      LDA SPTR,I    EXTRACT 
      AND OPMSK       OPERATOR
      CPA COMOP     'COM'?
      JMP RSTP1+1   YES 
      CPA DIMOP     NO, 'DIM'?
      RSS           YES 
      JMP #RSTP+1   NO
RSTP1 CLB 
      STB DCFLG     SET COM-DIM FLAG
RSTP2 LDA SPTR,I    COMPUTE 
      AND OPDMK       POINTER 
      ADA .-1           INTO
      ALS                 SYMBOL
      ADA SYMTB             TABLE 
      STA STMP1 
      LDA 0,I       EXTRACT 
      AND .+17B       SYMBOL
      ADA .-4       SIMPLE
      SSA             VARIABLE? 
      JMP RSTP4     NO
      CCA           YES 
      LDB STMP1     FLAG
      INB             AS 'IN
      STA 1,I           COMMON' 
      LDB SPTR      UPDATE
RSTP3 INB             STATEMENT 
      STB SPTR          POINTER 
      CPB NSPTR     END OF STATEMENT? 
      JMP #RSTP+1   YES 
      JMP RSTP2     NO
RSTP4 LDB SPTR      SET POINTER 
      ADB .+2         TO DIMENSION
      LDA DCFLG 
      SZA           'COM'?
      CMB,INB       YES--COMPLEMENT POINTER 
      LDA STMP1     STORE 
      INA             IN SYMBOL 
      STB 0,I           TABLE 
      LDB SPTR      FINISHED
      ADB .+4 
      CPB NSPTR       STATEMENT?
      JMP #RSTP+1   YES 
      ADB .-1       NO, TWO-
      LDA 1,I 
      AND OPMSK       DIMENSIONAL?
      CPA SCOMM 
      ADB .+2       YES--BUMP PAST SECOND DIMENSION 
      JMP RSTP3     NO
* 
*  SCAN SYMBOL TABLE FOR 'DON'T KNOW' ENTRIES AND 
*  DEFAULT DIMENSION ENTRIES
* 
RSTP5 LDB SYMTB     INITIALIZE TABLE POINTER
      CPB FILTB     FINISHED SYMBOL TABLE SCAN? 
      JMP RSTP9     YES 
      STB STMP1     NO--SAVE POINTER
      LDA 1,I       DON'T 
      AND .+17B       KNOW
      CPA .+3           ENTRY?
      JMP RSTP7     YES 
      ADA .-3       NO, STRING
      SSA,RSS         OR ARRAY? 
      JMP RSTP6     NO
      INB           YES 
      LDA 1,I       DEFAULT 
      CMA,INA 
      ADA SYMTB       DIMENSIONS? 
      SSA,RSS 
      JMP RSTP6     NO
      CLA           YES--STORE A ZERO 
      STA 1,I         IN SYMBOL TABLE 
RSTP6 LDB STMP1     BUMP TO 
      ADB .+2         NEXT SYMBOL 
      JMP RSTP5+1 
* 
*  PROCESS 'DON'T KNOW' ENTRY 
* 
RSTP7 STB STMP2 
      LDB SYMTB     IS THERE
      CCA             A MATCHING
      ADA STMP2,I       TWO-DIMENSIONAL 
      CPA 1,I             ENTRY?
      JMP RSTP8     YES 
      ADA .-1       NO, MATCHING ONE- 
      CPA 1,I         DIMENSIONAL ENTRY?
      JMP RSTP8     YES 
      ADB .+2       NO--BUMP TO 
      JMP RSTP7+2     NEXT SYMBOL 
RSTP8 INB           LINK 'DON'T 
      LDA STMP1       KNOW' ENTRY 
      INA               WITH MATCHING 
      STB 0,I             KNOWN ONE 
      JMP RSTP6 
RSTP9 CLA           SET STORAGE 
      STA VLFLG     UNALLOCATED FLAG
      STB PBPTR     RESET END-OF-PROGRAM POINTER
      JMP RSTPT,I 
      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 UNTOUCHED, 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                   [B]
      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
VAL85 LDB VTMP1     YES, RESTORE                 [B]
      JMP VALU1       B REGISTER                 [B]
VALU9 EQU * 
      ADA .5000     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 
      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 .5000     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 DIM = 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
      JMP VAL85                                  [B]
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 .5000       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 
      JMP VAL85                                  [B]
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
      SKP 
*                                *
**  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
      JMP VAL85                                  [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 VAL85                                  [B]
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 
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 EQU * 
      LDA VLFLG     HAS STORAGE 
      SZA             BEEN ALLOCATED? 
      JMP VAL98     YES 
      LDA USESN     NO, ANY 'PRINT
      SZA,RSS         USING' STATEMENTS?
      JMP VAL98     NO
      LDA PBPTR     YES,
      STA IFSS        ALLOCATE
      LDA .72            SPACE FOR
      JSB CUSP            FORMAT
      STA PBPTR             STACK 
VAL98 EQU * 
      CLA,INA       SAY STORAGE 
      STA VLFLG       ALLOCATED 
      LDA PBPTR     POINTER TO END
      STA FCORE       OF FIXED TABLES 
      HED MAIN EXECUTION LOOP 
* 
* ************************* 
****                     ***
***  EXECUTE THE PROGRAM  *** 
****                     ***
* ************************* 
* 
* 
*  THE CORE-RESIDENT FILE BUFFERS FOLLOW THE VALUE TABLE:  ONE
*  RECORD-SIZED BLOCK OF CORE IS ALLOCATED FOR EACH FILE REQUESTED
*  IN THE <FILES STATEMENT>.  FIVE STACKS EXIST DURING EXECUTION: 
*  SINCE STACK POINTERS ARE ASSUMED TO REFERENCE THE TOPMOST
*  ENTRY IN THEIR STACK THEY ARE INITIALLY SET ONE ENTRY BELOW
*  THE PHYSICAL START OF THE STACK; THUS THE FIRST ENTRY ADVANCES 
*  A STACK POINTER TO THE FIRST WORD OF ITS STACK SPACE.  GOSUBS
*  QUEUE THEIR RETURN ADDRESSES IN THE RETURN STACK, WHICH HAS A
*  FIXED LENGTH OF NINE WORDS ALLOCATED IMMEDIATELY FOLLOWING 
*  THE FILE BUFFERS.  THE FOR-STACK (SIX-WORD ENTRIES) CONTAINS 
*  ALL INFORMATION PERTAINING TO ACTIVE FOR-NEXT LOOPS; INITIALLY 
*  EMPTY, ITS CORE SPACE IS ALLOCATED DYNAMICALLY AS NEEDED.  THE 
*  TEMPORARY STACK HOLDS INTERMEDIATE RESULTS DURING FORMULA
*  EVALUATION; IT IS INITIALIZED TO HOLD TEN TEMPORARIES AND
*  EXPANDS DYNAMICALLY AS NECESSARY.  THE OPERAND AND OPERATOR
*  STACKS FOLLOW WITH THEIR ONE-WORD ENTRIES OCCUPYING ALTERNATE
*  LOCATIONS, EXPANDING INTO FREE USER SPACE ON A DEMAND BASIS. 
*  THE TOP OF THE OPERATOR STACK, ALWAYS AT LEAST ONE WORD AHEAD
*  OF THE OPERAND STACK, IS PBPTR SO THAT ALL ACTIVE USER SPACE 
*  IS KEPT WITHIN THE SWAP REGION.  SINCE ALL STACKS EXCEPT THE 
*  RETURN STACK EXPAND DYNAMICALLY, STATIC AND DYNAMIC NESTING
*  OF FORMULAS AND FOR-NEXT LOOPS IS FREELY PERMITTED UP TO 
*  THE EXHAUSTION OF USER SPACE.
* 
**                          **
***  INITIALIZE EXECUTION  ***
**                          **
* 
*  PRINT THE PROGRAM NAME.  INITIALIZE FILE STATUS INFORMATION
*  IN THE FILE TABLE AND NOTIFY USER OF ANY REQUESTED FILES 
*  WHICH ARE READ-ONLY.  ALLOCATE A 64 WORD BUFFER FOR EACH FILE. 
*  ALLOCATE RUN-TIME STACKS, INITIALIZE POINTERS TO THE DATA BLOCK, 
*  AND MOVE TO A FRESH TELETYPE LINE. 
* 
      JSB ABCK,I    ABORT ATTEMPT DURING COMPILE? 
      LDA MAIN,I
      AND CHNFG 
      STA TEMP2     SAVE CHAIN FLAG 
      SZA,RSS       WAS THIS PROGRAM CHAINED TO?
      JMP XEC01     NO
      CLF 0         YES 
      XOR MAIN,I    CLEAR 
      STA MAIN,I      CHAIN FLAG
      STF 0 
      JMP XEC0      DON'T PRINT NAME
XEC01 LDA .+12B     ECHO
      JSB OUTCR       LINE FEED 
      LDA LNAME 
      STA LT1 
      ADA .+?NAME-?ID 
      LDA A,I       REMOVE RUN-ONLY 
      AND INF         BIT AND CHECK FOR 
      SZA,RSS           NULL PROGRAM NAME 
      JMP XEC0      YES 
      CLB           NO
      STB LT2       OUTPUT
      LDA .-3         PROGRAM 
      JSB OUTST         NAME
XEC0  CLA           ZERO
      STA FCNTR       FILE COUNTER
      STA RTNST         AND MESSAGE FLAG
      STA ENOUF     TURN OFF OVER/UNDERFLOW 
      STA ASINP     SET NO ASSIGN PROCESSED 
      LDB FILTB     LOAD ADDRESS OF FILE TABLE
XEC2  CPB VALTB     DONE? 
      JMP XEC4      YES 
      ISZ FCNTR     NO, COUNT FILE
      LDA TEMP2 
      SZA           WAS THIS PROGRAM CHAINED TO?
      JMP XEC3      YES 
      LDA 1,I       READ
      SSA             ONLY? 
      JMP XEC5I,I   YES 
XEC3  LDA BIT15     NO
      ADB .+4       SET NULL
      STA B,I         RECORD ADDRESS
      ADB .-3       GET RECORD
      LDA B,I         SIZE AND
      ALR,RAR           CLEAR BITS 14 AND 15
      STA B,I         AND STICK BACK IN FILE TABLE
      ADB .+7       ALLOCATE
      JSB CUSP          BUFFER FOR
      STA PBPTR           THE FILE
      STA 1,I       SET 
      INB             'RECORD FULL' 
      STA 1,I           CONDITION 
      INB           SET 
      CLA             'NO EOF EXIT' 
      STA 1,I           CONDITION 
      ADB .+4       POINT TO MASK 
      STA 1,I       CLEAR PROTECT MASK
      INB           POINT TO NEXT ENTRY 
      JMP XEC2
XEC4  LDA FCNTR     ARE THERE 
      SZA,RSS         ANY FILES?
      JMP XEC9      NO
      LDA DFCHK     YES, SET
      CLF 0           POSSIBLE DIRTY
      IOR MAIN,I        FILES BIT IN
      STA MAIN,I          TTY TABLE 
      STF 0 
XEC9  LDA TEMP2 
      SZA           WAS THIS PROGRAM CHAINED TO?
      JMP XEC8      YES 
      LDA .+15B     NO, OUTPUT A
      JSB OUTCR       CARRIAGE RETURN 
      LDA .+12B         AND 
      JSB OUTCR           TWO 
      LDA .+12B             LINE FEEDS
      JSB OUTCR 
XEC8  LDB PBPTR 
      ADB .-1       SET POINTERS TO 
      STB RTRNQ       TOP AND BOTTOM
      STB RTNST         OF RETURN STACK 
      ADB .+4       SET 
      STB FORQ        EXECUTION 
      JSB SETPT         POINTERS
      LDB SPROG     SET POINTERS TO 
      JSB SETDP       FIRST <DATA STATEMENT>
*                       * 
**  EXECUTE STATEMENT  ** 
*                       * 
* 
*  SAVE SEQUENCE NUMBER FOR POSSIBLE USE BY ERROR ROUTINE.
*  ADVANCE PROGRAM COUNTER TO NEXT STATEMENT AND BRANCH TO
*  CODE FOR EXECUTION OF CURRENT STATEMENT. 
* 
XEC1  LDB PRGCT     SAVE CURRENT
XEC1B LDA B,I         SEQUENCE                   [B]
      STA .LNUM         NUMBER
      LDA B 
      INA           CHECK 
      LDA A,I         STATEMENT 
      JSB STLCK         LENGTH
      LDA 1         COMPUTE 
      INA             ADDRESS 
      ADB 0,I           OF NEXT 
      STB PRGCT           STATEMENT 
      INA           SET INTRA-
      STA TEMP1       STATEMENT POINTER 
      LDA TEMP1,I   COMPUTE 
      AND OPMSK       BRANCH
      ALF,ALF           ADDRESS 
      RAR                 FOR CURRENT 
      ADA XECBR             STATEMENT TYPE
      STA FILE#     SET 'NO FILE' FLAG
      JMP 0,I       BRANCH TO APPROPRIATE ROUTINE 
*                              *
**  OUTPUT READ-ONLY WARNING  **
*                              *
XEC5  STB RTRNQ     SAVE (B)
      LDB MLINK+1 
      ADB .+?ID-?LINK 
      LDA 1,I       GET ID
      AND M2000     IS IT 
      CPA A000        AN 'A'? 
      JMP XEC7      YES 
      ISZ RTNST     NO, FIRST TIME THROUGH? 
      JSB WERRS+8,I YES, EMIT MESSAGE 
      CCA           SET FLAG FOR
      STA RTNST       MESSAGE SUPPRESSION 
      LDA .+43B     OUTPUT
      JSB OUTCR       A '#' 
      LDA FCNTR     OUTPUT
      ADA .-10
      SSA           FILE #>9? 
      JMP XEC6      NO
      LDA .+61B     YES 
      JSB OUTCR     OUTPUT A '1'
      LDA FCNTR     OUTPUT
      ADA .+46B       SECOND
      RSS               DIGIT 
XEC6  ADA .58       OUTPUT SINGLE DIGIT 
      JSB OUTCR 
      LDA .+40B     OUTPUT
      JSB OUTCR       BLANK 
XEC7  LDB RTRNQ     RETRIEVE (B)
      JMP XEC3I,I 
