
**                   ** 
***  EXECUTE STORE  *** 
**                   ** 
* 
*  IN ORDER TO ALLOW MULTIPLE ASSIGNMENT STATEMENTS, NO 
*  ASSIGNMENT CAN TAKE PLACE UNTIL THE RIGHT-HAND FORMULA 
*  IS EVALUATED; I.E. ONLY AN END-OF-FORMULA OPERATOR CAN 
*  FORCE AN ASSIGNMENT OPERATOR OFF OF THE STACK.  ASSIGNMENTS
*  MAY BE NUMERICAL TO NUMERICAL TYPE OPERAND, IN WHICH CASE
*  THE ASSIGNED QUANTITY IS SAVED FOR POSSIBLE ADDITIONAL 
*  ASSIGNMENTS; OR STRING TO STRING OPERAND.  IN THE LATTER 
*  CASE AN INTERMEDIATE STRING IS NECESSARY IF THE HEAD OF
*  THE DESTINATION STRING LIES IN THE TAIL OF THE ACTUAL
*  SOURCE STRING. 
* 
ESTR  LDB TEMP2     NEXT OPERATOR AN
      SZB             END-OF-FORMULA? 
      JMP ESTR5     NO
      CPB TEMP3     YES, FIRST STORE OF FORMULA?
      JMP ESTR2     YES 
ESTR1 LDA OPDST,I   NO, SET 
      STA TEMP6       DESTINATION ADDRESS 
      DLD TEMP3,I   TRANSFER
      DST TEMP6,I     THE NUMBER
      LDA OPDST     UNSTACK 
      ADA .-2         DESTINATION 
      STA OPDST         OPERAND 
      JMP FORM4 
ESTR2 LDA OPDST,I   STRING
      SSA             OPERANDS? 
      JMP ESTR3     YES 
      JSB OPCHK     NO, UNSTACK SOURCE
      STB TEMP3       AND SAVE VALUE ADDRESS
      JMP ESTR1 
ESTR3 LDA .-2       PREPARE 
      JSB PSTR        SOURCE
      STA TEMP4         STRING
      STB TPRME 
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDB PBPTR     SAVE CORE 
      STB EST1        POINTER 
      LDA TEMP4     TRANSFER
      CMA             TO
      ADA TEMP5         HIGHER
      SSA                 CORE? 
      JMP ESTR4     NO
      ADA TPRME     YES,
      ADA .+2         OVERLAPPING 
      SSA,RSS           TRANSFER? 
      JMP ESTR4     NO
      LDA TEMP5     YES, SAVE 
      STA EST2        DESTINATION ADDRESS 
      INB           SET DESTINATION 
      BLS             ADDRESS TO START
      STB TEMP5         OF FREE CORE
      LDA TNULL     SAVE TRANSFER 
      STA EST3        LENGTH
      CMA,INA       ALLOCATE
      ARS             SPACE FOR 
      JSB CUSP          INTERMEDIATE
      STA PBPTR           STRING
      LDA FSCHA 
      JSB TRSTR     TRANSFER STRING TO FREE CORE
      LDA EST3      RESTORE TRANSFER
      STA TNULL       LENGTH
      STA TPRME     RESET ACTUAL SOURCE LENGTH
      LDA EST1      SET SOURCE
      INA             ADDRESS TO
      ALS               INTERMEDIATE
      STA TEMP4           STRING
      LDA EST2      RESTORE ORIGINAL
      STA TEMP5       DESTINATION STRING
ESTR4 LDA FSCHA 
      JSB TRSTR     COMPLETE TRANSFER 
      LDA EST1      RESTORE FREE
      STA PBPTR       CORE POINTER
      JMP FORM5     EXECUTE END-OF-FORMULA
ESTR5 ISZ PBPTR     DEFER 
      ISZ PBPTR       EXECUTION 
      LDA BASSO 
      STA PBPTR,I 
      JMP FORM4+6 
* 
BASSO OCT 7402
**               ** 
***  EXECUTE +  *** 
**               ** 
EFAD  JSB BINOP 
      JSB .FAD
      JMP FOR14 
