mirror of
https://github.com/zellyn/goapple2.git
synced 2024-12-02 12:52:07 +00:00
313 lines
10 KiB
Plaintext
313 lines
10 KiB
Plaintext
|
1010 *--------------------------------
|
||
|
|
1020 * "RUN" COMMAND
|
||
|
|
1030 *--------------------------------
|
||
|
|
1040 RUN PHP SAVE STATUS WHILE SUBTRACTING
|
||
|
|
1050 DEC CURLIN+1 IF WAS $FF (MEANING DIRECT MODE)
|
||
|
|
1060 * MAKE IT "RUNNING MODE"
|
||
|
|
1070 PLP GET STATUS AGAIN (FROM CHRGET)
|
||
|
|
1080 BNE .1 PROBABLY A LINE NUMBER
|
||
|
|
1090 JMP SETPTRS START AT BEGINNING OF PROGRAM
|
||
|
|
1100 .1 JSR CLEARC CLEAR VARIABLES
|
||
|
|
1110 JMP GO.TO.LINE JOIN GOSUB STATEMENT
|
||
|
|
1120 *--------------------------------
|
||
|
|
1130 * "GOSUB" STATEMENT
|
||
|
|
1140 *
|
||
|
|
1150 * LEAVES 7 BYTES ON STACK:
|
||
|
|
1160 * 2 -- RETURN ADDRESS (NEWSTT)
|
||
|
|
1170 * 2 -- TXTPTR
|
||
|
|
1180 * 2 -- LINE #
|
||
|
|
1190 * 1 -- GOSUB TOKEN ($B0)
|
||
|
|
1200 *--------------------------------
|
||
|
|
1210 GOSUB LDA #3 BE SURE ENOUGH ROOM ON STACK
|
||
|
|
1220 JSR CHKMEM
|
||
|
|
1230 LDA TXTPTR+1
|
||
|
|
1240 PHA
|
||
|
|
1250 LDA TXTPTR
|
||
|
|
1260 PHA
|
||
|
|
1270 LDA CURLIN+1
|
||
|
|
1280 PHA
|
||
|
|
1290 LDA CURLIN
|
||
|
|
1300 PHA
|
||
|
|
1310 LDA #TOKEN.GOSUB
|
||
|
|
1320 PHA
|
||
|
|
1330 GO.TO.LINE
|
||
|
|
1340 JSR CHRGOT
|
||
|
|
1350 JSR GOTO
|
||
|
|
1360 JMP NEWSTT
|
||
|
|
1370 *--------------------------------
|
||
|
|
1380 * "GOTO" STATEMENT
|
||
|
|
1390 * ALSO USED BY "RUN" AND "GOSUB"
|
||
|
|
1400 *--------------------------------
|
||
|
|
1410 GOTO JSR LINGET GET GOTO LINE
|
||
|
|
1420 JSR REMN POINT Y TO EOL
|
||
|
|
1430 LDA CURLIN+1 IS CURRENT PAGE < GOTO PAGE?
|
||
|
|
1440 CMP LINNUM+1
|
||
|
|
1450 BCS .1 SEARCH FROM PROG START IF NOT
|
||
|
|
1460 TYA OTHERWISE SEARCH FROM NEXT LINE
|
||
|
|
1470 SEC
|
||
|
|
1480 ADC TXTPTR
|
||
|
|
1490 LDX TXTPTR+1
|
||
|
|
1500 BCC .2
|
||
|
|
1510 INX
|
||
|
|
1520 BCS .2
|
||
|
|
1530 .1 LDA TXTTAB GET PROGRAM BEGINNING
|
||
|
|
1540 LDX TXTTAB+1
|
||
|
|
1550 .2 JSR FL1 SEARCH FOR GOTO LINE
|
||
|
|
1560 BCC UNDERR ERROR IF NOT THERE
|
||
|
|
1570 LDA LOWTR TXTPTR = START OF THE DESTINATION LINE
|
||
|
|
1580 SBC #1
|
||
|
|
1590 STA TXTPTR
|
||
|
|
1600 LDA LOWTR+1
|
||
|
|
1610 SBC #0
|
||
|
|
1620 STA TXTPTR+1
|
||
|
|
1630 RTS.5 RTS RETURN TO NEWSTT OR GOSUB
|
||
|
|
1640 *--------------------------------
|
||
|
|
1650 * "POP" AND "RETURN" STATEMENTS
|
||
|
|
1660 *--------------------------------
|
||
|
|
1670 POP BNE RTS.5
|
||
|
|
1680 LDA #$FF
|
||
|
|
1690 STA FORPNT <<< BUG: SHOULD BE FORPNT+1 >>>
|
||
|
|
1700 * <<< SEE "ALL ABOUT APPLESOFT", PAGES 100,101 >>>
|
||
|
|
1710 JSR GTFORPNT TO CANCEL FOR/NEXT IN SUB
|
||
|
|
1720 TXS
|
||
|
|
1730 CMP #TOKEN.GOSUB LAST GOSUB FOUND?
|
||
|
|
1740 BEQ RETURN
|
||
|
|
1750 LDX #ERR.NOGOSUB
|
||
|
|
1760 .HS 2C FAKE
|
||
|
|
1770 UNDERR LDX #ERR.UNDEFSTAT
|
||
|
|
1780 JMP ERROR
|
||
|
|
1790 *--------------------------------
|
||
|
|
1800 SYNERR.2 JMP SYNERR
|
||
|
|
1810 *--------------------------------
|
||
|
|
1820 RETURN PLA DISCARD GOSUB TOKEN
|
||
|
|
1830 PLA
|
||
|
|
1840 CPY #TOKEN.POP*2
|
||
|
|
1850 BEQ PULL3 BRANCH IF A POP
|
||
|
|
1860 STA CURLIN PULL LINE #
|
||
|
|
1870 PLA
|
||
|
|
1880 STA CURLIN+1
|
||
|
|
1890 PLA
|
||
|
|
1900 STA TXTPTR PULL TXTPTR
|
||
|
|
1910 PLA
|
||
|
|
1920 STA TXTPTR+1
|
||
|
|
1930 *--------------------------------
|
||
|
|
1940 * "DATA" STATEMENT
|
||
|
|
1950 * EXECUTED BY SKIPPING TO NEXT COLON OR EOL
|
||
|
|
1960 *--------------------------------
|
||
|
|
1970 DATA JSR DATAN MOVE TO NEXT STATEMENT
|
||
|
|
1980 *--------------------------------
|
||
|
|
1990 * ADD (Y) TO TXTPTR
|
||
|
|
2000 *--------------------------------
|
||
|
|
2010 ADDON TYA
|
||
|
|
2020 CLC
|
||
|
|
2030 ADC TXTPTR
|
||
|
|
2040 STA TXTPTR
|
||
|
|
2050 BCC .1
|
||
|
|
2060 INC TXTPTR+1
|
||
|
|
2070 .1
|
||
|
|
2080 RTS.6 RTS
|
||
|
|
2090 *--------------------------------
|
||
|
|
2100 * SCAN AHEAD TO NEXT ":" OR EOL
|
||
|
|
2110 *--------------------------------
|
||
|
|
2120 DATAN LDX #':' GET OFFSET IN Y TO EOL OR ":"
|
||
|
|
2130 .HS 2C FAKE
|
||
|
|
2140 *--------------------------------
|
||
|
|
2150 REMN LDX #0 TO EOL ONLY
|
||
|
|
2160 STX CHARAC
|
||
|
|
2170 LDY #0
|
||
|
|
2180 STY ENDCHR
|
||
|
|
2190 .1 LDA ENDCHR TRICK TO COUNT QUOTE PARITY
|
||
|
|
2200 LDX CHARAC
|
||
|
|
2210 STA CHARAC
|
||
|
|
2220 STX ENDCHR
|
||
|
|
2230 .2 LDA (TXTPTR),Y
|
||
|
|
2240 BEQ RTS.6 END OF LINE
|
||
|
|
2250 CMP ENDCHR
|
||
|
|
2260 BEQ RTS.6 COLON IF LOOKING FOR COLONS
|
||
|
|
2270 INY
|
||
|
|
2280 CMP #'"'
|
||
|
|
2290 BNE .2
|
||
|
|
2300 BEQ .1 ...ALWAYS
|
||
|
|
2310 *--------------------------------
|
||
|
|
2320 PULL3 PLA
|
||
|
|
2330 PLA
|
||
|
|
2340 PLA
|
||
|
|
2350 RTS
|
||
|
|
2360 *--------------------------------
|
||
|
|
2370 * "IF" STATEMENT
|
||
|
|
2380 *--------------------------------
|
||
|
|
2390 IF JSR FRMEVL
|
||
|
|
2400 JSR CHRGOT
|
||
|
|
2410 CMP #TOKEN.GOTO
|
||
|
|
2420 BEQ .1
|
||
|
|
2430 LDA #TOKEN.THEN
|
||
|
|
2440 JSR SYNCHR
|
||
|
|
2450 .1 LDA FAC CONDITION TRUE OR FALSE?
|
||
|
|
2460 BNE IF.TRUE BRANCH IF TRUE
|
||
|
|
2470 *--------------------------------
|
||
|
|
2480 * "REM" STATEMENT, OR FALSE "IF" STATEMENT
|
||
|
|
2490 *--------------------------------
|
||
|
|
2500 REM JSR REMN SKIP REST OF LINE
|
||
|
|
2510 BEQ ADDON ...ALWAYS
|
||
|
|
2520 *--------------------------------
|
||
|
|
2530 IF.TRUE
|
||
|
|
2540 JSR CHRGOT COMMAND OR NUMBER?
|
||
|
|
2550 BCS .1 COMMAND
|
||
|
|
2560 JMP GOTO NUMBER
|
||
|
|
2570 .1 JMP EXECUTE.STATEMENT
|
||
|
|
2580 *--------------------------------
|
||
|
|
2590 * "ON" STATEMENT
|
||
|
|
2600 *
|
||
|
|
2610 * ON <EXP> GOTO <LIST>
|
||
|
|
2620 * ON <EXP> GOSUB <LIST>
|
||
|
|
2630 *--------------------------------
|
||
|
|
2640 ONGOTO JSR GETBYT EVALUATE <EXP>, AS BYTE IN FAC+4
|
||
|
|
2650 PHA SAVE NEXT CHAR ON STACK
|
||
|
|
2660 CMP #TOKEN.GOSUB
|
||
|
|
2670 BEQ ON.2
|
||
|
|
2680 ON.1 CMP #TOKEN.GOTO
|
||
|
|
2690 BNE SYNERR.2
|
||
|
|
2700 ON.2 DEC FAC+4 COUNTED TO RIGHT ONE YET?
|
||
|
|
2710 BNE .3 NO, KEEP LOOKING
|
||
|
|
2720 PLA YES, RETRIEVE CMD
|
||
|
|
2730 JMP EXECUTE.STATEMENT.1 AND GO.
|
||
|
|
2740 .3 JSR CHRGET PRIME CONVERT SUBROUTINE
|
||
|
|
2750 JSR LINGET CONVERT LINE #
|
||
|
|
2760 CMP #',' TERMINATE WITH COMMA?
|
||
|
|
2770 BEQ ON.2 YES
|
||
|
|
2780 PLA NO, END OF LIST, SO IGNORE
|
||
|
|
2790 RTS.7 RTS
|
||
|
|
2800 *--------------------------------
|
||
|
|
2810 * CONVERT LINE NUMBER
|
||
|
|
2820 *--------------------------------
|
||
|
|
2830 LINGET LDX #0 ASC # TO HEX ADDRESS
|
||
|
|
2840 STX LINNUM IN LINNUM.
|
||
|
|
2850 STX LINNUM+1
|
||
|
|
2860 .1 BCS RTS.7 NOT A DIGIT
|
||
|
|
2870 SBC #'0'-1 CONVERT DIGIT TO BINARY
|
||
|
|
2880 STA CHARAC SAVE THE DIGIT
|
||
|
|
2890 LDA LINNUM+1 CHECK RANGE
|
||
|
|
2900 STA INDEX
|
||
|
|
2910 CMP /6400 LINE # TOO LARGE?
|
||
|
|
2920 BCS ON.1 YES, > 63999, GO INDIRECTLY TO
|
||
|
|
2930 * "SYNTAX ERROR".
|
||
|
|
2940 *<<<<<DANGEROUS CODE>>>>>
|
||
|
|
2950 * NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
|
||
|
|
2960 * ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
|
||
|
|
2970 * JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
|
||
|
|
2980 * FOR OTHER CALLS TO LINGET.
|
||
|
|
2990 *
|
||
|
|
3000 * YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
|
||
|
|
3010 * THEN TYPE "GO TO 437761".
|
||
|
|
3020 *
|
||
|
|
3030 * ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
|
||
|
|
3040 * THE PROBLEM. ($AB00 - $ABFF)
|
||
|
|
3050 *<<<<<DANGEROUS CODE>>>>>
|
||
|
|
3060 LDA LINNUM MULTIPLY BY TEN
|
||
|
|
3070 ASL
|
||
|
|
3080 ROL INDEX
|
||
|
|
3090 ASL
|
||
|
|
3100 ROL INDEX
|
||
|
|
3110 ADC LINNUM
|
||
|
|
3120 STA LINNUM
|
||
|
|
3130 LDA INDEX
|
||
|
|
3140 ADC LINNUM+1
|
||
|
|
3150 STA LINNUM+1
|
||
|
|
3160 ASL LINNUM
|
||
|
|
3170 ROL LINNUM+1
|
||
|
|
3180 LDA LINNUM
|
||
|
|
3190 ADC CHARAC ADD DIGIT
|
||
|
|
3200 STA LINNUM
|
||
|
|
3210 BCC .2
|
||
|
|
3220 INC LINNUM+1
|
||
|
|
3230 .2 JSR CHRGET GET NEXT CHAR
|
||
|
|
3240 JMP .1 MORE CONVERTING
|
||
|
|
3250 *--------------------------------
|
||
|
|
3260 * "LET" STATEMENT
|
||
|
|
3270 *
|
||
|
|
3280 * LET <VAR> = <EXP>
|
||
|
|
3290 * <VAR> = <EXP>
|
||
|
|
3300 *--------------------------------
|
||
|
|
3310 LET JSR PTRGET GET <VAR>
|
||
|
|
3320 STA FORPNT
|
||
|
|
3330 STY FORPNT+1
|
||
|
|
3340 LDA #TOKEN.EQUAL
|
||
|
|
3350 JSR SYNCHR
|
||
|
|
3360 LDA VALTYP+1 SAVE VARIABLE TYPE
|
||
|
|
3370 PHA
|
||
|
|
3380 LDA VALTYP
|
||
|
|
3390 PHA
|
||
|
|
3400 JSR FRMEVL EVALUATE <EXP>
|
||
|
|
3410 PLA
|
||
|
|
3420 ROL
|
||
|
|
3430 JSR CHKVAL
|
||
|
|
3440 BNE LET.STRING
|
||
|
|
3450 PLA
|
||
|
|
3460 *--------------------------------
|
||
|
|
3470 LET2 BPL .1 REAL VARIABLE
|
||
|
|
3480 JSR ROUND.FAC INTEGER VAR: ROUND TO 32 BITS
|
||
|
|
3490 JSR AYINT TRUNCATE TO 16-BITS
|
||
|
|
3500 LDY #0
|
||
|
|
3510 LDA FAC+3
|
||
|
|
3520 STA (FORPNT),Y
|
||
|
|
3530 INY
|
||
|
|
3540 LDA FAC+4
|
||
|
|
3550 STA (FORPNT),Y
|
||
|
|
3560 RTS
|
||
|
|
3570 *--------------------------------
|
||
|
|
3580 * REAL VARIABLE = EXPRESSION
|
||
|
|
3590 *--------------------------------
|
||
|
|
3600 .1 JMP SETFOR
|
||
|
|
3610 *--------------------------------
|
||
|
|
3620 LET.STRING
|
||
|
|
3630 PLA
|
||
|
|
3640 *--------------------------------
|
||
|
|
3650 * INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
|
||
|
|
3660 *--------------------------------
|
||
|
|
3670 PUTSTR LDY #2 STRING DATA ALREADY IN STRING AREA?
|
||
|
|
3680 LDA (FAC+3),Y (STRING AREA IS BTWN FRETOP
|
||
|
|
3690 CMP FRETOP+1 HIMEM)
|
||
|
|
3700 BCC .2 YES, DATA ALREADY UP THERE
|
||
|
|
3710 BNE .1 NO
|
||
|
|
3720 DEY MAYBE, TEST LOW BYTE OF POINTER
|
||
|
|
3730 LDA (FAC+3),Y
|
||
|
|
3740 CMP FRETOP
|
||
|
|
3750 BCC .2 YES, ALREADY THERE
|
||
|
|
3760 .1 LDY FAC+4 NO. DESCRIPTOR ALREADY AMONG VARIABLES?
|
||
|
|
3770 CPY VARTAB+1
|
||
|
|
3780 BCC .2 NO
|
||
|
|
3790 BNE .3 YES
|
||
|
|
3800 LDA FAC+3 MAYBE, COMPARE LO-BYTE
|
||
|
|
3810 CMP VARTAB
|
||
|
|
3820 BCS .3 YES, DESCRIPTOR IS AMONG VARIABLES
|
||
|
|
3830 .2 LDA FAC+3 EITHER STRING ALREADY ON TOP, OR
|
||
|
|
3840 LDY FAC+4 DESCRIPTOR IS NOT A VARIABLE
|
||
|
|
3850 JMP .4 SO JUST STORE THE DESCRIPTOR
|
||
|
|
3860 *--------------------------------
|
||
|
|
3870 * STRING NOT YET IN STRING AREA,
|
||
|
|
3880 * AND DESCRIPTOR IS A VARIABLE
|
||
|
|
3890 *--------------------------------
|
||
|
|
3900 .3 LDY #0 POINT AT LENGTH IN DESCRIPTOR
|
||
|
|
3910 LDA (FAC+3),Y GET LENGTH
|
||
|
|
3920 JSR STRINI MAKE A STRING THAT LONG UP ABOVE
|
||
|
|
3930 LDA DSCPTR SET UP SOURCE PNTR FOR MONINS
|
||
|
|
3940 LDY DSCPTR+1
|
||
|
|
3950 STA STRNG1
|
||
|
|
3960 STY STRNG1+1
|
||
|
|
3970 JSR MOVINS MOVE STRING DATA TO NEW AREA
|
||
|
|
3980 LDA #FAC ADDRESS OF DESCRIPTOR IS IN FAC
|
||
|
|
3990 LDY /FAC
|
||
|
|
4000 .4 STA DSCPTR
|
||
|
|
4010 STY DSCPTR+1
|
||
|
|
4020 JSR FRETMS DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
|
||
|
|
4030 LDY #0 COPY STRING DESCRIPTOR
|
||
|
|
4040 LDA (DSCPTR),Y
|
||
|
|
4050 STA (FORPNT),Y
|
||
|
|
4060 INY
|
||
|
|
4070 LDA (DSCPTR),Y
|
||
|
|
4080 STA (FORPNT),Y
|
||
|
|
4090 INY
|
||
|
|
4100 LDA (DSCPTR),Y
|
||
|
|
4110 STA (FORPNT),Y
|
||
|
|
4120 RTS
|