
      HED UTILITY ROUTINES
      ORG 42000B
ARBAS DEF FOJT-12B,I
D66   OCT -66 
ITEMP BSS 1 
M72   DEC -72 
.73   DEC 73
* 
**                               ** 
***  EXECUTE <CHAIN STATEMENT>  *** 
**                               ** 
* 
ECHAN JSB SCHLB,I   CALL SYSTEM TO EXECUTE DISC ROUTINE 
      DEF CHLIB 
      JSB RERRS+39,I
      JSB RERRS+48,I
      JSB RERRS+40,I
      JSB RERRS+41,I
      JSB RERRS+47,I
      JSB RERRS+50,I  BAD LINE NUMBER 
      JMP *+1,I     GO COMPILE IT 
      DEF CMPL0 
**                                    **
***  SET POINTERS TO DATA STATEMENT  ***
**                                    **
* 
*  STARTING WITH THE STATEMENT REFERENCED BY (B) UPON 
*  ENTRY, FIND THE NEXT <DATA STATEMENT> AND SET THE DATA 
*  BLOCK POINTERS APPROPRIATELY.  IF NO <DATA STATEMENT>
*  IS FOUND, SET THE POINTERS TO THE 'OUT OF DATA'
*  CONFIGURATION AND EXIT WITH (A) = -1.
* 
#STDP CPB SYMTB     PROGRAM EXHAUSTED?
      JMP SETD2     YES, SET 'OUT OF DATA' CONDITION
      ADB .+2       NO, 
      LDA 1,I         STATEMENT 
      ADB .-1           OF
      AND OPMSK           TYPE
      CPA DATOP             'DATA'? 
      JMP SETD1     YES 
      ADB 1,I       NO, COMPUTE 
      ADB .-1         ADDRESS OF
      JMP #STDP         NEXT STATEMENT
SETD1 LDA 1,I       LOAD STATEMENT LENGTH 
      INB           SET 
      CMA,INA         DATA
      INA,RSS           COUNTER 
SETD2 CCA                 TO
      STA DCCNT             1-STATEMENT LENGTH
      STB NXTDT     SET POINTER ONE WORD
      JMP SETDP,I     ABOVE FIRST DATA CONSTANT 
      SKP 
**                             ** 
***  VALIDATE A FILE REQUEST  *** 
**                             ** 
* 
*  EXIT TO (P+2) IF (TEMP1)+1 DOES NOT BEGIN A FILE REFERENCE;
*  ELSE EVALUATE THE FILE REFERENCE AND VERIFY ITS CORRESPONDENCE 
*  WITH A REQUESTED FILE.  IF A RECORD REFERENCE IS ALSO PRESENT, 
*  EVALUATE IT AND CALL FOR ITS SWAPPING INTO THE CORE BUFFER.
* 
#VLFI LDB TEMP1     IS
      INB 
      CPB PRGCT       NEXT
      JMP VLFI0 
      LDA 1,I           OPERATOR
      AND OPMSK 
      CPA B4000           A '#' ? 
      JMP VLFI1     YES 
VLFI0 ISZ VLFIL     NO, EXIT
      JMP VLFIL,I     TO (P+2)
VLFI1 CCB           SET 
      LDA TEMP1,I     VL0 = 0 
      AND OPMSK         FOR 
      CPA PRTOP           'PRINT',
      CLB                   ELSE
      STB VL0                 VL0 = -1
      ISZ TEMP1     EVALUATE
      JSB FETCH       FILE REFERENCE
      JSB SBFIX     15-BIT INTEGER? 
      JSB RERRS+35,I  NO
      STB FILE#     YES, SAVE IT
      LDA TEMP1     IS ANOTHER                   [B]
      CPA PRGCT       OPERATOR THERE?            [B]
      JMP VLFI2-1   NO                           [B]
      LDA TEMP1,I   NEXT
      AND OPMSK       OPERATOR
      CPA B2000         A COMMA?
      JMP VLFI3     YES 
      CCB           NO, USE NULL RECORD 