**               ** 
***  EXECUTE -  *** 
**               ** 
EFSB  JSB BINOP 
      JSB .FSB
      JMP FOR14 
**               ** 
***  EXECUTE *  *** 
**               ** 
EFMP  JSB BINOP 
      JSB .FMP
      JMP FOR14 
**               ** 
***  EXECUTE /  *** 
**               ** 
EFDV  JSB BINOP 
      JSB .FDV
      JMP FOR14 
**               ** 
***  EXECUTE ^  *** 
**               ** 
*                *
**  REAL POWER  **
*                *
* 
*  EXIT TO ERROR IF BASE IS NEGATIVE.  ELSE COMPUTE 
*  RESULT AS E^(POWER*LN(BASE)).
* 
EPWR  LDB OPDST,I   LOAD
      DLD 1,I         POWER 
      JSB IFIX      INTEGER?
      JMP *+3       NO
      SOS           YES, 16-BIT?
      JMP IPWR      YES 
      JSB BINOP     NO, UNSTACK 
      RSS             ARGUMENTS 
      JSB PCHK      CHECK ARGUMENTS 
      SSA           NEGATIVE BASE?
      JSB RERRS+30,I  YES 
      LDB BINO1     NO, LOAD BASE ADDRESS 
      JSB .LOG      TAKE NATUAL LOG 
      JSB .FMP      MULTIPLY
      DEF BINO2,I     BY POWER
      JSB .EXP      EXPONENTIATE
      JMP FOR14 
*                   * 
**  INTEGER POWER  ** 
*                   * 
* 
*  MULTIPLY BASE REPEATEDLY, USING POWERS-OF-TWO METHOD 
*  TO SPEED PROCESS.  IF POWER IS NEGATIVE, TAKE RECIPROCAL 
*  FOR FINAL RESULT.
* 
IPWR  STB TT1       SAVE SIGN 
      SSB           FORM ABSOLUTE 
      CMB,INB         VALUE OF POWER
      STB TT2       SAVE IT 
      JSB BINOP     UNSTACK 
      RSS             ARGUMENTS 
      JSB PCHK      CHECK ARGUMENTS 
      LDB BINO1     STORE 
      STA BINO1 
      STB BINO2       BASE
      LDA HALF      INITIALIZE
      STA TT3         RESULT
      LDA .+2           TO
      STA TT4             1.0 
IPWR1 LDB TT2       DIVIDE POWER
      SLB,BRS         BY 2
      JMP IPWR4     ODD POWER 
      STB TT2       EVEN POWER
IPWR2 SZB           ZERO? 
      JMP IPWR5     NO
      LDA TT1       YES 
      SSA           POSITIVE POWER? 
      JMP IPWR3     NO
      LDA TT3       YES, RETURN 
      LDB TT4         WITH
      JMP FOR14         RESULT
IPWR3 LDA HALF      TAKE
      LDB .+2         RECIPROCAL
      JSB .FDV          FOR 
      DEF TT3             FINAL 
      JMP FOR14             RESULT
IPWR4 STB TT2       SAVE POWER
      LDA BINO1     LOAD
      LDB BINO2       BASE
      JSB .FMP      MULTIPLY BY 
      DEF TT3         RESULT SO FAR 
      STA TT3       SAVE NEW
      STB TT4         PARTIAL 
      LDB TT2           RESULT
      JMP IPWR2 
IPWR5 LDA BINO1     SQUARE
      LDB BINO2 
      JSB .FMP        BASE
      DEF BINO1 
      STA BINO1     RECORD
      STB BINO2       NEW 
      JMP IPWR1         BASE
      SKP 
**               ** 
***  EXECUTE >  *** 
**               ** 
EGTRT JSB COMPR     COMPARE OPERANDS
      SSA           < ? 
      JMP FALSE     YES 
      JMP ENEQL+1   NO
**               ** 
***  EXECUTE <  *** 
**               ** 
ELST  JSB COMPR     COMPARE OPERANDS
      CMA,RSS       REVERSE COMPARISON SENSE
