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
S.DCF9