S-C DocuMentor — Applesoft

               SAVE S.DD7B
               1010 *--------------------------------
               1020 *      EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
               1030 *      RESULT IN FAC.  WORKS FOR BOTH STRING AND NUMERIC
               1040 *      EXPRESSIONS.
               1050 *--------------------------------
DD7B- A6 B8    1060 FRMEVL LDX TXTPTR   DECREMENT TXTPTR
DD7D- D0 02    1070        BNE .1
DD7F- C6 B9    1080        DEC TXTPTR+1
DD81- C6 B8    1090 .1     DEC TXTPTR
DD83- A2 00    1100        LDX #0       START WITH PRECEDENCE = 0
DD85- 24       1110        .HS 24       TRICK TO SKIP FOLLOWING "PHA"
               1120 *--------------------------------
               1130 FRMEVL.1
DD86- 48       1140        PHA          PUSH RELOPS FLAGS
DD87- 8A       1150        TXA
DD88- 48       1160        PHA          SAVE LAST PRECEDENCE
DD89- A9 01    1170        LDA #1
DD8B- 20 D6 D3 1180        JSR CHKMEM   CHECK IF ENOUGH ROOM ON STACK
DD8E- 20 60 DE 1190        JSR FRM.ELEMENT   GET AN ELEMENT
DD91- A9 00    1200        LDA #0
DD93- 85 89    1210        STA CPRTYP   CLEAR COMPARISON OPERATOR FLAGS
               1220 *--------------------------------
               1230 FRMEVL.2
DD95- 20 B7 00 1240        JSR CHRGOT   CHECK FOR RELATIONAL OPERATORS
DD98- 38       1250 .1     SEC          > IS $CF, = IS $D0, < IS $D1
DD99- E9 CF    1260        SBC #TOKEN.GREATER   > IS 0, = IS 1, < IS 2
DD9B- 90 17    1270        BCC .2       NOT RELATIONAL OPERATOR
DD9D- C9 03    1280        CMP #3
DD9F- B0 13    1290        BCS .2       NOT RELATIONAL OPERATOR
DDA1- C9 01    1300        CMP #1       SET CARRY IF "=" OR "<"
DDA3- 2A       1310        ROL          NOW > IS 0, = IS 3, < IS 5
DDA4- 49 01    1320        EOR #1       NOW > IS 1, = IS 2, < IS 4
DDA6- 45 89    1330        EOR CPRTYP   SET BITS OF CPRTYP:  00000<=>
DDA8- C5 89    1340        CMP CPRTYP   CHECK FOR ILLEGAL COMBINATIONS
DDAA- 90 61    1350        BCC SNTXERR  IF LESS THAN, A RELOP WAS REPEATED
DDAC- 85 89    1360        STA CPRTYP
DDAE- 20 B1 00 1370        JSR CHRGET   ANOTHER OPERATOR?
DDB1- 4C 98 DD 1380        JMP .1       CHECK FOR <,=,> AGAIN
               1390 *--------------------------------
DDB4- A6 89    1400 .2     LDX CPRTYP   DID WE FIND A RELATIONAL OPERATOR?
DDB6- D0 2C    1410        BNE FRM.RELATIONAL  YES
DDB8- B0 7B    1420        BCS NOTMATH  NO, AND NEXT TOKEN IS > $D1
DDBA- 69 07    1430        ADC #$CF-TOKEN.PLUS  NO, AND NEXT TOKEN < $CF
DDBC- 90 77    1440        BCC NOTMATH  IF NEXT TOKEN < "+"
DDBE- 65 11    1450        ADC VALTYP   + AND LAST RESULT A STRING?
DDC0- D0 03    1460        BNE .3       BRANCH IF NOT
DDC2- 4C 97 E5 1470        JMP CAT      CONCATENATE IF SO.
               1480 *--------------------------------
