293 lines
11 KiB
Plaintext
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
|