**                                       ** ***  PROCESS NEXT STATEMENT OF PROGRAM  *** **                                       ** * *  USED BY CMPLE AND DCMPL TO SCAN THROUGH THE PROGRAM. *  A 'JSB PRNST' INITIALIZES THE SCAN: (P+1) IS A POINTER *  TO THE CODE FOR HANDLING THE END-OF-STATEMENT CONDITION; *  .LNUM HOLDS THE SEQUENCE NUMBER OF THE STATEMENT BEING *  PROCESSED; SPTR POINTS TO THE WORD OF THE PROGRAM BEING*  PROCESSED.  PRNST HANDLES <REM STATEMENT>, <DATA STATEMENT>, *  STRING CONSTANTS, NULL OPERANDS, NUMERICAL CONSTANTS, AND*  <FILES STATEMENT>.  OTHER CASES EXIT TO (P+2).  PRNST IS *  RE-ENTERED DIRECTLY, LEAVING THE INITIALIZED EXIT ADDRESSES*  UNCHANGED THROUGHOUT PROCESSING OF THE PROGRAM.* #PNST LDA PRNST,I   SET POINTER TO      STA STEND       END-OF-STATEMENT      ISZ PRNST         PROCESSING ROUTINE      CCA           SET FLAG TO SHOW NO       STA VALTB       <FILES STATEMENT>       LDB PBUFF     INITIAL PROGRAM POINTER PRNS1 STB SPTR      SET PROGRAM POINTER TO STATEMENT      LDA SPTR,I    SAVE STATEMENT      STA .LNUM       SEQUENCE NUMBER       ISZ SPTR      COMPUTE       ADB SPTR,I      LENGTH      STB NSPTR     SAVE POINTER TO NEXT STATEMENT      ISZ SPTR      EXTRACT       LDA SPTR,I      STATEMENT       AND OPMSK         TYPE      STA STYPE     SAVE IT       CPA REMOP     'REM' ?       JMP PRNS2+2   YES       CPA DATOP     NO, DATA?       JMP PRNS2+2   YES       CPA FILOP     NO, <FILES STATEMENT> ?       RSS           YES       JMP PRNS2+1   NO      LDA SPTR      ISZ VALTB     SECOND <FILES STATEMENT> ?      JMP *+4       YES       ADA .-2       NO, SAVE POINTER TO       STA VALTB       <FILES STATEMENT>       JMP PRNS2+2       STB SPTR      SET POINTER TO NEXT STATEMENT       JSB DCMPL       LDB SYMTB     RESTORE NULL      STA SYMTB       SYMBOL TABLE ( (A) = 0 )      STB PBPTR     REDUCE SWAP AREA TO PROGRAM       JSB RERRS+34,I  EXTRA <FILES STATEMENT> *                                    ***  PROCESS NEXT WORD OF STATEMENT  ***                                    *PRNS2 ISZ SPTR      MOVE TO       LDB SPTR        NEXT WORD       CPB FILTB     DECOMPILE FINISHED?       JMP DCMP3     YES       CPB NSPTR     NO, STATEMENT FINISHED?       JMP STEND,I   YES       LDA SPTR,I    NO, ISOLATE       AND OPMSK       OPERATOR      CPA B1000     " ?       JMP PRNS3     YES       XOR SPTR,I    NO, GET OPERAND       SZA,RSS       NULL OPERAND?       JMP PRNS2     YES       RAL,CLE,ERA   NO, PUT FLAG BIT IN (E)       SZA,RSS       NUMBER?       JMP CMPL7     YES       JMP PRNST,I   NOPRNS3 XOR SPTR,I    EXTRACT LENGTH      ADA .+3       COMPUTE       ARS             POINTER       ADA SPTR          TO CLOSING      STA SPTR            QUOTE       JMP PRNS2+1 **                        *****  'COMPILE' A SYMBOL  *****                        *** *  ENTER WITH A SYMBOLIC NAME IN STMP1 AND SEARCH THE *  SYMBOL TABLE FOR A MATCHING ENTRY.  IF NO ENTRY IS *  FOUND, APPEND A NEW TWO WORD ENTRY WITH THE SYMBOL *  IN THE FIRST WORD AND 0 IN THE SECOND.  THE SYMBOL IN*  THE PROGRAM IS REPLACED WITH THE ORDINAL NUMBER OF *  ITS SYMBOL TABLE ENTRY.  EXIT WITH THE NEW PROGRAM *  WORD IN (A), A POINTER TO THE SECOND WORD OF THE *  TABLE ENTRY IN STMP2, AND THE STATEMENT TYPE IN (B). * #SSYM LDA .+4       INSURE SPACE      JSB CUSP        FOR NEW ENTRY       LDA STMP1     RETRIEVE SYMBOL       LDB SYMTB SYMT1 CPB PBPTR     SYMBOL TABLE EXHAUSTED?       JMP SYMT3     YES       CPA 1,I       NO, IS NEXT SYMBOL A MATCH?       JMP SYMT5     YES       ADB .+2       NO, MOVE      JMP SYMT1       TO NEXT ENTRY *                                   * **  HANDLE UNMATCHED ARRAY SYMBOL  ** *                                   * SYMT2 CPA STMP1     "DON'T KNOW" SYMBOL?      RSS           YES       JMP SYMT3     NO, MAKE NORMAL TABLE ENTRY       ISZ PBPTR     ALLOCATE SPACE      ISZ PBPTR       FOR NEW ENTRY       LDA STMP2     WAS A SINGLE OR DOUBLE      INA,SZA         SUBSCRIPTED ENTRY FOUND?      JMP SYMT4     YES, INCLUDE POINTER IN ENTRY       STA 1,I       NO, SAVE SPACE FOR LATER ENTRY      ADB .+2         WITH NUMBER OF DIMENSIONS       SKP *                              ***  CREATE A NEW TABLE ENTRY  ***                              *SYMT3 ISZ PBPTR     ALLOCATE SPACE      ISZ PBPTR       FOR NEW ENTRY       CLA           INITIALIZESYMT4 INB             SECOND      STA 1,I           WORD      ADB .-1       PUT SYMBOL      LDA STMP1       IN FIRST      STA 1,I           WORD*                            ***  'COMPILE' PROGRAM WORD  ***                            *SYMT5 INB           COMPUTE       STB STMP2       CMB             RELATIVE      ADB SYMTB       CMB,INB           ADDRESS       BRS       LDA SPTR,I    REPLACE SYMBOL      AND OPMSK       IN PROGRAM      IOR 1             WITH RELATIVE       STA SPTR,I          ADDRESS       LDB STYPE     LOAD STATEMENT TYPE       JMP SSYMT,I **                          *****  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 ASSYMT7 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 **                                *****  INSURE SPACE FOR NEW ENTRY  *****                                *** *  A CHECK IS MADE THAT THE UNUSED USER SPACE IS AT *  LEAST AS LARGE AS THE NUMBER OF WORDS SPECIFIED BY *  (A).  EXIT TO ERROR IF NOT SO.  (B) IS NOT CHANGED.*  ON NORMAL EXIT (A) CONTAINS ITS ENTRY VALUE + (PBPTR). * #CUSP ADA PBPTR     AT LEAST      STA CU1         (A) WORDS       CMA               OF AVAILABLE      ADA LWAUS           USER      SSA,RSS               SPACE?      JMP *+3       YES       JSB DCMPL     NO, DECOMPILE       JSB RERRS+10,I  OUT OF STORAGE      LDA CU1       RETURN WITH NEW       JMP CUSP,I      VALUE OF PBPTR      HED PRINT NAME TABLE**                                                 ** ***  PRINT NAME TABLE FOR MULTICHARACTER SYMBOLS  *** **                                                 ** * *  BITS 15-9 OF THE 'OCT' WORD ARE THE BASIC OPERATOR *  CODES OF THE SYMBOLS.  BITS 2-0 ARE THE LENGTH IN*  CHARACTERS OF THE SYMBOLS.  THE ASCII VERSION (PRINT *  NAME) FOLLOWS. * *                                    ***  MULTICHARACTER BINARY OPERATORS  ** *                                    *MCBOS OCT 36003     AND       ASC 1,AN      OCT 42000       OCT 37002     OR      ASC 1,OR      OCT 40003     MIN       ASC 1,MI      OCT 47000       OCT 41003     MAX       ASC 1,MA      OCT 54000 MRELS OCT 42002     UNEQUAL       ASC 1,<>      OCT 43002     GREATER THAN OR EQUAL       ASC 1,>=      OCT 44002     LESS THAN OR EQUAL      ASC 1,<=*                                   * **  MULTICHARACTER UNARY OPERATOR  ** *                                   * NOT   OCT 45003       ASC 1,NO      OCT 52000 *                     * **  STATEMENT TYPES  ** *                     * STYPS OCT 46003     LET       ASC 1,LE      OCT 52000       OCT 47003     DIM       ASC 1,DI      OCT 46400       OCT 50003     DEF       ASC 1,DE      OCT 43000       OCT 51003     REM       ASC 1,RE      OCT 46400       OCT 52004     GOTO      ASC 2,GOTO      OCT 53002     IF      ASC 1,IF      OCT 54003     FOR       ASC 1,FO      OCT 51000       OCT 55004     NEXT      ASC 2,NEXT      OCT 56005     GOSUB       ASC 2,GOSU      OCT 41000       OCT 57006     RETURN      ASC 3,RETURNEOFOP OCT 60003     END       ASC 1,EN      OCT 42000       OCT 61004     STOP      ASC 2,STOP      OCT 62004     DATA      ASC 2,DATAIOSTS OCT 63005     INPUT       ASC 2,INPU      OCT 52000       OCT 64004     READ      ASC 2,READ      OCT 65005     PRINT       ASC 2,PRIN      OCT 52000       OCT 66007     RESTORE       ASC 3,RESTOR      OCT 42400       OCT 67003     MAT       ASC 1,MA      OCT 52000       OCT 70005     FILES       ASC 2,FILE      OCT 51400       OCT 71001     'IMPLIED' LET       OCT 0 *                             * **  MISCELLANEOUS OPERATORS  ** *                             *       OCT 74002     OF      ASC 1,OFTHEN  OCT 75004       ASC 2,THEN      OCT 76002     TO      ASC 1,TOSTEP  OCT 77004       ASC 2,STEP*                                               * **  PREDEFINED FUNCTIONS.  BITS 13-9 ARE USED  ** **    FOR INTERNAL IDENTIFICATION              ** *                                               * TAB   OCT 1003      TAB       ASC 1,TA      OCT 41000 PRDFS OCT 2003      SIN       ASC 1,SI      OCT 47000       OCT 3003      COS       ASC 1,CO      OCT 51400       OCT 4003      TAN       ASC 1,TA      OCT 47000       OCT 5003      ATN       ASC 1,AT      OCT 47000       OCT 6003      EXP       ASC 1,EX      OCT 50000       OCT 7003      LOG       ASC 1,LO      OCT 43400       OCT 10003     ABS       ASC 1,AB      OCT 51400       OCT 11003     SQR       ASC 1,SQ      OCT 51000       OCT 12003     INT       ASC 1,IN      OCT 52000       OCT 13003     RND       ASC 1,RN      OCT 42000       OCT 14003     SGN       ASC 1,SG      OCT 47000       OCT 15003     LEN       ASC 1,LE      OCT 47000       OCT 16003     TYP       ASC 1,TY      OCT 50000 *                      ***  MATRIX FUNCTIONS  ***                      *MATFS OCT 24003     ZER       ASC 1,ZE      OCT 51000       OCT 25003     CON       ASC 1,CO      OCT 47000       OCT 26003     IDN       ASC 1,ID      OCT 47000       OCT 27003     INV       ASC 1,IN      OCT 53000       OCT 30003     TRN       ASC 1,TR      OCT 47000       HED ASCII TO BINARY NUMBER CONVERSION **                     ** ***  HANDLE OVERFLOW  *** **                     ** * *  (A) CONTAINS THE HIGH MANTISSA UPON ENTRY.  (A) AND*  (B) CONTAIN THE LARGEST REPRESENTABLE NUMBER OF*  APPROPRIATE SIGN, PACKED, UPON EXIT. * #OVFL LDB .-2       SSA       LDB B776      IOR INF       SSA       LDA MNEG      JMP OVFLW,I **                           ** ***  CHECK OVER/UNDERFLOWS  *** **                           ** * *  EXIT TO (P+1) IF STATUS IS NOT SYNTAX.  ELSE EXIT TO (P+2),*  SETTING SYMTB = 4 IF IN KEYBOARD MODE.  THESE ERRORS ARE NOT *  REPORTED IF IN TAPE MODE.* #CHOU LDA LNAME     COMPUTE       ADA .+?STAT-?ID       LDB 0,I         STATUS      CPB .+4       SYNTAX?       RSS           YES       JMP CHOUF,I   NO      LDA TAPEF     TAPE      AND LMSK      SZA,RSS         MODE?       STB SYMTB     NO      ISZ CHOUF       JMP CHOUF,I **                       ** ***  LOOK FOR A NUMBER  *** **                       ** * *  NUMCK LOOKS FOR AN UNSIGNED NUMBER, SIGN MUST BE SET *  BY THE CALLER (SIGN = -1 FOR NEGATIVE, ELSE POSITIVE). *  (A) CONTAINS A CHARACTER UPON ENTRY; IF IT IS NEITHER*  A DIGIT NOR A DECIMAL POINT, EXIT IS TO (P+1) WITH *  (A) UNCHANGED AND (B) = 0.  EXIT IS TO ERROR ON FINDING*  AN EXPONENT PART OF INCORRECT FORMAT.  ZERO REPLACES AN*  UNDERFLOW; THE LARGEST REPRESENTABLE NUMBER OF THE *  APPROPRIATE SIGN REPLACES AN OVERFLOW.  AFTER STORING A*  FLOATING POINT NUMBER IN M AND M+1 (WHERE SBPTR,I = M) *  EXIT IS TO (P+2) WITH THE NEXT INPUT STRING CHARACTER*  IN (A) AND TEMP+1. * #NMCK CLB           ZERO      STB EXP         ALL       STB MANT1         COMPONENTS      STB MANT2           OF THE      STB EXPON             NUMBER      STB TEMP+1    SET 'NUMBER FLAG' FALSE       CCB           SET 'DECIMAL POINT'       STB DPFLG            FLAG FALSE NUMC1 CPA .+56B     DECIMAL POINT?      ISZ DPFLG     YES       JMP NUMC2     NO      CLA           ZERO POST-DECIMAL       STA EXPON       DIGIT       JMP NUMC4+1       COUNTER NUMC2 JSB DIGCK     DIGIT?      JMP NUMC7     NO      ISZ EXPON     YES, COUNT DIGIT      ASL 11        LEFT-JUSTIFY DIGIT      STA TEMP+2      AND SAVE IT       JSB MBY10     MULTIPLY PREVIOUS NUMBER BY 10      LDB EXP       ZERO      SZB,RSS         EXPONENT?       JMP NUMC6     YES       ADB .-4       NO,       CMB             SAVE      LDA TEMP+2        SHIFT       STB TEMP+2          COUNT       CLB           CLEAR LOWER MANTISSANUMC3 ISZ TEMP+2    ALL SHIFTS DONE?      JMP NUMC5     NO      CLE           YES, ADD IN       ADB MANT2       LOW PART      CLO               OF NUMBER       SEZ           OVERFLOW FROM (B)?      INA           YES       ADA MANT1     ADD IN HIGH PART OF MANTISSA      SOS           OVERFLOW?       JMP NUMC4     NO      CLE,ERA       YES, CORRECT      ERB             MANTISSA      ISZ EXP           AND BUMP      NOP                 EXPONENTNUMC4 JSB NORML     NORMALIZE THE NUMBER      ISZ TEMP+1    SET 'NUMBER FLAG' TRUE      JSB GETCR     FETCH CHARACTER       JMP NUM12-1   NONE FOUND      JMP NUMC1 NUMC5 CLE,ERA       SHIFT       ERB             DIGIT       JMP NUMC3         RIGHT NUMC6 LDA .+4       SET       STA EXP         EXPONENT      LDA TEMP+2    LOAD      CLB             NUMBER      JMP NUMC4 NUMC7 CLB           SET EXPONENT      STB TEMP+2      SIGN TO '+'       CPB TEMP+1    DIGIT OR DECIMAL POINT FOUND?       JMP NUMCK,I   NO      CPA E         'E' ?       RSS           YES       JMP NUM12     NO      JSB GETCR     FETCH CHARACTER       JMP NUM16     NONE FOUND      CPA .+53B     '+' ?       JMP NUMC8     YES       CPA .+55B     NO, '-' ?       CCA,RSS       YES       JMP NUMC9     NO      STA TEMP+2    SET EXPONENT SIGN TO '-'NUMC8 JSB GETCR     FETCH CHARACTER       JMP NUM16     NONE FOUNDNUMC9 JSB DIGCK     DIGIT?      JMP NUM16     NO      STA TEMP+1    YES, SAVE IT      JSB GETCR       JMP NUM11       JSB DIGCK     DIGIT?      JMP NUM11     NO      LDA TEMP+1    YES, MULTIPLY       STB TEMP+1      PREVIOUS DIGIT      MPY .+10          BY 10       ADA TEMP+1    ADD IN NEW DIGIT      STA TEMP+1    SAVE EXPONENT       JSB GETCR       JMP NUM11       JSB DIGCK     THIRD DIGIT?      RSS           NO      JMP NUM16     YES NUM11 LDB TEMP+1    LOAD EXPONENT       ISZ TEMP+2    POSITIVE?       CMB,INB       YES, COMPLEMENT IT      RSS           NO      CLB NUM12 STA TEMP+1    SAVE CHARACTER      ISZ DPFLG     DECIMAL POINT FOUND?      ADB EXPON     YES, CORRECT EXPONENT       SZB,RSS       NO, ZERO EXPONENT?      JMP NUM14     YES       SSB           NO, POSITIVE EXPONENT?      JMP NUM13     YES       CMB,INB       NO, SET       STB EXPON       COUNTER       JSB DBY10     DIVIDE NUMBER BY 10       ISZ EXPON     DONE?       JMP *-2       NO      JMP NUM14     YES NUM13 STB EXPON     SET COUNTER       JSB MBY10     MULTIPLY NUMBER BY 10       ISZ EXPON     DONE?       JMP *-2       NONUM14 LDA MANT1     LOAD      LDB MANT2       MANTISSA      ISZ SIGN      POSITIVE?       JMP NUM15     YES       CMA           NO, COMPLEMENT      CMB,INB,SZB,RSS  THE      INA                NUMBER NUM15 JSB .PACK     NORMALIZE AND PACK      STA SBPTR,I   STORE       JSB SBPUD       NUMBER IN       STB SBPTR,I       DESTINATION       JSB SBPUD           ADDRESS       LDA TEMP+1    RETRIEVE CHARACTER      ISZ NUMCK NUM16 ISZ NUMCK       JMP NUMCK,I **                                    *****  MULTIPLY UNPACKED NUMBER BY 10  *****                                    *** *  THE FLOATING POINT NUMBER IN MANT1, MANT2, AND EXP *  IS MULTIPLIED BY 10. * #MB10 LDA MANT1     LOAD HIGH MANTISSA      SZA,RSS       ZERO NUMBER?      JMP MBY10,I   YES       LDB EXP       NO,       ADB .+3         MULTIPLY      STB EXP           BY 8      LDB MANT2     LOAD LOW MANTISSA       CLE,ERA       DIVIDE      ERB             BY      CLE,ERA           4       ERB,CLE       ADB MANT2     ADD INTO      SEZ             BOTH REGISTERS      INA               PRODUCING       ADA MANT1           1.25 * MANTISSA       SSA,RSS       CORRECT       JMP MBY01       CLE,ERA         ON      ERB       ISZ EXP           OVERFLOW      NOP MBY01 STA MANT1     STORE       STB MANT2       MANTISSA      JMP MBY10,I **                                  *****  DIVIDE UNPACKED NUMBER BY 10  *****                                  *** *  INVERSE OF MBY10 * #DB10 LDA MANT1     RETURN      SZA,RSS         ON      JMP DBY10,I       ZERO      LDB .-2       ADD EXPONENT      ADB EXP         OF 1/10 TO      STB EXP           THAT OF NUMBER      LDA MANT2     JUSTIFY       CLE,ERA         LOWER MANTISSA      MPY TENTH         MULTIPLY BY 1/10      CLE,ELA       SHIFT       ELB,CLE         BACK      ADA 1         ADD IN EQUIVALENT OF      SEZ             LOWER MANTISSA*       CLE,INB           TENTH*2^(-16)       STB MANT2           AND ROUND TO 16 BITS      LDA MANT1     DO      MPY TENTH       SAME TO       ADA 1             HIGH MANTISSA       ADA MANT2     PERFORM EFFECTIVE       SEZ             SUM OF DOUBLE-LENGTH      INB               PRODUCTS      SWP           SWAP (A) AND (B)      JSB NORML     NORMALIZE       JMP DBY10,I     RESULT**                               ** ***  NORMALIZE UNPACKED NUMBER  *** **                               ** * *  ENTER WITH NUMBER IN (A), (B), AND EXP.  EXIT WITH *  NORMALIZED NUMBER IN MANT1, MANT2, AND EXP (MANTISSA *  IS LEFT IN (A) AND (B) AS WELL). * #NRML STA NT0       SET       CLA             LEFT-SHIFT      STA TEMP+2        COUNTER       LDA NT0             TO ZERO       SZA,RSS       IF NUMBER       SZB             IS ZERO,      JMP NORM2+1       CLEAR       STA EXP             EVERYTHING      STA MANT1     STORE NORM1 STB MANT2       MANTISSA      JMP NORML,I NORM2 ISZ TEMP+2    COUNT A LEFT SHIFT      CLE,ELB       ROTATE (A)      ELA             AND (B) LEFT      SEZ,SSA,RSS   TWO HIGHEST BITS 0?       JMP NORM2     YES, POSITIVE UNNORMALIZED      SEZ,SSA       NO, TWO HIGHEST BITS 1?       JMP NORM2     YES, NEGATIVE UNNORMALIZED      ERA           NO, NORMALIZE       ERB,CLE         MANTISSA      STA MANT1     COMPUTE       LDA TEMP+2      CMA,INA         CORRECTED       ADA EXP       STA EXP           EXPONENT      LDA MANT1       JMP NORM1 **                               ** ***  NORMALIZE AND PACK NUMBER  *** **                               ** * *  NUMBER IN (A), (B), AND EXP ON ENTRY.  ON EXIT (A) *  AND (B) CONTAIN THE NORMALIZED, ROUNDED, AND PACKED*  NUMBER.  UNDERFLOW BECOMES A ZERO, OVERFLOW BECOMES*  THE LARGEST REPRESNTABLE NUMBER OF APPROPRIATE SIGN. * #PACK JSB NORML     NORMALIZE NUMBER      CLE,SZA,RSS   ZERO?       JMP .PACK,I   YES       ADB B177      NO, ROUND       SSA,RSS       POSITIVE?       INB           YES, FINISH ROUND       CLO       SEZ           ON OVERFLOW FROM (B)      CLE,INA         CORRECT (A)       SOS           OVERFLOW? ( (A)=100000, (B)=0 )       RAL           TWO HIGH BITS       SSA,SLA,RSS     BOTH 1? ( IF (A) WAS 140000 )       JMP PACK1     NO      CCE           YES       ARS,SLA,ALS   SET (A) = 100000 AND SKIP PACK1 RAR           UNDOES RAL ABOVE      STA TEMP+2    SAVE (A)      LSR 8         DELETE 8 LOW BITS       BLF,BLF         OF MANTISSA       LDA EXP       DECREMENT       SEZ             EXPONENT      ADA .-1           ON (E) # 0      SOC           INCREMENT       INA             EXPONENT ON OVERFLOW      ADA B200      EXPONENT      SSA             UNDERFLOW?      JMP PACK3     YES       ADA M256      NO, EXPONENT      SSA,RSS         OVERFLOW?       JMP PACK4     YES       ADA B200      NO, RESTORE EXPONENT      RAL           POSITION      AND B377        EXPONENT AND      ADB 0             ADD LOW MANTISSA      LDA TEMP+2    RETRIEVE HIGH MANTISSA      CPA MNEG      RSS           NEGATIVE      JMP .PACK,I       CPB MNEG+1      OVERFLOW?       JMP PACK4     YES       JMP .PACK,I   NOPACK3 JSB CHOUF     CHECK STATUS      JSB WERRS+6,I       CLA           ZERO RESULT       CLB             ON UNDERFLOW      JMP .PACK,I PACK4 JSB CHOUF     CHECK STATUS      JSB WERRS+5,I       LDA TEMP+2    RETRIEVE HIGH MANTISSA      JSB OVFLW       JMP .PACK,I       HED MAIN EXECUTION LOOP * * ************************* ****                     ******  EXECUTE THE PROGRAM  *** ****                     **** ************************* * * *  THE CORE-RESIDENT FILE BUFFERS FOLLOW THE VALUE TABLE:  ONE*  64-WORD 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. * XEC   LDA PBPTR     SET POINTER TO LAST WORD +1       STA FCORE       OF FIXED TABLES       LDA .+12B     ECHO      JSB OUTCR       LINE FEED       LDA LNAME       STA LT1       INA           NULL      LDA 0,I       SZA,RSS         NAME?       JMP XEC0      YES       CLB           NO      STB LT2       OUTPUT      LDA .-3         PROGRAM       JSB OUTST         NAMEXEC0  CLA           ZERO      STA FCNTR       FILE COUNTER      STA RTNST         AND MESSAGE FLAG      LDB FILTB     LOAD ADDRESS OF FILE TABLEXEC2  CPB VALTB     DONE?       JMP XEC4      YES       ISZ FCNTR     NO, COUNT FILE      LDA 1,I       READ      SSA             ONLY?       JMP XEC5      YES XEC3  CCA           NO      ADB .+2       SET NULL      STA 1,I         RECORD ADDRESS      ADB .+2       ALLOCATE      LDA B100        A 64 WORD       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       INB       JMP XEC2XEC4  LDA .+15B     OUTPUT A      JSB OUTCR       CARRAGE RETURN      LDA .+12B         AND       JSB OUTCR           TWO       LDA .+12B             LINE FEEDS      JSB OUTCR       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 PBUFF     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      LDA 1,I         SEQUENCE      STA .LNUM         NUMBER      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)      ISZ RTNST     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 .+60B       RELATIVE      JSB OUTCR         FILE NUMBER       LDA .+40B     OUTPUT      JSB OUTCR       BLANK       LDB RTRNQ     RETRIEVE (B)      JMP XEC3