DDC5- 69 FF    1490 .3     ADC #$FF     +-*/ IS 0123
DDC7- 85 5E    1500        STA INDEX
DDC9- 0A       1510        ASL          MULTIPLY BY 3
DDCA- 65 5E    1520        ADC INDEX    +-*/ IS 0,3,6,9
DDCC- A8       1530        TAY
               1540 *--------------------------------
               1550 FRM.PRECEDENCE.TEST
DDCD- 68       1560        PLA          GET LAST PRECEDENCE
DDCE- D9 B2 D0 1570        CMP MATHTBL,Y
DDD1- B0 67    1580        BCS FRM.PERFORM.1    DO NOW IF HIGHER PRECEDENCE
DDD3- 20 6A DD 1590        JSR CHKNUM   WAS LAST RESULT A #?
DDD6- 48       1600 NXOP   PHA          YES, SAVE PRECEDENCE ON STACK
DDD7- 20 FD DD 1610 SAVOP  JSR FRM.RECURSE  SAVE REST, CALL FRMEVL RECURSIVELY
DDDA- 68       1620        PLA
DDDB- A4 87    1630        LDY LASTOP
DDDD- 10 17    1640        BPL PREFNC
DDDF- AA       1650        TAX
DDE0- F0 56    1660        BEQ GOEX     EXIT IF NO MATH IN EXPRESSION
DDE2- D0 5F    1670        BNE FRM.PERFORM.2  ...ALWAYS
               1680 *--------------------------------
               1690 *      FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
               1700 *--------------------------------
               1710 FRM.RELATIONAL
DDE4- 46 11    1720        LSR VALTYP   (VALTYP) = 0 (NUMERIC), = $FF (STRING)
DDE6- 8A       1730        TXA          SET CPRTYP TO 0000<=>C
DDE7- 2A       1740        ROL          WHERE C=0 IF #, C=1 IF STRING
DDE8- A6 B8    1750        LDX TXTPTR   BACK UP TXTPTR
DDEA- D0 02    1760        BNE .1
DDEC- C6 B9    1770        DEC TXTPTR+1
DDEE- C6 B8    1780 .1     DEC TXTPTR
DDF0- A0 1B    1790        LDY #M.REL-MATHTBL   POINT AT RELOPS ENTRY
DDF2- 85 89    1800        STA CPRTYP
DDF4- D0 D7    1810        BNE FRM.PRECEDENCE.TEST   ...ALWAYS
               1820 *--------------------------------
DDF6- D9 B2 D0 1830 PREFNC CMP MATHTBL,Y
DDF9- B0 48    1840        BCS FRM.PERFORM.2  DO NOW IF HIGHER PRECEDENCE
DDFB- 90 D9    1850        BCC NXOP     ...ALWAYS
               1860 *--------------------------------
               1870 *      STACK THIS OPERATION AND CALL FRMEVL FOR
               1880 *      ANOTHER ONE
               1890 *--------------------------------
               1900 FRM.RECURSE
DDFD- B9 B4 D0 1910        LDA MATHTBL+2,Y
DE00- 48       1920        PHA          PUSH ADDRESS OF OPERATION PERFORMER
DE01- B9 B3 D0 1930        LDA MATHTBL+1,Y
DE04- 48       1940        PHA
DE05- 20 10 DE 1950        JSR FRM.STACK.1   STACK FAC.SIGN AND FAC
DE08- A5 89    1960        LDA CPRTYP   A=RELOP FLAGS, X=PRECEDENCE BYTE
DE0A- 4C 86 DD 1970        JMP FRMEVL.1      RECURSIVELY CALL FRMEVL
               1980 *--------------------------------
DE0D- 4C C9 DE 1990 SNTXERR JMP SYNERR
               2000 *--------------------------------
               2010 *      STACK (FAC)
               2020 *
               2030 *      THREE ENTRY POINTS:
               2040 *          .1, FROM FRMEVL
               2050 *          .2, FROM "STEP"
               2060 *          .3, FROM "FOR"
               2070 *--------------------------------
               2080 FRM.STACK.1