**                **
***  EXECUTE >=  ***
**                **
EGORE JSB COMPR     COMPARE OPERANDS
      SSA           < ? 
      JMP FALSE     YES 
      JMP TRUE      NO
**               ** 
***  EXECUTE =  *** 
**               ** 
EEQL  JSB COMPR     COMPARE OPERANDS
      SZA           = ? 
      JMP FALSE     NO
      JMP TRUE      YES 
**                **
***  EXECUTE <=  ***
**                **
ELORE JSB COMPR     COMPARE OPERANDS
      SSA           >= ?
      JMP TRUE      NO
      JMP EEQL+1    YES 
**                     ** 
***  EXECUTE # OR <>  *** 
**                     ** 
ENEQL JSB COMPR     COMPARE OPERANDS
      SZA           # ? 
      JMP TRUE      NO
      JMP FALSE     YES 
**                   ** 
***  EXECUTE 'MAX'  *** 
**                   ** 
EMAX  JSB BINOP     SUBTRACT THE
      JSB .FSB        TOP TWO OPERANDS
      SSA,RSS       TOP OPERAND LARGER? 
      JMP ARG1      NO
ARG2  DLD BINO2,I   YES, RETRIEVE 
      JMP FOR14       ITS VALUE 
**                   ** 
***  EXECUTE 'MIN'  *** 
**                   ** 
EMIN  JSB BINOP     SUBTRACT THE
      JSB .FSB        TOP TWO OPERANDS
      SSA,RSS       TOP OPERAND LARGER? 
      JMP ARG2      NO
ARG1  ISZ OPDST     YES,
      ISZ OPDST       RETRIEVE
      LDB OPDST,I       VALUE OF
      DLD 1,I             NEXT-TO-TOP 
      JMP FOR14+2           OPERAND 
**                   ** 
***  EXECUTE 'AND'  *** 
**                   ** 
EAND  JSB BINOP     UNSTACK 
      RSS             OPERANDS
      SZA,RSS       TOP OPERAND ZERO? 
      JMP FALSE     YES 
      LDA BINO2,I   NO, CHECK 
      JMP ENEQL+1     NEXT-TO-TOP OPERAND 
**                  **
***  EXECUTE 'OR'  ***
**                  **
EIOR  JSB BINOP     UNSTACK 
      RSS             OPERANDS
      SZA           TOP OPERAND NON-ZERO? 
      JMP TRUE      YES 
      LDA BINO2,I   NO, CHECK 
      JMP ENEQL+1     NEXT-TO-TOP OPERAND 
**                   ** 
***  EXECUTE 'NOT'  *** 
**                   ** 
ENOT  JSB STTOP     LOAD TOP OPERAND
      JMP EEQL+1    GO TO CHECK 
**                           ** 
***  INSURE VALID POWERING  *** 
**                           ** 
* 
*  INSURES THAT A^B HAS ACCEPTABLE ARGUMENTS.  A=B=0 IS A NON-
*  RECOVERABLE ERROR.  A=0 AND B<0 PRINTS A WARNING MESSAGE AND 
*  RETURNS THE MAXIMUM POSITIVE NUMBER AS THE RESULT. 
* 
#PCHK STB BINO1     LOAD HIGH PART
      LDB BINO2,I     OF POWER
      SZA           BASE ZERO?
      JMP PCHK1     NO
      SZB,RSS       YES, POWER ZERO?
      JSB RERRS+29,I  YES 
      SSB,RSS       NO, POWER POSITIVE? 
      JMP FALSE     YES 
      JSB WERRS+2,I NO
      LDA INF       USE POSITIVE
      LDB .-2         INFINITY
      JMP FOR14         FOR RESULT
PCHK1 SZB,RSS       POWER ZERO? 
      JMP TRUE      YES, TAKE RESULT AS 1.0 
      JMP PCHK,I    NO
      SKP 
**                                   ** 
***  COMPARE TOP OPERANDS OF STACK  *** 
**                                   ** 
* 
*  ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE
*  STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND, 
*  POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL.
* 
#CMPR LDA OPDST,I   STRING
      SSA             ARGUMENTS?
      JMP COMP1     YES 
      JSB BINOP     NO, COMPARE 
      JSB .FSB        NUMERICAL 
      JMP COMPR,I       OPERANDS
