mirror of
https://github.com/zellyn/goapple2.git
synced 2024-12-01 21:50:13 +00:00
273 lines
9.0 KiB
Plaintext
273 lines
9.0 KiB
Plaintext
|
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 *--------------------------------
|