VLFI2 STB RCRD# 
      SSB           NULL RECORD?
      LDB .-2       YES, DO NOT ADJUST FILE POINTER 
      LDA FILE# 
      ISZ VL0       WRITE REQUEST?
      CMA           YES 
      JSB RQSTR     VALIDATE FILE/RECORD REQUEST
      JMP VLFIL,I 
VLFI3 JSB FETCH     EVALUATE RECORD REFERENCE 
      JSB SBFIX     15-BIT INTEGER? 
      LDB INF       NO, LOAD IMPOSSIBLE RECORD
      JMP VLFI2     YES 
      SKP 
**                     ** 
***  FETCH DATA ITEM  *** 
**                     ** 
* 
*  UPON ENTRY (B) = 1 IF A NUMBER IS REQUESTED OR (B) = 2 IF A
*  STRING IS REQUESTED.  FDATA FILLS THE REQUEST FROM A FILE IF 
*  ONE IS REFERENCED BY THE CALLER, ELSE FROM THE DATA BLOCK. 
*  TYPE MATCH IS CHECKED.  NUMBERS RETURN IN (A) AND (B); STRINGS 
*  ARE PREPARED AS SOURCE STRINGS.  FDATA MOVES TO NEW FILE 
*  RECORDS OR <DATA STATEMENT>S AS NECESSARY. 
* 
#FDAT LDA FILE#     READ FROM 
      SSA,RSS         FILE? 
      JMP FDAT3     YES 
      ISZ DCCNT     NO, DATA IN CURRENT STATEMENT?
      JMP FDAT1     YES 
      STB TEMP5     NO, SAVE (B)
      LDB NXTDT     MOVE TO NEXT
      JSB SETDP       <DATA STATEMENT>
      LDB TEMP5     RETRIEVE (B)
      ISZ DCCNT     DATA FOUND? 
      RSS           YES 
      JSB RERRS+21,I  NO, OUT OF DATA 
FDAT1 ISZ DCCNT     INCREMENT COUNTER 
      LDA NXTDT,I   CORRECT 
      ISZ NXTDT 
      RBR             TYPE OF 
      XOR 1 
      SSA               DATA? 
      JSB RERRS+22,I  NO
      SSB,RSS       YES, STRING?
      JMP FDAT2     YES 
      DLD NXTDT,I   NO, LOAD NUMBER 
      ISZ NXTDT     UPDATE
      ISZ NXTDT       POINTER 
      ISZ DCCNT 
      JMP FDATA,I 
FDAT2 LDA NXTDT,I   LOAD STRING LENGTH
      ISZ NXTDT     SET 
      LDB NXTDT       START-OF-STRING 
      BLS               CHARACTER 
      STB TEMP4           ADDRESS 
      AND B377      SET 
      CMA             TRANSFER STRING 
      STA TPRME         LENGTH
      CMA,INA       UPDATE
      ARS 
      LDB 0 
      ADA NXTDT       DATA
      STA NXTDT 
      ADB DCCNT 
      STB DCCNT         POINTERS
      JMP FDATA,I 
FDAT3 LDA FBASE     GET 
      ADA .+5 
      LDA 0,I         PROTECT 
      STA PMASK            MASK 
      STB TEMP5     SAVE DATA REQUEST TYPE
      LDB RCRD#     GET TYPE
      STB EORFL       OF NEXT ITEM
      JSB GTTYP         IN FILE 
      CPA TEMP5     MATCHING TYPES? 
      JMP FDAT5     YES 
      CPA .+4       NO, END-OF-RECORD?
      JMP FDAT4     YES 
      CPA .+3       NO, END-OF-FILE?
      RSS           YES 
      JSB RERRS+22,I  NO, TYPE MISMATCH 
FDAT4 ISZ FBASE     LOAD
      LDB FBASE,I     EOF/EOR ADDRESS 
      SZB,RSS       NULL? 
      JSB RERRS+37,I  YES, UNPROTECTED EOF/EOR
      STB PRGCT     NO
      LDB FORST     CLEAN UP
      JSB SETPT       EXECUTION STACKS
      JMP XEC1A,I 
