Apple-2-Tools/goapple2
1
0
Fork 0
mirror of https://github.com/zellyn/goapple2.git synced 2024-11-29 08:49:49 +00:00
Code Issues Projects Releases Wiki Activity
master
goapple2/source/applesoft/S.D766
Zellyn Hunter 5c89db1649 Add AppleSoft basic source
2014-05-09 17:59:16 -07:00

273 lines
9.0 KiB
Plaintext
Raw Permalink Blame History

1010 *--------------------------------
1020 * "FOR" STATEMENT
1030 *
1040 * FOR PUSHES 18 BYTES ON THE STACK:
1050 * 2 -- TXTPTR
1060 * 2 -- LINE NUMBER
1070 * 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
1080 * 1 -- STEP SIGN
1090 * 5 -- STEP VALUE
1100 * 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
1110 * 1 -- FOR TOKEN ($81)
1120 *--------------------------------
1130 FOR LDA #$80
1140 STA SUBFLG SUBSCRIPTS NOT ALLOWED
1150 JSR LET DO <VAR> = <EXP>, STORE ADDR IN FORPNT
1160 JSR GTFORPNT IS THIS FOR VARIABLE ACTIVE?
1170 BNE .1 NO
1180 TXA YES, CANCEL IT AND ENCLOSED LOOPS
1190 ADC #15 CARRY=1, THIS ADDS 16
1200 TAX X WAS ALREADY S+2
1210 TXS
1220 .1 PLA POP RETURN ADDRESS TOO
1230 PLA
1240 LDA #9 BE CERTAIN ENOUGH ROOM IN STACK
1250 JSR CHKMEM
1260 JSR DATAN SCAN AHEAD TO NEXT STATEMENT
1270 CLC PUSH STATEMENT ADDRESS ON STACK
1280 TYA
1290 ADC TXTPTR
1300 PHA
1310 LDA TXTPTR+1
1320 ADC #0
1330 PHA
1340 LDA CURLIN+1 PUSH LINE NUMBER ON STACK
1350 PHA
1360 LDA CURLIN
1370 PHA
1380 LDA #TOKEN.TO
1390 JSR SYNCHR REQUIRE "TO"
1400 JSR CHKNUM <VAR> = <EXP> MUST BE NUMERIC
1410 JSR FRMNUM GET FINAL VALUE, MUST BE NUMERIC
1420 LDA FAC.SIGN PUT SIGN INTO VALUE IN FAC
1430 ORA #$7F
1440 AND FAC+1
1450 STA FAC+1
1460 LDA #STEP SET UP FOR RETURN
1470 LDY /STEP TO STEP
1480 STA INDEX
1490 STY INDEX+1
1500 JMP FRM.STACK.3 RETURNS BY "JMP (INDEX)"
1510 *--------------------------------
1520 * "STEP" PHRASE OF "FOR" STATEMENT
1530 *--------------------------------
1540 STEP LDA #CON.ONE STEP DEFAULT=1
1550 LDY /CON.ONE
1560 JSR LOAD.FAC.FROM.YA
1570 JSR CHRGOT
1580 CMP #TOKEN.STEP
1590 BNE .1 USE DEFAULT VALUE OF 1.0
1600 JSR CHRGET STEP SPECIFIED, GET IT
1610 JSR FRMNUM
1620 .1 JSR SIGN
1630 JSR FRM.STACK.2
1640 LDA FORPNT+1
1650 PHA
1660 LDA FORPNT
1670 PHA
1680 LDA #TOKEN.FOR
1690 PHA
1700 *--------------------------------
1710 * PERFORM NEXT STATEMENT
1720 *--------------------------------
1730 NEWSTT TSX REMEMBER THE STACK POSITION
1740 STX REMSTK
1750 JSR ISCNTC SEE IF CONTROL-C HAS BEEN TYPED
1760 LDA TXTPTR NO, KEEP EXECUTING
1770 LDY TXTPTR+1
1780 LDX CURLIN+1 =$FF IF IN DIRECT MODE
1790 INX $FF TURNS INTO $00
1800 BEQ .1 IN DIRECT MODE
1810 STA OLDTEXT IN RUNNING MODE
1820 STY OLDTEXT+1
1830 .1 LDY #0
1840 LDA (TXTPTR),Y END OF LINE YET?
1850 BNE COLON. NO
1860 LDY #2 YES, SEE IF END OF PROGRAM
1870 LDA (TXTPTR),Y
1880 CLC
1890 BEQ GOEND YES, END OF PROGRAM
1900 INY
1910 LDA (TXTPTR),Y GET LINE # OF NEXT LINE
1920 STA CURLIN
1930 INY
1940 LDA (TXTPTR),Y
1950 STA CURLIN+1
1960 TYA ADJUST TXTPTR TO START
1970 ADC TXTPTR OF NEW LINE
1980 STA TXTPTR
1990 BCC .2
2000 INC TXTPTR+1
2010 .2
2020 *--------------------------------
2030 TRACE. BIT TRCFLG IS TRACE ON?
2040 BPL .1 NO
2050 LDX CURLIN+1 YES, ARE WE RUNNING?
2060 INX
2070 BEQ .1 NOT RUNNING, SO DON'T TRACE
2080 LDA #'#' PRINT "#"
2090 JSR OUTDO
2100 LDX CURLIN
2110 LDA CURLIN+1
2120 JSR LINPRT PRINT LINE NUMBER
2130 JSR OUTSP PRINT TRAILING SPACE
2140 .1 JSR CHRGET GET FIRST CHR OF STATEMENT
2150 JSR EXECUTE.STATEMENT AND START PROCESSING
2160 JMP NEWSTT BACK FOR MORE
2170 *--------------------------------
2180 GOEND BEQ END4
2190 *--------------------------------
2200 * EXECUTE A STATEMENT
2210 *
2220 * (A) IS FIRST CHAR OF STATEMENT
2230 * CARRY IS SET
2240 *--------------------------------
2250 EXECUTE.STATEMENT
2260 BEQ RTS.3 END OF LINE, NULL STATEMENT
2270 EXECUTE.STATEMENT.1
2280 SBC #$80 FIRST CHAR A TOKEN?
2290 BCC .1 NOT TOKEN, MUST BE "LET"
2300 CMP #$40 STATEMENT-TYPE TOKEN?
2310 BCS SYNERR.1 NO, SYNTAX ERROR
2320 ASL DOUBLE TO GET INDEX
2330 TAY INTO ADDRESS TABLE
2340 LDA TOKEN.ADDRESS.TABLE+1,Y
2350 PHA PUT ADDRESS ON STACK
2360 LDA TOKEN.ADDRESS.TABLE,Y
2370 PHA
2380 JMP CHRGET GET NEXT CHR & RTS TO ROUTINE
2390 *--------------------------------
2400 .1 JMP LET MUST BE <VAR> = <EXP>
2410 *--------------------------------
2420 COLON. CMP #':'
2430 BEQ TRACE.
2440 SYNERR.1 JMP SYNERR
2450 *--------------------------------
2460 * "RESTORE" STATEMENT
2470 *--------------------------------
2480 RESTORE
2490 SEC SET DATPTR TO BEGINNING OF PROGRAM
2500 LDA TXTTAB
2510 SBC #1
2520 LDY TXTTAB+1
2530 BCS SETDA
2540 DEY
2550 *---SET DATPTR TO Y,A------------
2560 SETDA STA DATPTR
2570 STY DATPTR+1
2580 RTS.3 RTS
2590 *--------------------------------
2600 * SEE IF CONTROL-C TYPED
2610 *--------------------------------
2620 ISCNTC LDA KEYBOARD
2630 CMP #$83
2640 BEQ .1
2650 RTS
2660 .1 JSR INCHR <<< SHOULD BE "BIT $C010" >>>
2670 CONTROL.C.TYPED
2680 LDX #$FF CONTROL C ATTEMPTED
2690 BIT ERRFLG "ON ERR" ENABLED?
2700 BPL .2 NO
2710 JMP HANDLERR YES, RETURN ERR CODE = 255
2720 .2 CMP #3 SINCE IT IS CTRL-C, SET Z AND C BITS
2730 *--------------------------------
2740 * "STOP" STATEMENT
2750 *--------------------------------
2760 STOP BCS END2 CARRY=1 TO FORCE PRINTING "BREAK AT.."
2770 *--------------------------------
2780 * "END" STATEMENT
2790 *--------------------------------
2800 END CLC CARRY=0 TO AVOID PRINTING MESSAGE
2810 END2 BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
2820 LDA TXTPTR
2830 LDY TXTPTR+1
2840 LDX CURLIN+1
2850 INX RUNNING?
2860 BEQ .1 NO, DIRECT MODE
2870 STA OLDTEXT
2880 STY OLDTEXT+1
2890 LDA CURLIN
2900 LDY CURLIN+1
2910 STA OLDLIN
2920 STY OLDLIN+1
2930 .1 PLA
2940 PLA
2950 END4 LDA #QT.BREAK " BREAK" AND BELL
2960 LDY /QT.BREAK
2970 BCC .1
2980 JMP PRINT.ERROR.LINNUM
2990 .1 JMP RESTART
3000 *--------------------------------
3010 * "CONT" COMMAND
3020 *--------------------------------
3030 CONT BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
3040 LDX #ERR.CANTCONT
3050 LDY OLDTEXT+1 MEANINGFUL RE-ENTRY?
3060 BNE .1 YES
3070 JMP ERROR NO
3080 .1 LDA OLDTEXT RESTORE TXTPTR
3090 STA TXTPTR
3100 STY TXTPTR+1
3110 LDA OLDLIN RESTORE LINE NUMBER
3120 LDY OLDLIN+1
3130 STA CURLIN
3140 STY CURLIN+1
3150 RTS.4 RTS
3160 *--------------------------------
3170 * "SAVE" COMMAND
3180 * WRITES PROGRAM ON CASSETTE TAPE
3190 *--------------------------------
3200 SAVE SEC
3210 LDA PRGEND COMPUTE PROGRAM LENGTH
3220 SBC TXTTAB
3230 STA LINNUM
3240 LDA PRGEND+1
3250 SBC TXTTAB+1
3260 STA LINNUM+1
3270 JSR VARTIO SET UP TO WRITE 3 BYTE HEADER
3280 JSR MON.WRITE WRITE 'EM
3290 JSR PROGIO SET UP TO WRITE THE PROGRAM
3300 JMP MON.WRITE WRITE IT
3310 *--------------------------------
3320 * "LOAD" COMMAND
3330 * READS A PROGRAM FROM CASSETTE TAPE
3340 *--------------------------------
3350 LOAD JSR VARTIO SET UP TO READ 3 BYTE HEADER
3360 JSR MON.READ READ LENGTH, LOCK BYTE
3370 CLC
3380 LDA TXTTAB COMPUTE END ADDRESS
3390 ADC LINNUM
3400 STA VARTAB
3410 LDA TXTTAB+1
3420 ADC LINNUM+1
3430 STA VARTAB+1
3440 LDA TEMPPT LOCK BYTE
3450 STA LOCK
3460 JSR PROGIO SET UP TO READ PROGRAM
3470 JSR MON.READ READ IT
3480 BIT LOCK IF LOCKED, START RUNNING NOW
3490 BPL .1 NOT LOCKED
3500 JMP SETPTRS LOCKED, START RUNNING
3510 .1 JMP FIX.LINKS JUST FIX FORWARD POINTERS
3520 *--------------------------------
3530 VARTIO LDA #LINNUM SET UP TO READ/WRITE 3 BYTE HEADER
3540 LDY #0
3550 STA MON.A1L
3560 STY MON.A1H
3570 LDA #TEMPPT
3580 STA MON.A2L
3590 STY MON.A2H
3600 STY LOCK
3610 RTS
3620 *--------------------------------
3630 PROGIO LDA TXTTAB SET UP TO READ/WRITE PROGRAM
3640 LDY TXTTAB+1
3650 STA MON.A1L
3660 STY MON.A1H
3670 LDA VARTAB
3680 LDY VARTAB+1
3690 STA MON.A2L
3700 STY MON.A2H
3710 RTS
3720 *--------------------------------
Reference in New Issue View Git Blame Copy Permalink