COMP1 LDA .-2       PREPARE 
      JSB PSTR        COMPARISON
      STA TEMP4         STRING
      STB TPRME 
      LDA TNULL     SAVE SPECIFIED
      STA CP0         LENGTH
      LDA .-2       PREPARE 
      JSB PSTR        TEST STRING 
      STB CP1       SAVE ACTUAL LENGTH
      ISZ TMPST     RESERVE SPACE 
      ISZ TMPST       FOR RESULT
COMP2 ISZ CP0       MORE SPECIFIED STRING?
      JMP COMP3     YES 
      CLB           NO, LOAD A
      JMP COMP4       NULL CHARACTER
COMP3 JSB FSCH      LOAD NEXT 
      LDA .+40B       COMPARISON
      LDB 0             CHARACTER 
COMP4 ISZ TNULL     MORE SPECIFIED TEST STRING? 
      JMP COMP6     YES 
      CLA           NO, LOAD NULL CHARACTER 
COMP5 CMB,INB       COMPARE 
      ADA 1           CHARACTERS
      SZA,RSS       EXIT ON NOT EQUAL 
      SZB,RSS         OR BOTH NULL
      JMP COMPR,I       CHARACTERS
      JMP COMP2 
COMP6 LDA CP1       MORE ACTUAL 
      INA,SZA         TEST STRING?
      JMP COMP7     YES 
      LDA .+40B     NO, LOAD A BLANK
      JMP COMP5 
COMP7 STA CP1 
      LDA TEMP5     EXTRACT 
      CLE,ERA 
      LDA 0,I         NEXT
      SEZ,RSS 
      ALF,ALF           TEST
      AND B377
      ISZ TEMP5           CHARACTER 
      JMP COMP5 
      SKP 
**                           ** 
***  PREPARE STRING OPERAND  ** 
**                           ** 
* 
*  THE STRING ADDRESS ON TOP OF THE OPERAND STACK IS COMBINED 
*  WITH THE SUBSCRIPTS IN A PSUEDO-ENTRY ON THE TEMPORARY STACK 
*  TO FORM A STRING OPERAND.  (A) = -2 UPON ENTRY FOR A SOURCE
*  STRING; (A) = -1 FOR A DESTINATION STRING.  THE ADDRESS OF 
*  THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMP5;
*  FOR SOURCE STRINGS (A) = TEMP5 UPON EXIT.  THE REQUESTED 
*  STRING LENGTH (IN CHARACTERS) IS LEFT IN TNULL; FOR SOURCE 
*  STRINGS THE ACTUAL STRING LENGTH (WHICH MAY BE LESS THAN THE 
*  REQUESTED LENGTH) IS IN (B) UPON EXIT.  THE FOLLOWING
*  CONDITIONS EXIT TO ERROR:  NEGATIVE STRING LENGTH, REQUESTED 
*  DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR 
*  REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY 
*  WITH TWO UNCONNECTED PARTS.  THE LOGICAL LENGTH OF A 
*  DESTINATION STRING IS ADJUSTED AS NEEDED.
* 
#PSTR STA PS0       SAVE MODE FLAG
      JSB OPCHK     UNSTACK OPERAND 
      STB PS1       SET FLAG POSITIVE 
      BLS           SAVE ADDRESS OF FIRST 
      STB TEMP5       CHARACTER OF STRING 
      BRS           SAVE
      ADB .-1         POINTER TO
      STB TEMP6         STRING LENGTH 
      LDB TMPST     LOAD
      ADB .+2         START-OF-STRING 
      LDA 1,I           DESIGNATOR
      STA MPT       SAVE IT 
      ADA TEMP5     RECORD CHARACTER ADDRESS
      STA TEMP5       OF START-OF-STRING
      STA SBPTR     SAVE ADDRESS
      INB           LOAD
      LDA 1,I         END-OF-STRING DESIGNATOR
      INA,SZA       SPECIFIED?
      JMP PSTR2     YES 
      CCA           NO
      CPA PS0       'SOURCE' MODE?
      JMP PSTR1     NO
      LDA TEMP6,I   YES, LOAD STRING'S
      AND B377        LOGICAL LENGTH
      JMP PSTR2 