FDAT5 LDB FBASE,I   LOAD DATA ADDRESS 
      SLA,RSS       STRING? 
      JMP FDAT6     YES 
      DLD 1,I       NO, LOAD NUMBER 
      SZA,RSS       ZEROS ARE 
      JMP FDAT7       NOT MASKED
      XOR PMASK     MASK
      SWP 
      XOR PMASK      DATA 
      SWP 
FDAT7 ISZ FBASE,I   ADJUST RECORD POINTER 
      ISZ FBASE,I     PAST DATA 
      JMP FDATA,I 
FDAT6 LDA 1,I       LOAD STRING HEADER
      INB           SET 
      BLS             SOURCE
      STB TEMP4         ADDRESS 
      BRS 
      AND B377      SET 
      CMA             TRANSFER
      STA TPRME         LENGTH
      CMA,INA       ADJUST
      ARS             RECORD POINTER
      ADB 0             PAST
      STB FBASE,I         STRING
      JMP FDATA,I 
      SKP 
**                             ** 
***  REQUEST AN INPUT RECORD  *** 
**                             ** 
* 
*  SERVICES REQUESTS FOR TELETYPE INPUT.  IF (A) = 0 EMIT A '?' 
*  AND 'X-ON' ELSE EMIT A LINE FEED, TWO '?', AND AN 'X-ON'.
* 
#INCL STA ITEMP     SAVE FLAG 
      LDA MAIN      DOES THIS USER
      INA             HAVE THE
      CPA PRIST         LINE PRINTER? 
      JSB WERRS+9,I YES - RELEASE IT
      LDA ITEMP     RESTORE FLAG
      SZA           INITIAL REQUEST?
      JMP INCL2     NO
      LDA CHRCT     YES 
      ADA M72       LINE
      SSA             FULL? 
      JMP INCL1     NO
      LDA .+15B     YES, OUTPUT 
      JSB OUTCR       CARRIAGE RETURN 
      LDA .+12B         AND 
      JSB OUTCR           LINE FEED 
INCL1 LDA B77       OUTPUT
      JSB OUTCR       '?' 
      LDA .+21B     OUTPUT
      JSB OUTCR       AN X-ON 
      CLA           RESET 
      STA CHRCT       OUTPUT CHARACTER COUNTER
      STA IFCNT         AND INPUT ITEM COUNTER
      LDA IWT 
      JSB SCHIN,I   REQUEST INPUT RECORD
      JSB GETCR     FIRST 
      JMP INCL2       CHARACTER A 
      CPA .+3           'CONTROL C' ? 
      JMP EXITA,I   YES, TERMINATE EXECUTION
      JSB BCKSP     NO, RETURN
      JMP INCAL,I     TO CALLER 
INCL2 LDA MAIN      IF USER 
      INA             HAS THE 
      CPA PRIST         LINE PRINTER, 
      JSB WERRS+9,I       RELEASE IT
      LDA .+12B     OUTPUT A
      JSB OUTCR       LINE FEED 
      LDA B77           AND 
      JSB OUTCR           A '?' 
      JMP INCL1 
**                            **
***  EXECUTION BRANCH TABLE  ***
**                            **
XECTB DEF EASN      ASSIGN
      DEF XEC1      USING 
      DEF XEC1      IMAGE 
      DEF XEC1      COM 
      DEF ELET      LET 
      DEF XEC1      DIM 
      DEF XEC1      DEF 
      DEF XEC1      REM 
      DEF EGOTO     GOTO
      DEF EIF       IF
      DEF EFOR      FOR 
      DEF ENEXT     NEXT
      DEF EGOSB     GOSUB 
      DEF ERTRN     RETURN
      DEF EXIT      END 
      DEF EXIT      STOP
      DEF XEC1      DATA
      DEF EINPT     INPUT 
      DEF EREAD     READ
      DEF EPRIN     PRINT 
      DEF ERSTR     RESTORE 
      DEF EMAT      MAT 
      DEF XEC1      FILES 
      DEF ECHAN     CHAIN 
      DEF EENTR     ENTER 
      DEF ELET      'IMPLIED' LET 
