goapple2/source/applesoft/S.DD7B
2014-05-09 17:59:16 -07:00

293 lines
11 KiB
Plaintext

1010 *--------------------------------
1020 * EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
1030 * RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
1040 * EXPRESSIONS.
1050 *--------------------------------
1060 FRMEVL LDX TXTPTR DECREMENT TXTPTR
1070 BNE .1
1080 DEC TXTPTR+1
1090 .1 DEC TXTPTR
1100 LDX #0 START WITH PRECEDENCE = 0
1110 .HS 24 TRICK TO SKIP FOLLOWING "PHA"
1120 *--------------------------------
1130 FRMEVL.1
1140 PHA PUSH RELOPS FLAGS
1150 TXA
1160 PHA SAVE LAST PRECEDENCE
1170 LDA #1
1180 JSR CHKMEM CHECK IF ENOUGH ROOM ON STACK
1190 JSR FRM.ELEMENT GET AN ELEMENT
1200 LDA #0
1210 STA CPRTYP CLEAR COMPARISON OPERATOR FLAGS
1220 *--------------------------------
1230 FRMEVL.2
1240 JSR CHRGOT CHECK FOR RELATIONAL OPERATORS
1250 .1 SEC > IS $CF, = IS $D0, < IS $D1
1260 SBC #TOKEN.GREATER > IS 0, = IS 1, < IS 2
1270 BCC .2 NOT RELATIONAL OPERATOR
1280 CMP #3
1290 BCS .2 NOT RELATIONAL OPERATOR
1300 CMP #1 SET CARRY IF "=" OR "<"
1310 ROL NOW > IS 0, = IS 3, < IS 5
1320 EOR #1 NOW > IS 1, = IS 2, < IS 4
1330 EOR CPRTYP SET BITS OF CPRTYP: 00000<=>
1340 CMP CPRTYP CHECK FOR ILLEGAL COMBINATIONS
1350 BCC SNTXERR IF LESS THAN, A RELOP WAS REPEATED
1360 STA CPRTYP
1370 JSR CHRGET ANOTHER OPERATOR?
1380 JMP .1 CHECK FOR <,=,> AGAIN
1390 *--------------------------------
1400 .2 LDX CPRTYP DID WE FIND A RELATIONAL OPERATOR?
1410 BNE FRM.RELATIONAL YES
1420 BCS NOTMATH NO, AND NEXT TOKEN IS > $D1
1430 ADC #$CF-TOKEN.PLUS NO, AND NEXT TOKEN < $CF
1440 BCC NOTMATH IF NEXT TOKEN < "+"
1450 ADC VALTYP + AND LAST RESULT A STRING?
1460 BNE .3 BRANCH IF NOT
1470 JMP CAT CONCATENATE IF SO.
1480 *--------------------------------
1490 .3 ADC #$FF +-*/ IS 0123
1500 STA INDEX
1510 ASL MULTIPLY BY 3
1520 ADC INDEX +-*/ IS 0,3,6,9
1530 TAY
1540 *--------------------------------
1550 FRM.PRECEDENCE.TEST
1560 PLA GET LAST PRECEDENCE
1570 CMP MATHTBL,Y
1580 BCS FRM.PERFORM.1 DO NOW IF HIGHER PRECEDENCE
1590 JSR CHKNUM WAS LAST RESULT A #?
1600 NXOP PHA YES, SAVE PRECEDENCE ON STACK
1610 SAVOP JSR FRM.RECURSE SAVE REST, CALL FRMEVL RECURSIVELY
1620 PLA
1630 LDY LASTOP
1640 BPL PREFNC
1650 TAX
1660 BEQ GOEX EXIT IF NO MATH IN EXPRESSION
1670 BNE FRM.PERFORM.2 ...ALWAYS
1680 *--------------------------------
1690 * FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
1700 *--------------------------------
1710 FRM.RELATIONAL
1720 LSR VALTYP (VALTYP) = 0 (NUMERIC), = $FF (STRING)
1730 TXA SET CPRTYP TO 0000<=>C
1740 ROL WHERE C=0 IF #, C=1 IF STRING
1750 LDX TXTPTR BACK UP TXTPTR
1760 BNE .1
1770 DEC TXTPTR+1
1780 .1 DEC TXTPTR
1790 LDY #M.REL-MATHTBL POINT AT RELOPS ENTRY
1800 STA CPRTYP
1810 BNE FRM.PRECEDENCE.TEST ...ALWAYS
1820 *--------------------------------
1830 PREFNC CMP MATHTBL,Y
1840 BCS FRM.PERFORM.2 DO NOW IF HIGHER PRECEDENCE
1850 BCC NXOP ...ALWAYS
1860 *--------------------------------
1870 * STACK THIS OPERATION AND CALL FRMEVL FOR
1880 * ANOTHER ONE
1890 *--------------------------------
1900 FRM.RECURSE
1910 LDA MATHTBL+2,Y
1920 PHA PUSH ADDRESS OF OPERATION PERFORMER
1930 LDA MATHTBL+1,Y
1940 PHA
1950 JSR FRM.STACK.1 STACK FAC.SIGN AND FAC
1960 LDA CPRTYP A=RELOP FLAGS, X=PRECEDENCE BYTE
1970 JMP FRMEVL.1 RECURSIVELY CALL FRMEVL
1980 *--------------------------------
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
2090 LDA FAC.SIGN GET FAC.SIGN TO PUSH IT
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
2150 TAY FAC.SIGN OR SGN(STEP VALUE)
2160 PLA PULL RETURN ADDRESS AND ADD 1
2170 STA INDEX <<< ASSUMES NOT ON PAGE BOUNDARY! >>>
2180 INC INDEX PLACE BUMPED RETURN ADDRESS IN
2190 PLA INDEX,INDEX+1
2200 STA INDEX+1
2210 TYA FAC.SIGN OR SGN(STEP VALUE)
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
2280 JSR ROUND.FAC ROUND TO 32 BITS
2290 LDA FAC+4 PUSH (FAC)
2300 PHA
2310 LDA FAC+3
2320 PHA
2330 LDA FAC+2
2340 PHA
2350 LDA FAC+1
2360 PHA
2370 LDA FAC
2380 PHA
2390 JMP (INDEX) DO RTS FUNNY WAY
2400 *--------------------------------
2410 *
2420 *--------------------------------
2430 NOTMATH LDY #$FF SET UP TO EXIT ROUTINE
2440 PLA
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
2550 CMP #P.REL WAS IT RELATIONAL OPERATOR?
2560 BEQ .1 YES, ALLOW STRING COMPARE
2570 JSR CHKNUM MUST BE NUMERIC VALUE
2580 .1 STY LASTOP
2590 *--------------------------------
2600 FRM.PERFORM.2
2610 PLA GET 0000<=>C FROM STACK
2620 LSR SHIFT TO 00000<=> FORM
2630 STA CPRMASK 00000<=>
2640 PLA
2650 STA ARG GET FLOATING POINT VALUE OFF STACK,
2660 PLA AND PUT IT IN ARG
2670 STA ARG+1
2680 PLA
2690 STA ARG+2
2700 PLA
2710 STA ARG+3
2720 PLA
2730 STA ARG+4
2740 PLA
2750 STA ARG+5
2760 EOR FAC.SIGN SAVE EOR OF SIGNS OF THE OPERANDS,
2770 STA SGNCPR IN CASE OF MULTIPLY OR DIVIDE
2780 EXIT LDA FAC FAC EXPONENT IN A-REG
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
2880 LDA #0 ASSUME NUMERIC
2890 STA VALTYP
2900 .1 JSR CHRGET
2910 BCS .3 NOT A DIGIT
2920 .2 JMP FIN NUMERIC CONSTANT
2930 .3 JSR ISLETC VARIABLE NAME?
2940 BCS FRM.VARIABLE YES
2950 CMP #'.' DECIMAL POINT
2960 BEQ .2 YES, NUMERIC CONSTANT
2970 CMP #TOKEN.MINUS UNARY MINUS?
2980 BEQ MIN YES
2990 CMP #TOKEN.PLUS UNARY PLUS
3000 BEQ .1 YES
3010 CMP #'"' STRING CONSTANT?
3020 BNE NOT. NO
3030 *--------------------------------
3040 * STRING CONSTANT ELEMENT
3050 *
3060 * SET Y,A = (TXTPTR)+CARRY
3070 *--------------------------------
3080 STRTXT LDA TXTPTR ADD (CARRY) TO GET ADDRESS OF 1ST CHAR
3090 LDY TXTPTR+1 OF STRING IN Y,A
3100 ADC #0
3110 BCC .1
3120 INY
3130 .1 JSR STRLIT BUILD DESCRIPTOR TO STRING
3140 * GET ADDRESS OF DESCRIPTOR IN FAC
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 *--------------------------------
3210 NOT. CMP #TOKEN.NOT
3220 BNE FN. NOT "NOT", TRY "FN"
3230 LDY #M.EQU-MATHTBL POINT AT = COMPARISON
3240 BNE EQUL ...ALWAYS
3250 *--------------------------------
3260 * COMPARISON FOR EQUALITY (= OPERATOR)
3270 * ALSO USED TO EVALUATE "NOT" FUNCTION
3280 *--------------------------------
3290 EQUOP LDA FAC SET "TRUE" IF (FAC) = ZERO
3300 BNE .1 FALSE
3310 LDY #1 TRUE
3320 .HS 2C TRICK TO SKIP NEXT 2 BYTES
3330 .1 LDY #0 FALSE
3340 JMP SNGFLT
3350 *--------------------------------
3360 FN. CMP #TOKEN.FN
3370 BNE SGN.
3380 JMP FUNCT
3390 *--------------------------------
3400 SGN. CMP #TOKEN.SGN
3410 BCC PARCHK
3420 JMP UNARY
3430 *--------------------------------
3440 * EVALUATE "(EXPRESSION)"
3450 *--------------------------------
3460 PARCHK JSR CHKOPN IS THERE A '(' AT TXTPTR?
3470 JSR FRMEVL YES, EVALUATE EXPRESSION
3480 *--------------------------------
3490 CHKCLS LDA #')' CHECK FOR ')'
3500 .HS 2C TRICK
3510 *--------------------------------
3520 CHKOPN LDA #'('
3530 .HS 2C TRICK
3540 *--------------------------------
3550 CHKCOM LDA #',' COMMA AT TXTPTR?
3560 *--------------------------------
3570 * UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
3580 *--------------------------------
3590 SYNCHR LDY #0
3600 CMP (TXTPTR),Y
3610 BNE SYNERR
3620 JMP CHRGET MATCH, GET NEXT CHAR & RETURN
3630 *--------------------------------
3640 SYNERR LDX #ERR.SYNTAX
3650 JMP ERROR
3660 *--------------------------------
3670 MIN LDY #M.NEG-MATHTBL POINT AT UNARY MINUS
3680 EQUL PLA
3690 PLA
3700 JMP SAVOP
3710 *--------------------------------
3720 FRM.VARIABLE
3730 JSR PTRGET
3740 FRM.VARIABLE.CALL .EQ *-1 SO PTRGET CAN TELL WE CALLED
3750 STA VPNT ADDRESS OF VARIABLE
3760 STY VPNT+1
3770 LDX VALTYP NUMERIC OR STRING?
3780 BEQ .1 NUMERIC
3790 LDX #0 STRING
3800 STX STRNG1+1
3810 RTS
3820 .1 LDX VALTYP+1 NUMERIC, WHICH TYPE?
3830 BPL .2 FLOATING POINT
3840 LDY #0 INTEGER
3850 LDA (VPNT),Y
3860 TAX GET VALUE IN A,Y
3870 INY
3880 LDA (VPNT),Y
3890 TAY
3900 TXA
3910 JMP GIVAYF CONVERT A,Y TO FLOATING POINT
3920 .2 JMP LOAD.FAC.FROM.YA