PSTR1 STA PS1       SET FLAG TO -1
      LDA TPRME     COMPUTE 
      CMA             END-OF-STRING 
      ADA MPT           DESIGNATOR
PSTR2 STA NQT       SAVE IT 
      CMA           IS LENGTH 
      ADA MPT         OF SPECIFIED STRING 
      SSA,RSS           NEGATIVE? 
      JSB RERRS+18,I  YES 
      STA TNULL 
      ADA .73      >72? 
      SSA 
      JSB RERRS+20,I
      LDA TEMP6,I   DOES
      AND B377        START-OF-STRING 
      CMA               CHARACTER 
      ISZ PS0             RELATE TO 
      INA                   PREVIOUS
      ADA MPT                 VALUE 
      SSA,RSS                   OF STRING?
      JMP PSTR3     NO
      LDA TEMP6,I   YES, EXTRACT
      ISZ PS0         END-OF- 
      ALF,ALF           PERMITTED-STRING
      AND B377            DESIGNATOR
      CMA           COMPUTE DIFFERENCE FROM 
      ADA NQT         END OF SPECIFIED STRING -1
      CLB,INB       'SOURCE'
      CPB PS0         MODE? 
      JMP PSTR5     NO
      LDB TNULL     YES, SPECIFIED SOURCE STRING
      INA             CONTAINED WITHIN
      SSA,RSS           DEFINED SOURCE STRING?
      ADB 0         NO, CORRECT LENGTH
      JMP PSTR4       OF ACTUAL SOURCE STRING 
PSTR3 ISZ PS0       'SOURCE' MODE?
      JSB RERRS+19,I  NO
      CCB           YES, SET ACTUAL LENGTH TO 0 
PSTR4 LDA TEMP5     LOAD START-OF-STRING
      JMP PSTR,I      CHARACTER ADDRESS 
PSTR5 SSA,RSS       PHYSICAL STORAGE OVERFLOW?
      JSB RERRS+20,I  YES 
      ISZ PS1       END-OF-STRING SPECIFIED?
      JMP PSTR7     YES 
PSTR6 LDA TEMP6,I   NO, 
      AND M256        RESET 
      IOR NQT           LOGICAL LENGTH
      STA TEMP6,I         OF STRING 
      JMP PSTR,I
PSTR7 LDA TEMP6,I   IS NEW
      AND B377        DESTINATION 
      CMA               STRING
      ADA NQT             LONGER
      SSA,RSS               THAN OLD? 
      JMP PSTR6     YES 
      JMP PSTR,I    NO
**                           ** 
***  STACK STRING CONSTANT  *** 
**                           ** 
* 
*  SEE NOTE AT FOR13 OF ROUTINE FORMX 
* 
#STST ISZ OPDST     STACK 
      ISZ OPDST       NEGATIVE
      LDA TEMP1         OF
      CMA                 STRING
      STA OPDST,I           ADDRESS 
      LDA TEMP1,I   COMPUTE 
      AND B377        STRING
      CCB               LENGTH
      ADB 0               -1
      ADA .+3       UPDATE
      ARS             INTRA-STATEMENT 
      ADA TEMP1          POINTER
      STA TEMP1           PAST STRING 
      JSB RSCHK     CREATE TEMPORARY
      CLA           RECORD
      DST TMPST,I     (0,(B) )
      JMP STSTR,I 