**                         ** 
***  FETCH FORMULA VALUE  *** 
**                         ** 
* 
*  RETURN WITH THE RESULT IN (A) AND (B)
* 
#FTCH JSB FORMX     EVALUATE FORMULA
      JSB OPCHK     UNSTACK ADDRESS 
      DLD 1,I       LOAD RESULT 
      JMP FETCH,I 
**                            **
***  SET EXECUTION POINTERS  ***
**                            **
* 
*  SETS POINTERS TO THOSE STACKS WHOSE LOCATION MAY CHANGE
*  DURING EXECUTION, USUALLY DUE TO INITIATION OR COMPLETION
*  OF FOR-LOOPS.
* 
#STPT STB FORST     SET TOP OF FOR-STACK
      ADB .+4       SET POINTER TO TOP
      STB TMPST       OF TEMPORARY STACK
      ADB .+20      SET POINTER TO TOP
      STB OPDST       OF OPERAND STACK
      ADB .+3       SET POINTER TO BOTTOM 
      STB OPTRQ       OF OPERATOR STACK 
      CMB           OUT 
      ADB LWAUS       OF
      SSB               STORAGE?
      JSB RERRS+10,I  YES 
      LDB OPTRQ     NO, SET POINTER TO TOP
      STB PBPTR       OF OPERATOR STACK 
      JMP SETPT,I 
**                                         ** 
***  INITIALIZE FOR PROGRAM MODIFICATION  *** 
**                                         ** 
#SINI LDA .+40B     TURN ON 
      STA BLANK       BLANK SUPPRESSION 
      STA GFLAG     TURN OFF INTEGER ERROR-SUPPRESS 
      JMP SINIT,I 
      HED FORMULA EVALUATION ROUTINES 
**                        **
***  EVALUATE A FORMULA  ***
**                        **
* 
*  ENTER WITH TEMP1 POINTING TO THE FIRST OPERAND OF THE
*  FORMULA.  OPERATORS AND THE ADDRESSES OF OPERANDS ARE
*  STACKED SEPARATELY.  OPERAND ADDRESSES ARE STACKED AS
*  SOON AS THE OPERAND IS SCANNED.  AN OPERATOR IS NOT
*  STACKED WHILE THE OPERATOR ON TOP OF THE STACK HAS EQUAL 
*  OR HIGHER PRECEDENCE, INSTEAD THE LATTER IS UNSTACKED
*  AND EXECUTED; THUS AN OPERATOR FORCES EXECUTION OF THOSE 
*  PREVIOUSLY STACKED, DOWN TO THE LATEST ONE STACKED WHICH 
*  HAS A LOWER PRECEDENCE.  THE OPERATOR STACK IS INITIALIZED 
*  WITH AN END-OF-FORMULA (LOWEST PRECEDENCE) OPERATOR.  THE
*  ACTION OF OPERATORS IS IN GENERAL TO COMBINE THE TOP TWO 
*  OPERANDS STACKED .  THE ADDRESS OF THE PARTIAL RESULT THUS 
*  OBTAINED REPLACES THE ADDRESSES OF ITS CONSTITUENT OPERANDS
*  ON THE STACK (VALUES OF PARTIAL RESULTS ARE KEPT ON THE
*  TEMPORARY STACK).  UPON EXIT TEMP1 POINTS TO THE FIRST PROGRAM 
*  WORD WHOSE OPERATOR DOES NOT MANIPULATE THE STACK (THIS
*  MAY BE AN END-OF-FORMULA, 'THEN', 'OF', ETC.). 
* 
#FORM JSB PSHST     STACK 
      CLB             BEGINNING-OF-FORMULA
      STB PBPTR,I       OPERATOR
*                          *
**  PROCESS NEXT OPERAND  **
*                          *
FORM1 LDA TEMP1,I   EXTRACT 
      ISZ TEMP1       NEXT
      AND OPDMK         OPERAND 
      SZA,RSS       NULL OPERAND? 
      JMP FORM2     YES 
      ISZ OPDST     NO, BUMP POINTER
      ISZ OPDST       TO OPERAND STACK
      SSA           VARIABLE OPERAND? 
      JMP FORM6     NO