DE10- A5 A2    2090        LDA FAC.SIGN        GET FAC.SIGN TO PUSH IT
DE12- BE B2 D0 2100        LDX MATHTBL,Y     PRECEDENCE BYTE FROM MATHTBL
               2110 *--------------------------------
               2120 *      ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
               2130 *--------------------------------
               2140 FRM.STACK.2
DE15- A8       2150        TAY          FAC.SIGN OR SGN(STEP VALUE)
DE16- 68       2160        PLA          PULL RETURN ADDRESS AND ADD 1
DE17- 85 5E    2170        STA INDEX    <<< ASSUMES NOT ON PAGE BOUNDARY! >>>
DE19- E6 5E    2180        INC INDEX    PLACE BUMPED RETURN ADDRESS IN
DE1B- 68       2190        PLA              INDEX,INDEX+1
DE1C- 85 5F    2200        STA INDEX+1
DE1E- 98       2210        TYA          FAC.SIGN OR SGN(STEP VALUE)
DE1F- 48       2220        PHA          PUSH FAC.SIGN OR SGN(STEP VALUE)
               2230 *--------------------------------
               2240 *      ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
               2250 *      TO PUSH INITIAL VALUE OF "FOR" VARIABLE
               2260 *--------------------------------
               2270 FRM.STACK.3
DE20- 20 72 EB 2280        JSR ROUND.FAC     ROUND TO 32 BITS
DE23- A5 A1    2290        LDA FAC+4         PUSH (FAC)
DE25- 48       2300        PHA
DE26- A5 A0    2310        LDA FAC+3
DE28- 48       2320        PHA
DE29- A5 9F    2330        LDA FAC+2
DE2B- 48       2340        PHA
DE2C- A5 9E    2350        LDA FAC+1
DE2E- 48       2360        PHA
DE2F- A5 9D    2370        LDA FAC
DE31- 48       2380        PHA
DE32- 6C 5E 00 2390        JMP (INDEX)       DO RTS FUNNY WAY
               2400 *--------------------------------
               2410 *
               2420 *--------------------------------
DE35- A0 FF    2430 NOTMATH LDY #$FF    SET UP TO EXIT ROUTINE
DE37- 68       2440        PLA
DE38- F0 23    2450 GOEX   BEQ EXIT       EXIT IF NO MATH TO DO
               2460 *--------------------------------
               2470 *      PERFORM STACKED OPERATION
               2480 *
               2490 *      (A) = PRECEDENCE BYTE
               2500 *      STACK:  1 -- CPRMASK
               2510 *              5 -- (ARG)
               2520 *              2 -- ADDR OF PERFORMER
               2530 *--------------------------------
               2540 FRM.PERFORM.1
DE3A- C9 64    2550        CMP #P.REL   WAS IT RELATIONAL OPERATOR?
DE3C- F0 03    2560        BEQ .1       YES, ALLOW STRING COMPARE
DE3E- 20 6A DD 2570        JSR CHKNUM   MUST BE NUMERIC VALUE
DE41- 84 87    2580 .1     STY LASTOP
               2590 *--------------------------------
               2600 FRM.PERFORM.2