**                            **
***  FETCH SOURCE CHARACTER  ***
**                            **
* 
*  CHARACTER ADDRESS IN TEMP4, SOURCE CHARACTER COUNT 
*  IN TPRME (IN 1'S COMPLEMENT).  EXIT TO (P+1) ON NO 
*  MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH 
*  NEXT CHARACTER IN (A). 
* 
#FSCH LDA TPRME     MORE
      INA,SZA,RSS     CHARACTERS? 
      JMP FSCH,I    NO
      STA TPRME     YES, UPDATE CHARACTER COUNT 
      LDA TEMP4     LOAD CHARACTER
      CLE,ERA         ADDRESS 
      LDA 0,I       EXTRACT 
      SEZ,RSS         NEXT
      ALF,ALF           CHARACTER 
      AND B377
      ISZ TEMP4     UPDATE CHARACTER ADDRESS
      ISZ FSCH
      JMP FSCH,I
**                                         ** 
***  FETCH SOURCE CHARACTER (UPPER CASE)  *** 
**                                         ** 
* 
*  SAME AS FSCH, EXCEPT LOWER CASE CHARACTERS ARE CONVERTED TO
*  UPPER CASE.  USED BY CHAIN AND ASSIGN STATEMENTS.
* 
#FCUC LDA TPRME     MORE
      INA,SZA,RSS     CHARACTERS? 
      JMP FCUC,I    NO
      STA TPRME     YES, UPDATE CHARACTER COUNT 
      LDA TEMP4     LOAD CHARACTER
      CLE,ERA         ADDRESS 
      LDA A,I       EXTRACT 
      SEZ,RSS         NEXT
      ALF,ALF           CHARACTER 
      AND B377
      ADA M96 
      SSA,RSS       LOWER CASE
      ADA M32       NO
      ADA .140      YES 
      ISZ TEMP4     UPDATE CHARACTER ADDRESS
      ISZ FCUC
      JMP FCUC,I
**                           ** 
***  FETCH INPUT CHARACTER  *** 
**                           ** 
* 
*  EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A).
*  IF THE CHARACTER IS A " OR THE INPUT RECORD IS EMPTY,
*  EXIT TO TRSTR,I (THE ONLY CALLER WHO CAN ENCOUNTER THIS
*  CONDITION).
* 
#FINC ISZ FINCH 
      JSB GETCR     FETCH NEXT CHARACTER
      JMP TRSTR,I   NONE IN BUFFER
      LDA B         ALLOW LOWER CASE
      CPA .+42B     " ? 
      JMP TRSTR,I   YES, TERMINAL EXIT
      JMP FINCH,I   NO
      SKP 
**                           ** 
***  FETCH ENTER CHARACTER  *** 
**                           ** 
* 
*  SAME AS FINCH EXCEPT IT DOES NOT CHECH FOR A QUOTE 
* 
#FENC ISZ FENCH 
      JSB GETCR     FETCH NEXT CHARACTER
      JMP TRSTR,I   NONE IN BUFFER
      LDA B         ALLOW LOWER CASE
      JMP FENCH,I   CHARACTER FOUND 
**                        **
***  FETCH TOP OF STACK  ***
**                        **
* 
*  EXIT WITH TOP OPERAND IN (A) AND (B) AFTER UNSTACKING
*  IT.  CREATE EMPTY SPACE ON TEMPORARY STACK FOR FUTURE
*  INTERMEDIATE RESULT. 
* 
#STTP JSB OPCHK     UNSTACK OPERAND 
      JSB RSCHK     CREATE SPACE FOR TEMPORARY
      DLD 1,I       LOAD TOP OPERAND
      JMP STTOP,I 
**                               ** 
***  EXECUTE A BINARY OPERATOR  *** 
**                               ** 
* 
*  ON ENTRY (P+1) CONTAINS A SUBROUTINE CALL FOR A BINARY 
*  OPERATION.  THE TOP TWO OPERANDS ON THE STACK ARE
*  UNSTACKED AND VERIFIED AS NOT BEING 'UNDEFINED.'  THE
*  APPROPRIATE SUBROUTINE IS CALLED WITH THE TOP ARGUMENT'S 
*  ADDRESS IN BINO2 AND THE NEXT-TO-TOP ARGUMENT'S VALUE IN 
*  (A) AND (B).  EXIT IS TO (P+2) WITH THE RESULT IN (A)
*  AND (B). 
#BNOP LDA BINOP,I   SAVE
      STA BINO1       SUBROUTINE
      ISZ BINOP         CALL
      JSB OPCHK     SAVE ADDRESS OF 
      STB BINO2       TOP OPERAND 
      JSB STTOP     FETCH NEXT OPERAND
      JMP BINO1     EXECUTE SUBROUTINE