*                                                 * 
**  STACK NON-FUNCTION VARIABLE OPERAND ADDRESS  ** 
*                                                 * 
* 
*  THE ADDRESSES STACKED ARE AS FOLLOWS:  FOR SIMPLE VARIABLES, 
*  A POINTER TO THE VALUE; FOR ARRAYS, THE BASE ADDRESS; FOR
*  STRING VARIABLES, THE NEGATION OF THE BASE ADDRESS.
* 
      ADA .-1       COMPUTE 
      ALS             POINTERS
      ADA SYMTB         TO SYMBOL 
      LDB 0               TABLE 
      INB                   ENTRY 
      LDA 0,I       PROGRAMMER- 
      AND .+17B       DEFINED 
      CPA .+17B         FUNCTION? 
      JMP FORM8     YES 
      LDB 1,I       NO, LOAD VALUE POINTER
      SZA           STRING VARIABLE?
      JMP FORM2-1   NO
      LDA TEMP1     YES, END
      CPA PRGCT       OF FORMULA? 
      JMP FORM0     YES 
      LDA TEMP1,I   NO, 
      AND OPMSK       FOLLOWED BY 
      CPA LBOP          SUBSCRIPT?
      JMP FORM2-2   YES 
FORM0 STB TEMP4     NO
      JSB RSCHK     CREATE TEMPORARY
      CLA           RECORD
      CCB 
      DST TMPST,I     (0,-1)
      LDB TEMP4     RETRIEVE AND
      CMB,INB         NEGATE STRING ADDRESS 
      STB OPDST,I   STACK ADDRESS 
*                           * 
**  PROCESS NEXT OPERATOR  ** 
*                           * 
FORM2 LDA TEMP1     FORMULA 
      CPA PRGCT       EXHAUSTED?
      JMP FORM3     YES 
      LDA TEMP1,I   NO, 
      AND OPMSK       EXTRACT 
      ALF,ALF           NEXT
      LDB 0               OPERATOR
      CPA .+2       STRING CONSTANT?
      JMP FOR13     YES 
      ADA .-20B     NO, NON-FORMULA 
      SSA             OPERATOR? 
      CLB           YES 
      ADA D66       NO, NON-FORMULA 
      SSA,RSS         OPERATOR? 
FORM3 CLB           YES 
      CLA           NO
      SZB,RSS       END-OF-FORMULA? 
      JMP *+4       YES 
      ADB FOPBS     NO, LOAD OPERATOR 
      LDA 1,I         INFORMATION WORD
      AND B377      SAVE
      STA TEMP2       PRIORITY
      XOR 1,I       SAVE
      ARS             INTERNAL
      STA TEMP3         NAME
*                                                *
**  STACK PRESENT OR EXECUTE PREVIOUS OPERATOR  **
*                                                *
FORM4 LDA PBPTR,I   DOES OPERATOR 
      AND B377        ON TOP
      CMA               OF STACK
      ADA TEMP2           HAVE HIGHER 
      SSA                   PRIORITY? 
      JMP FORM5     YES 
      LDA TEMP2     NO
      CPA .+13B     CORRECT 
      CLA,INA         STACK PRIORITY
      IOR TEMP3     ADD NAME
      JSB PSHST     STACK 
      STA PBPTR,I     OPERATOR
      JMP FORM1 
FORM5 LDA PBPTR,I   POP 
      LDB .-2         OPERATOR
      ADB PBPTR         FROM TOP
      STB PBPTR           OF STACK
      ALF,ALF       BRANCH
      AND B377        TO
      ADA ARBAS         APPROPRIATE 
      JMP 0,I             ROUTINE 
*                                         * 
**  STACK CONSTANT OR PARAMETER ADDRESS  ** 
*                                         * 
* 
*  FOR NUMERICAL CONSTANTS STACK A POINTER TO THE VALUE 
*  EMBEDDED IN THE PROGRAM, FOR PARAMETERS STACK THE
*  PARAMETER ADDRESS. 
* 
FORM6 ELA,CLE,ERA   ERASE FLAG BIT
      SZA           CONSTANT? 
      JMP FORM7     NO
      LDB TEMP1     YES,
      ISZ TEMP1       STACK 
      ISZ TEMP1         ADDRESS 
      JMP FORM2-1 