DE43- 68       2610        PLA          GET 0000<=>C FROM STACK
DE44- 4A       2620        LSR          SHIFT TO 00000<=> FORM
DE45- 85 16    2630        STA CPRMASK   00000<=>
DE47- 68       2640        PLA
DE48- 85 A5    2650        STA ARG      GET FLOATING POINT VALUE OFF STACK,
DE4A- 68       2660        PLA          AND PUT IT IN ARG
DE4B- 85 A6    2670        STA ARG+1
DE4D- 68       2680        PLA
DE4E- 85 A7    2690        STA ARG+2
DE50- 68       2700        PLA
DE51- 85 A8    2710        STA ARG+3
DE53- 68       2720        PLA
DE54- 85 A9    2730        STA ARG+4
DE56- 68       2740        PLA
DE57- 85 AA    2750        STA ARG+5
DE59- 45 A2    2760        EOR FAC.SIGN   SAVE EOR OF SIGNS OF THE OPERANDS,
DE5B- 85 AB    2770        STA SGNCPR   IN CASE OF MULTIPLY OR DIVIDE
DE5D- A5 9D    2780 EXIT   LDA FAC      FAC EXPONENT IN A-REG
DE5F- 60       2790        RTS          STATUS .EQ. IF (FAC)=0
               2800 *                   RTS GOES TO PERFORM OPERATION
               2810 *--------------------------------
               2820 *      GET ELEMENT IN EXPRESSION
               2830 *
               2840 *      GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
               2850 *      TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
               2860 *--------------------------------
               2870 FRM.ELEMENT
DE60- A9 00    2880        LDA #0       ASSUME NUMERIC
DE62- 85 11    2890        STA VALTYP
DE64- 20 B1 00 2900 .1     JSR CHRGET
DE67- B0 03    2910        BCS .3       NOT A DIGIT
DE69- 4C 4A EC 2920 .2     JMP FIN      NUMERIC CONSTANT
DE6C- 20 7D E0 2930 .3     JSR ISLETC   VARIABLE NAME?
DE6F- B0 64    2940        BCS FRM.VARIABLE YES
DE71- C9 2E    2950        CMP #'.'     DECIMAL POINT
DE73- F0 F4    2960        BEQ .2       YES, NUMERIC CONSTANT
DE75- C9 C9    2970        CMP #TOKEN.MINUS  UNARY MINUS?
DE77- F0 55    2980        BEQ MIN           YES
DE79- C9 C8    2990        CMP #TOKEN.PLUS   UNARY PLUS
DE7B- F0 E7    3000        BEQ .1            YES
DE7D- C9 22    3010        CMP #'"'     STRING CONSTANT?
DE7F- D0 0F    3020        BNE NOT.     NO
               3030 *--------------------------------
               3040 *      STRING CONSTANT ELEMENT
               3050 *
               3060 *      SET Y,A = (TXTPTR)+CARRY
               3070 *--------------------------------
DE81- A5 B8    3080 STRTXT LDA TXTPTR   ADD (CARRY) TO GET ADDRESS OF 1ST CHAR
DE83- A4 B9    3090        LDY TXTPTR+1      OF STRING IN Y,A
DE85- 69 00    3100        ADC #0
DE87- 90 01    3110        BCC .1
DE89- C8       3120        INY
DE8A- 20 E7 E3 3130 .1     JSR STRLIT   BUILD DESCRIPTOR TO STRING
               3140 *                   GET ADDRESS OF DESCRIPTOR IN FAC
DE8D- 4C 3D E7 3150        JMP POINT    POINT TXTPTR AFTER TRAILING QUOTE
               3160 *--------------------------------
               3170 *      "NOT" FUNCTION
               3180 *      IF FAC=0, RETURN FAC=1
               3190 *      IF FAC<>0, RETURN FAC=0
               3200 *--------------------------------
DE90- C9 C6    3210 NOT.   CMP #TOKEN.NOT
DE92- D0 10    3220        BNE FN.      NOT "NOT", TRY "FN"
DE94- A0 18    3230        LDY #M.EQU-MATHTBL  POINT AT = COMPARISON
DE96- D0 38    3240        BNE EQUL     ...ALWAYS
               3250 *--------------------------------
               3260 *      COMPARISON FOR EQUALITY (= OPERATOR)
               3270 *      ALSO USED TO EVALUATE "NOT" FUNCTION
               3280 *--------------------------------