**                                  **
***  VERIFY LEGITIMACY OF OPERAND  ***
**                                  **
* 
*  THE VALUE REFERENCED BY THE TOP OF THE OPERAND STACK 
*  IS CHECKED.  EXIT TO ERROR IF VALUE IS 'UNDEFINED.'
*  ELSE REMOVE OPERAND ADDRESS FROM STACK AND REMOVE VALUE
*  FROM TOP OF TEMPORARY STACK, IF IT IS THERE.  EXIT 
*  WITH OPERAND ADDRESS IN (B). 
* 
#OPCK LDB OPDST,I   STRING
      SSB             OPERAND?
      JMP OPCH3-1   YES 
      LDA 1,I       NO, HIGH PART OF
      RAL,RAL       IS
      INA             OPERAND 
      RAR,SLA           NORMALIZED? 
      JMP OPCH1     YES 
      CPA BIT15     WAS FIRST WORD ZERO 
      INB,RSS       YES 
      JSB RERRS+23,I NO--ERROR
      LDA 1,I       SECOND
      SZA             WORD ZERO?
      JSB RERRS+23,I NO--ERROR
      ADB .-1       YES--RESTORE OPERAND ADDRESS
OPCH1 CPB TMPST     TEMPORARY?
      JMP OPCH3     YES 
OPCH2 LDA OPDST     NO, 
      ADA .-2         UNSTACK 
      STA OPDST         OPERAND 
      JMP OPCHK,I         ADDRESS 
      CMB,INB       SET ADDRESS TRUE
OPCH3 LDA TMPST     UNSTACK 
      ADA .-2         TEMPORARY 
      STA TMPST         OPERAND 
      JMP OPCH2 
**                                              **
***  ALLOCATE AN ENTRY ON THE TEMPORARY STACK  ***
**                                              **
* 
*  (B) IS UNCHANGED UPON EXIT.  ON STACK OVERFLOW,
*  THE OPERATOR AND OPERAND STACKS ARE MOVED TO HIGHER
*  CORE TO MAKE ROOM FOR FIVE MORE TEMPORARY ENTRIES. 
* 
#RSCK LDA TMPST     ADVANCE 
      ADA .+2         POINTER TO
      STA TMPST         NEXT ENTRY
      INA           STACK 
      CPA OPTRQ       OVERFLOW? 
      RSS           YES 
      JMP RSCHK,I   NO
      STB RT0       SAVE (B)
      LDB PBPTR     LOAD SOURCE ADDRESS 
      LDA .+10      ALLOCATE SPACE FOR
      JSB CUSP        FIVE MORE 
      STA PBPTR         TEMPORARIES 
      STA RT1       SAVE DESTINATION ADDRESS
RSCH1 LDA 1,I       TRANSFER
      STA RT1,I       A WORD
      CPB TMPST     DONE? 
      JMP RSCH2     YES 
      CCA           NO, DECREMENT 
      ADA RT1         DESTINATION 
      STA RT1           AND SOURCE
      ADB .-1             ADDRESSES 
      JMP RSCH1 
RSCH2 LDA OPDST     CORRECT 
      ADA .+10
      STA OPDST       STACK 
      LDA OPTRQ 
      ADA .+10          POINTERS
      STA OPTRQ 
      LDB RT0       RESTORE (B) 
      JMP RSCHK,I 
**                              **
***  PUSH DOWN OPERATOR STACK  ***
**                              **
* 
*  ALLOCATE AN ENTRY ON THE OPERATOR STACK.  (A) IS 
*  NOT CHANGED. 
* 
#PSHS LDB PBPTR     ADVANCE 
      ADB .+2       STACK POINTER 
      CMB           USER
      ADB LWAUS       SPACE 
      SSB               OVERFLOW? 
      JSB RERRS+10,I  YES 
      ISZ PBPTR     NO, ALLOCATE
      ISZ PBPTR       STORAGE 
      JMP PSHST,I 