FORM7 STA TEMP2     PRE-
      AND .+17B       DEFINED 
      CPA .+17B         FUNCTION? 
      JMP *+3       YES 
      LDB OPTRQ,I   NO, STACK 
      JMP FORM2-1     PARAMETER ADDRESS 
* 
*  FOR FUNCTIONS RECURSION ON FORMX EVALUATES THE PARAMETER 
*  AND, FOR PROGRAMMER DEFINED FUNCTIONS, THE VALUE.
*  FUNCTION VALUES ARE LEFT ON THE TEMPORARY STACK AND A
*  POINTER THERETO IS PLACED ON THE OPERAND STACK.
*  'LEN' IS HANDLED IN A SPECIAL WAY. 
* 
*                                   * 
**  EVALUATE PRE-DEFINED FUNCTION  ** 
*                                   * 
      XOR TEMP2     IDENTIFY
      ALF,ALF 
      ALF             FUNCTION
      CPA .+15B     'LEN' ? 
      JMP FOR12     YES 
      ADA PDFBS     NO, STACK 
      JSB PSHST       JUMP TO 
      STA PBPTR,I       ENTRY POINT 
      LDA FORMX     SAVE FORMX
      STA OPDST,I     RETURN ADDRESS
      JSB FORMX     EVALUATE ARGUMENT 
      JSB STTOP     BRANCH TO 
      JMP PBPTR,I     SUBROUTINE
      SKP 
*                                          *
**  EVALUATE PROGRAMMER-DEFINED FUNCTION  **
*                                          *
FORM8 LDA 1,I       LOAD ADDRESS OF FORMULA 
      JSB PSHST     SAVE VALUE OF 
      LDB TMPST       CURRENT POINTER TO
      STB PBPTR,I       TEMPORARY STACK 
      JSB PSHST     SAVE ADDRESS OF 
      STA PBPTR,I     DEFINING FORMULA
      LDA FORMX     SAVE FORMX
      STA OPDST,I     RETURN ADDRESS
      JSB FORMX     EVALUATE ARGUMENT 
      LDA OPDST,I   SWAP
      LDB OPTRQ,I     OLD AND NEW 
      STB OPDST,I       ARGUMENT
      STA OPTRQ,I         ADDRESSES 
      CPA TMPST     PROTECT PARAMETER 
      JSB RSCHK       ON TEMPORARY STACK
      LDA TEMP1     SWAP ADDRESSES
      LDB PBPTR,I     OF CURRENT
      STB TEMP1         AND FUNCTION
      STA PBPTR,I         FORMULAS
      JSB FORMX     EVALUATE FUNCTION 
      LDB OPDST,I   POP 
      LDA .-2         OPERAND 
      ADA OPDST         STACK,
      STA OPDST           SAVING
      LDA OPDST,I           RESULT ADDRESS
      STA OPTRQ,I             AND ADDRESS OF
      STB OPDST,I               OLD PARAMETER 
      LDA PBPTR,I   RESTORE 
      STA TEMP1       FORMULA POINTER 
      LDA PBPTR     POP 
      ADA .-2         OPERATOR
      STA PBPTR         STACK 
      LDA PBPTR,I   RESTORE ORIGINAL
      STA TMPST       TEMPORARY STACK POINTER 
      JSB STTOP     LOAD FUNCTION RESULT
*                               * 
**  RECORD RESULT OF FUNCTION  ** 
*                               * 
* 
*  PRE-DEFINED FUNCTIONS RETURN TO THIS POINT WITH THEIR
*  RESULT IN (A) AND (B). 
* 
FOR10 DST TMPST,I   SAVE RESULT 
      LDA OPDST,I   RESTORE FORMX 
      STA FORMX       RETURN ADDRESS
      LDA TMPST     RECORD LOCATION 
      STA OPDST,I     OF RESULT 
      LDB PBPTR     POP 
      ADB .-2         FUNCTION
      STB PBPTR         ADDRESS 
      ISZ TEMP1       OF RESULT 
      ISZ TEMP1         ON TOP OF 
      JMP FORM2           OPERAND STACK 