DE98- A5 9D    3290 EQUOP  LDA FAC      SET "TRUE" IF (FAC) = ZERO
DE9A- D0 03    3300        BNE .1       FALSE
DE9C- A0 01    3310        LDY #1       TRUE
DE9E- 2C       3320        .HS 2C       TRICK TO SKIP NEXT 2 BYTES
DE9F- A0 00    3330 .1     LDY #0       FALSE
DEA1- 4C 01 E3 3340        JMP SNGFLT
               3350 *--------------------------------
DEA4- C9 C2    3360 FN.    CMP #TOKEN.FN
DEA6- D0 03    3370        BNE SGN.
DEA8- 4C 54 E3 3380        JMP FUNCT
               3390 *--------------------------------
DEAB- C9 D2    3400 SGN.   CMP #TOKEN.SGN
DEAD- 90 03    3410        BCC PARCHK
DEAF- 4C 0C DF 3420        JMP UNARY
               3430 *--------------------------------
               3440 *      EVALUATE "(EXPRESSION)"
               3450 *--------------------------------
DEB2- 20 BB DE 3460 PARCHK JSR CHKOPN   IS THERE A '(' AT TXTPTR?
DEB5- 20 7B DD 3470        JSR FRMEVL   YES, EVALUATE EXPRESSION
               3480 *--------------------------------
DEB8- A9 29    3490 CHKCLS LDA #')'     CHECK FOR ')'
DEBA- 2C       3500        .HS 2C       TRICK
               3510 *--------------------------------
DEBB- A9 28    3520 CHKOPN LDA #'('
DEBD- 2C       3530        .HS 2C       TRICK
               3540 *--------------------------------
DEBE- A9 2C    3550 CHKCOM LDA #','     COMMA AT TXTPTR?
               3560 *--------------------------------
               3570 *      UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
               3580 *--------------------------------
DEC0- A0 00    3590 SYNCHR LDY #0
DEC2- D1 B8    3600        CMP (TXTPTR),Y
DEC4- D0 03    3610        BNE SYNERR
DEC6- 4C B1 00 3620        JMP CHRGET   MATCH, GET NEXT CHAR & RETURN
               3630 *--------------------------------
DEC9- A2 10    3640 SYNERR LDX #ERR.SYNTAX
DECB- 4C 12 D4 3650        JMP ERROR
               3660 *--------------------------------
DECE- A0 15    3670 MIN    LDY #M.NEG-MATHTBL  POINT AT UNARY MINUS
DED0- 68       3680 EQUL   PLA
DED1- 68       3690        PLA
DED2- 4C D7 DD 3700        JMP SAVOP
               3710 *--------------------------------
               3720 FRM.VARIABLE
DED5- 20 E3 DF 3730        JSR PTRGET
DED7-          3740 FRM.VARIABLE.CALL .EQ *-1   SO PTRGET CAN TELL WE CALLED
DED8- 85 A0    3750        STA VPNT     ADDRESS OF VARIABLE
DEDA- 84 A1    3760        STY VPNT+1
DEDC- A6 11    3770        LDX VALTYP   NUMERIC OR STRING?
DEDE- F0 05    3780        BEQ .1       NUMERIC
DEE0- A2 00    3790        LDX #0       STRING
DEE2- 86 AC    3800        STX STRNG1+1
DEE4- 60       3810        RTS
DEE5- A6 12    3820 .1     LDX VALTYP+1 NUMERIC, WHICH TYPE?
DEE7- 10 0D    3830        BPL .2       FLOATING POINT
DEE9- A0 00    3840        LDY #0       INTEGER
DEEB- B1 A0    3850        LDA (VPNT),Y
DEED- AA       3860        TAX          GET VALUE IN A,Y
DEEE- C8       3870        INY
DEEF- B1 A0    3880        LDA (VPNT),Y
DEF1- A8       3890        TAY
DEF2- 8A       3900        TXA
DEF3- 4C F2 E2 3910        JMP GIVAYF   CONVERT A,Y TO FLOATING POINT
DEF6- 4C F9 EA 3920 .2     JMP LOAD.FAC.FROM.YA