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

369 lines
13 KiB
Plaintext

1010 *--------------------------------
1020 * "CALL" STATEMENT
1030 *
1040 * EFFECTIVELY PERFORMS A "JSR" TO THE SPECIFIED
1050 * ADDRESS, WITH THE FOLLOWING REGISTER CONTENTS:
1060 * (A,Y) = CALL ADDRESS
1070 * (X) = $9D
1080 *
1090 * THE CALLED ROUTINE CAN RETURN WITH "RTS",
1100 * AND APPLESOFT WILL CONTINUE WITH THE NEXT
1110 * STATEMENT.
1120 *--------------------------------
1130 CALL JSR FRMNUM EVALUATE EXPRESSION FOR CALL ADDRESS
1140 JSR GETADR CONVERT EXPRESSION TO 16-BIT INTEGER
1150 JMP (LINNUM) IN LINNUM, AND JUMP THERE.
1160 *--------------------------------
1170 * "IN#" STATEMENT
1180 *
1190 * NOTE: NO CHECK FOR VALID SLOT #, AS LONG
1200 * AS VALUE IS < 256 IT IS ACCEPTED.
1210 * MONITOR MASKS VALUE TO 4 BITS (0-15).
1220 *--------------------------------
1230 IN.NUMBER
1240 JSR GETBYT GET SLOT NUMBER IN X-REG
1250 TXA MONITOR WILL INSTALL IN VECTOR
1260 JMP MON.INPORT AT $38,39.
1270 *--------------------------------
1280 * "PR#" STATEMENT
1290 *
1300 * NOTE: NO CHECK FOR VALID SLOT #, AS LONG
1310 * AS VALUE IS < 256 IT IS ACCEPTED.
1320 * MONITOR MASKS VALUE TO 4 BITS (0-15).
1330 *--------------------------------
1340 PR.NUMBER
1350 JSR GETBYT GET SLOT NUMBER IN X-REG
1360 TXA MONITOR WILL INSTALL IN VECTOR
1370 JMP MON.OUTPORT AT $36,37
1380 *--------------------------------
1390 * GET TWO VALUES < 48, WITH COMMA SEPARATOR
1400 *
1410 * CALLED FOR "PLOT X,Y"
1420 * AND "HLIN A,B AT Y"
1430 * AND "VLIN A,B AT X"
1440 *
1450 *--------------------------------
1460 PLOTFNS
1470 JSR GETBYT GET FIRST VALUE IN X-REG
1480 CPX #48 MUST BE < 48
1490 BCS GOERR TOO LARGE
1500 STX FIRST SAVE FIRST VALUE
1510 LDA #',' MUST HAVE A COMMA
1520 JSR SYNCHR
1530 JSR GETBYT GET SECOND VALUE IN X-REG
1540 CPX #48 MUST BE < 48
1550 BCS GOERR TOO LARGE
1560 STX MON.H2 SAVE SECOND VALUE
1570 STX MON.V2
1580 RTS SECOND VALUE STILL IN X-REG
1590 *--------------------------------
1600 GOERR JMP IQERR ILLEGAL QUANTITY ERROR
1610 *--------------------------------
1620 * GET "A,B AT C" VALUES FOR "HLIN" AND "VLIN"
1630 *
1640 * PUT SMALLER OF (A,B) IN FIRST,
1650 * AND LARGER OF (A,B) IN H2 AND V2.
1660 * RETURN WITH (X) = C-VALUE.
1670 *--------------------------------
1680 LINCOOR
1690 JSR PLOTFNS GET A,B VALUES
1700 CPX FIRST IS A < B?
1710 BCS .1 YES, IN RIGHT ORDER
1720 LDA FIRST NO, INTERCHANGE THEM
1730 STA MON.H2
1740 STA MON.V2
1750 STX FIRST
1760 .1 LDA #TOKEN.AT MUST HAVE "AT" NEXT
1770 JSR SYNCHR
1780 JSR GETBYT GET C-VALUE IN X-REG
1790 CPX #48 MUST BE < 48
1800 BCS GOERR TOO LARGE
1810 RTS C-VALUE IN X-REG
1820 *--------------------------------
1830 * "PLOT" STATEMENT
1840 *--------------------------------
1850 PLOT JSR PLOTFNS GET X,Y VALUES
1860 TXA Y-COORD TO A-REG FOR MONITOR
1870 LDY FIRST X-COORD TO Y-YEG FOR MONITOR
1880 CPY #40 X-COORD MUST BE < 40
1890 BCS GOERR X-COORD IS TOO LARGE
1900 JMP MON.PLOT PLOT!
1910 *--------------------------------
1920 * "HLIN" STATEMENT
1930 *--------------------------------
1940 HLIN JSR LINCOOR GET "A,B AT C"
1950 TXA Y-COORD IN A-REG
1960 LDY MON.H2 RIGHT END OF LINE
1970 CPY #40 MUST BE < 40
1980 BCS GOERR TOO LARGE
1990 LDY FIRST LEFT END OF LINE IN Y-REG
2000 JMP MON.HLINE LET MONITOR DRAW LINE
2010 *--------------------------------
2020 * "VLIN" STATEMENT
2030 *--------------------------------
2040 VLIN JSR LINCOOR GET "A,B AT C"
2050 TXA X-COORD IN Y-REG
2060 TAY
2070 CPY #40 X-COORD MUST BE < 40
2080 BCS GOERR TOO LARGE
2090 LDA FIRST TOP END OF LINE IN A-REG
2100 JMP MON.VLINE LET MONITOR DRAW LINE
2110 *--------------------------------
2120 * "COLOR=" STATEMENT
2130 *--------------------------------
2140 COLOR JSR GETBYT GET COLOR VALUE IN X-REG
2150 TXA
2160 JMP MON.SETCOL LET MONITOR STORE COLOR
2170 *--------------------------------
2180 * "VTAB" STATEMENT
2190 *--------------------------------
2200 VTAB JSR GETBYT GET LINE # IN X-REG
2210 DEX CONVERT TO ZERO BASE
2220 TXA
2230 CMP #24 MUST BE 0-23
2240 BCS GOERR TOO LARGE, OR WAS "VTAB 0"
2250 JMP MON.TABV LET MONITOR COMPUTE BASE
2260 *--------------------------------
2270 * "SPEED=" STATEMENT
2280 *--------------------------------
2290 SPEED JSR GETBYT GET SPEED SETTING IN X-REG
2300 TXA SPEEDZ = $100-SPEED
2310 EOR #$FF SO "SPEED=255" IS FASTEST
2320 TAX
2330 INX
2340 STX SPEEDZ
2350 RTS
2360 *--------------------------------
2370 * "TRACE" STATEMENT
2380 * SET SIGN BIT IN TRCFLG
2390 *--------------------------------
2400 TRACE SEC
2410 .HS 90 FAKE BCC TO SKIP NEXT OPCODE
2420 *--------------------------------
2430 * "NOTRACE" STATEMENT
2440 * CLEAR SIGN BIT IN TRCFLG
2450 *--------------------------------
2460 NOTRACE
2470 CLC
2480 ROR TRCFLG SHIFT CARRY INTO TRCFLG
2490 RTS
2500 *--------------------------------
2510 * "NORMAL" STATEMENT
2520 *--------------------------------
2530 NORMAL LDA #$FF SET INVFLG = $FF
2540 BNE N.I. AND FLASH.BIT = $00
2550 *--------------------------------
2560 * "INVERSE" STATEMENT
2570 *--------------------------------
2580 INVERSE
2590 LDA #$3F SET INVFLG = $3F
2600 N.I. LDX #0 AND FLASH.BIT = $00
2610 N.I.F. STA MON.INVFLG
2620 STX FLASH.BIT
2630 RTS
2640 *--------------------------------
2650 * "FLASH" STATEMENT
2660 *--------------------------------
2670 FLASH LDA #$7F SET INVFLG = $7F
2680 LDX #$40 AND FLASH.BIT = $40
2690 BNE N.I.F. ...ALWAYS
2700 *--------------------------------
2710 * "HIMEM:" STATEMENT
2720 *--------------------------------
2730 HIMEM JSR FRMNUM GET VALUE SPECIFIED FOR HIMEM
2740 JSR GETADR AS 16-BIT INTEGER
2750 LDA LINNUM MUST BE ABOVE VARIABLES AND ARRAYS
2760 CMP STREND
2770 LDA LINNUM+1
2780 SBC STREND+1
2790 BCS SETHI IT IS ABOVE THEM
2800 JMM JMP MEMERR NOT ENOUGH MEMORY
2810 SETHI LDA LINNUM STORE NEW HIMEM: VALUE
2820 STA MEMSIZ
2830 STA FRETOP <<<NOTE THAT "HIMEM:" DOES NOT>>>
2840 LDA LINNUM+1 <<<CLEAR STRING VARIABLES. >>>
2850 STA MEMSIZ+1 <<<THIS COULD BE DISASTROUS. >>>
2860 STA FRETOP+1
2870 RTS
2880 *--------------------------------
2890 * "LOMEM:" STATEMENT
2900 *--------------------------------
2910 LOMEM JSR FRMNUM GET VALUE SPECIFIED FOR LOMEM
2920 JSR GETADR AS 16-BIT INTEGER IN LINNUM
2930 LDA LINNUM MUST BE BELOW HIMEM
2940 CMP MEMSIZ
2950 LDA LINNUM+1
2960 SBC MEMSIZ+1
2970 BCS JMM ABOVE HIMEM, MEMORY ERROR
2980 LDA LINNUM MUST BE ABOVE PROGRAM
2990 CMP VARTAB
3000 LDA LINNUM+1
3010 SBC VARTAB+1
3020 BCC JMM NOT ABOVE PROGRAM, ERROR
3030 LDA LINNUM STORE NEW LOMEM VALUE
3040 STA VARTAB
3050 LDA LINNUM+1
3060 STA VARTAB+1
3070 JMP CLEARC LOMEM CLEARS VARIABLES AND ARRAYS
3080 *--------------------------------
3090 * "ON ERR GO TO" STATEMENT
3100 *--------------------------------
3110 ONERR LDA #TOKEN.GOTO MUST BE "GOTO" NEXT
3120 JSR SYNCHR
3130 LDA TXTPTR SAVE TXTPTR FOR HANDLERR
3140 STA TXTPSV
3150 LDA TXTPTR+1
3160 STA TXTPSV+1
3170 SEC SET SIGN BIT OF ERRFLG
3180 ROR ERRFLG
3190 LDA CURLIN SAVE LINE # OF CURRENT LINE
3200 STA CURLSV
3210 LDA CURLIN+1
3220 STA CURLSV+1
3230 JSR REMN IGNORE REST OF LINE <<<WHY?>>>
3240 JMP ADDON CONTINUE PROGRAM
3250 *--------------------------------
3260 * ROUTINE TO HANDLE ERRORS IF ONERR GOTO ACTIVE
3270 *--------------------------------
3280 HANDLERR
3290 STX ERRNUM SAVE ERROR CODE NUMBER
3300 LDX REMSTK GET STACK PNTR SAVED AT NEWSTT
3310 STX ERRSTK REMEMBER IT
3320 * <<<COULD ALSO HAVE DONE TXS >>>
3330 * <<<HERE; SEE ONERR CORRECTION>>>
3340 * <<<IN APPLESOFT MANUAL. >>>
3350 LDA CURLIN GET LINE # OF OFFENDING STATEMENT
3360 STA ERRLIN SO USER CAN SEE IT IF DESIRED
3370 LDA CURLIN+1
3380 STA ERRLIN+1
3390 LDA OLDTEXT ALSO THE POSITION IN THE LINE
3400 STA ERRPOS IN CASE USER WANTS TO "RESUME"
3410 LDA OLDTEXT+1
3420 STA ERRPOS+1
3430 LDA TXTPSV SET UP TXTPTR TO READ TARGET LINE #
3440 STA TXTPTR IN "ON ERR GO TO XXXX"
3450 LDA TXTPSV+1
3460 STA TXTPTR+1
3470 LDA CURLSV
3480 STA CURLIN LINE # OF "ON ERR" STATEMENT
3490 LDA CURLSV+1
3500 STA CURLIN+1
3510 JSR CHRGOT START CONVERSION
3520 JSR GOTO GOTO SPECIFIED ONERR LINE
3530 JMP NEWSTT
3540 *--------------------------------
3550 * "RESUME" STATEMENT
3560 *--------------------------------
3570 RESUME LDA ERRLIN RESTORE LINE # AND TXTPTR
3580 STA CURLIN TO RE-TRY OFFENDING LINE
3590 LDA ERRLIN+1
3600 STA CURLIN+1
3610 LDA ERRPOS
3620 STA TXTPTR
3630 LDA ERRPOS+1
3640 STA TXTPTR+1
3650 * <<< ONERR CORRECTION IN MANUAL IS EASILY >>>
3660 * <<< BY "CALL -3288", WHICH IS $F328 HERE >>>
3670 LDX ERRSTK RETRIEVE STACK PNTR AS IT WAS
3680 TXS BEFORE STATEMENT SCANNED
3690 JMP NEWSTT DO STATEMENT AGAIN
3700 *--------------------------------
3710 JSYN JMP SYNERR
3720 *--------------------------------
3730 * "DEL" STATEMENT
3740 *--------------------------------
3750 DEL BCS JSYN ERROR IF # NOT SPECIFIED
3760 LDX PRGEND
3770 STX VARTAB
3780 LDX PRGEND+1
3790 STX VARTAB+1
3800 JSR LINGET GET BEGINNING OF RANGE
3810 JSR FNDLIN FIND THIS LINE OR NEXT
3820 LDA LOWTR UPPER PORTION OF PROGRAM WILL
3830 STA DEST BE MOVED DOWN TO HERE
3840 LDA LOWTR+1
3850 STA DEST+1
3860 LDA #',' MUST HAVE A COMMA NEXT
3870 JSR SYNCHR
3880 JSR LINGET GET END RANGE
3890 * (DOES NOTHING IF END RANGE
3900 * IS NOT SPECIFIED)
3910 INC LINNUM POINT ONE PAST IT
3920 BNE .1
3930 INC LINNUM+1
3940 .1 JSR FNDLIN FIND START LINE AFTER SPECIFIED LINE
3950 LDA LOWTR WHICH IS BEGINNING OF PORTION
3960 CMP DEST TO BE MOVED DOWN
3970 LDA LOWTR+1 IT MUST BE ABOVE THE TARGET
3980 SBC DEST+1
3990 BCS .2 IT IS OKAY
4000 RTS NOTHING TO DELETE
4010 .2 LDY #0 MOVE UPPER PORTION DOWN NOW
4020 .3 LDA (LOWTR),Y SOURCE . . .
4030 STA (DEST),Y ...TO DESTINATION
4040 INC LOWTR BUMP SOURCE PNTR
4050 BNE .4
4060 INC LOWTR+1
4070 .4 INC DEST BUMP DESTINATION PNTR
4080 BNE .5
4090 INC DEST+1
4100 .5 LDA VARTAB REACHED END OF PROGRAM YET?
4110 CMP LOWTR
4120 LDA VARTAB+1
4130 SBC LOWTR+1
4140 BCS .3 NO, KEEP MOVING
4150 LDX DEST+1 STORE NEW END OF PROGRAM
4160 LDY DEST MUST SUBTRACT 1 FIRST
4170 BNE .6
4180 DEX
4190 .6 DEY
4200 STX VARTAB+1
4210 STY VARTAB
4220 JMP FIX.LINKS RESET LINKS AFTER A DELETE
4230 *--------------------------------
4240 * "GR" STATEMENT
4250 *--------------------------------
4260 GR LDA SW.LORES
4270 LDA SW.MIXSET
4280 JMP MON.SETGR
4290 *--------------------------------
4300 * "TEXT" STATEMENT
4310 *--------------------------------
4320 TEXT LDA SW.LOWSCR JMP $FB36 WOULD HAVE
4330 JMP MON.SETTXT DONE BOTH OF THESE
4340 * <<< BETTER CODE WOULD BE: >>>
4350 * <<< LDA SW.MIXSET >>>
4360 * <<< JMP $FB33 >>>
4370 *--------------------------------
4380 * "STORE" STATEMENT
4390 *--------------------------------
4400 STORE JSR GETARYPT GET ADDRESS OF ARRAY TO BE SAVED
4410 LDY #3 FORWARD OFFSET - 1 IS SIZE OF
4420 LDA (LOWTR),Y THIS ARRAY
4430 TAX
4440 DEY
4450 LDA (LOWTR),Y
4460 SBC #1
4470 BCS .1
4480 DEX
4490 .1 STA LINNUM
4500 STX LINNUM+1
4510 JSR MON.WRITE
4520 JSR TAPEPNT
4530 JMP MON.WRITE
4540 *--------------------------------
4550 * "RECALL" STATEMENT
4560 *--------------------------------
4570 RECALL JSR GETARYPT FIND ARRAY IN MEMORY
4580 JSR MON.READ READ HEADER
4590 LDY #2 MAKE SURE THE NEW DATA FITS
4600 LDA (LOWTR),Y
4610 CMP LINNUM
4620 INY
4630 LDA (LOWTR),Y
4640 SBC LINNUM+1
4650 BCS .1 IT FITS
4660 JMP MEMERR DOESN'T FIT
4670 .1 JSR TAPEPNT READ THE DATA
4680 JMP MON.READ