*                    *
**  EVALUATE 'LEN'  **
*                    *
FOR12 JSB RSCHK     CREATE SPACE ON TEMPORARY STACK 
      LDA TEMP1,I   FIND
      AND OPDMK       STRING'S
      ADA .-1           SYMBOL
      ALS                 TABLE 
      ADA SYMTB             ENTRY 
      INA           LOAD ADDRESS
      LDA 0,I         OF STRING 
      ADA .-1       EXTRACT 
      LDA 0,I         STRING
      AND B377          LENGTH
      FLT           STACK                        [B]
      DST TMPST,I     STRING LENGTH 
      LDA TMPST     STACK ADDRESS 
      STA OPDST,I     OF RESULT 
      JMP FOR12-3 
*                             * 
**  PROCESS STRING CONSTANT  ** 
*                             * 
* 
*  WHEN STRING CONSTANTS ARE STACKED, AN APPROPRIATE
*  ENTRY IS PLACED ON THE TEMPORARY STACK SO THAT ALL 
*  STRING OPERANDS HAVE THE SAME FORM:  A NEGATED BASE
*  ADDRESS ON THE OPERAND STACK AND A TWO WORD ENTRY ON 
*  THE TEMPORARY STACK CONTAINING THE START-OF-STRING 
*  AND END-OF-STRING DESIGNATORS BIASED BY -1 (DEFAULT
*  START-OF-STRING DESIGNATORS HAVE A STACK VALUE OF 0, 
*  DEFAULT END-OF-STRING DESIGNATORS HAVE A STACK VALUE 
*  OF -1).  IN THE CASE OF SUBSCRIPTED STRING VARIABLES,
*  THE TEMPORARY IS CREATED WHEN THE ']' IS SCANNED; THE
*  ENTRY FOR NON-SUBSCRIPTED STRING OPERANDS IS CREATED 
*  WHEN THEY ARE SCANNED. 
* 
FOR13 CLA,INA       PRINT STATEMENT 
      CPA EOL         STRING CONSTANT?
      JSB STSTR     NO, STACK STRING CONSTANT 
      JMP FORM3     EXECUTE END-OF-FORMULA
      SKP 
*                                *
**  RECORD RESULT OF OPERATION  **
*                                *
* 
*  OPERATORS CREATING INTERMEDIATE RESULTS RETURN TO HERE.
* 
FOR14 ISZ OPDST     STACK 
      ISZ OPDST       TEMPORARY 
      DST TMPST,I       RESULT
      LDA TMPST     SAVE
      STA OPDST,I     ADDRESS ON
      JMP FORM4         OPERAND STACK 
*                            *
**  EXIT FORMULA EVALUATOR  **
*                            *
* 
*  THIS WORD IS ACTUALLY PART OF THE FORMULA OPERATOR JUMP
*  TABLE.  THE WORDS BETWEEN IT AND FOJT CORRESPOND TO
*  OPERATORS WHICH ARE NOT EXECUTED, SO CODE IS INSERTED HERE 
*  TO UTILIZE THIS SPACE. 
* 
      DEF FORMX,I 
**                        **
***  SET LOGICAL VALUES  ***
**                        **
FALSE CLA           LOAD
      CLB             ZERO
      JMP FOR14 
TRUE  LDA HALF      LOAD
      LDB .+2         1.0 
      JMP FOR14 
**                     ** 
***  EXECUTE UNARY -  *** 
**                     ** 
EUMIN JSB STTOP     UNSTACK AND LOAD TOP OF STACK 
      JSB ARINV     NEGATE IT 
      JMP FOR14     STORE IT
**                                 ** 
***  FORMULA OPERATOR JUMP TABLE  *** 
**                                 ** 
FOJT  DEF ELBRC     [ 
      DEF FORM1     ( 
      DEF FORM4     UNARY + 
      DEF EUMIN     UNARY - 
      DEF ESCMA     SUBSCRIPT COMMA 
      DEF ESTR      ASSIGNMENT OPERATOR 
      DEF EFAD      + 
      DEF EFSB      - 
      DEF EFMP      * 
      DEF EFDV      / 
      DEF EPWR      ^ 
      DEF EGTRT     > 
      DEF ELST      < 
      DEF ENEQL     # 
      DEF EEQL      = 
      NOP           UNUSED
      DEF EAND      AND 
      DEF EIOR      OR
      DEF EMIN      MIN 
      DEF EMAX      MAX 
      DEF ENEQL     <>
      DEF EGORE     >=
      DEF ELORE     <=
      DEF ENOT      NOT 
**                          **
***  EXECUTE LEFT BRACKET  ***
**                          **
* 
*  LOAD A DEFAULT SECOND SUBSCRIPT AND ENTER THE CODE FOR 
*  A SUBSCRIPT COMMA. 
* 
ELBRC LDA OPDST     LOAD
      ADA .-2         -1
      LDA 0,I           FOR A 
      CCB                 STRING, 
      SSA,RSS               0 
      CLB                     FOR 
      JMP ESCM1                 AN ARRAY
**                             ** 
***  EXECUTE SUBSCRIPT COMMA  *** 
**                             ** 
* 
*  BOTH SUBSCRIPTS ARE ROUNDED TO INTEGERS AND TESTED TO BE 
*  POSITIVE.  FOR STRINGS, THE TWO INTEGERS ARE SAVED ON THE
*  TEMPORARY STACK AS A PSUEDO-ENTRY LATER USED BY PSTR.  FOR 
*  ARRAYS, THE SUBSCRIPTS ARE CHECKED AND IF WITHIN THE CURRENT 
*  BOUNDS THEY ARE COMBINED WITH THE BASE ADDRESS OF THE ARRAY. 
*  THE ARRAY ELEMENT ADDRESS THEN REPLACES THE BASE ADDRESS ON
*  THE OPERAND STACK.  UNSUITABLE SUBSCRIPTS EXIT TO THE ERROR
*  ROUTINE. 
* 
ESCMA JSB OPCHK     UNSTACK 
      DLD 1,I         SECOND SUBSCRIPT
      JSB SBFIX     ROUND TO INTEGER
      JSB RERRS+17,I  UNSUITABLE RESULT 
      LDA PBPTR     UNSTACK 
      ADA .-2         THE 
      STA PBPTR         '[' 
ESCM1 STB TEMP4     SAVE RESULT 
      JSB STTOP     POP FIRST SUBSCRIPT 
      JSB SBFIX     ROUND TO INTEGER
      JSB RERRS+17,I  UNSUITABLE RESULT 
      STB TMPST,I   STORE IN TEMPORARY STACK
      LDA OPDST,I   STRING
      SSA,RSS         VARIABLE? 
      JMP ESCM2     NO, ARRAY VARIABLE
      LDA TMPST     YES,
      INA             SAVE
      LDB TEMP4         SECOND SUBSCRIPT IN 
      STB 0,I             TEMPORARY STACK 
      JMP FORM1 
ESCM2 ADA .-2       LOAD COLUMN 
      DLD 0,I         AND ROW BOUNDS
      CMA,INA       IS SPECIFIED
      ADA TMPST,I     ROW 
      SSA,RSS           LEGAL?
      JSB RERRS+17,I  NO
      STB TEMP5     YES 
      CMB,INB       IS SPECIFIED
      ADB TEMP4       COLUMN
      SSB,RSS           LEGAL?
      JSB RERRS+17,I  NO
      LDA TMPST,I   YES, COMPUTE ROW
      MPY TEMP5       DISPLACEMENT
      ADA TEMP4     ADD COLUMN DISPLACEMENT 
      ALS           DOUBLE FOR CORE WORDS 
      ADA OPDST,I   STORE ACTUAL
      STA OPDST,I     ELEMENT ADDRESS 
      LDA TMPST     POP UNUSED
      ADA .-2         TEMPORARY 
      STA TMPST         STACK 
      JMP FORM1           ENTRY 
