S-C DocuMentor — Applesoft
SAVE S.DACF
1010 *--------------------------------
1020 PR.STRING
DACF- 20 3D DB 1030 JSR STRPRT
DAD2- 20 B7 00 1040 JSR CHRGOT
1050 *--------------------------------
1060 * "PRINT" STATEMENT
1070 *--------------------------------
DAD5- F0 24 1080 PRINT BEQ CRDO NO MORE LIST, PRINT <RETURN>
1090 *--------------------------------
DAD7- F0 29 1100 PRINT2 BEQ RTS.8 NO MORE LIST, DON'T PRINT <RETURN>
DAD9- C9 C0 1110 CMP #TOKEN.TAB
DADB- F0 39 1120 BEQ PR.TAB.OR.SPC C=1 FOR TAB(
DADD- C9 C3 1130 CMP #TOKEN.SPC
DADF- 18 1140 CLC
DAE0- F0 34 1150 BEQ PR.TAB.OR.SPC C=0 FOR SPC(
DAE2- C9 2C 1160 CMP #','
DAE4- 18 1170 CLC <<< NO PURPOSE TO THIS >>>
DAE5- F0 1C 1180 BEQ PR.COMMA
DAE7- C9 3B 1190 CMP #';'
DAE9- F0 44 1200 BEQ PR.NEXT.CHAR
DAEB- 20 7B DD 1210 JSR FRMEVL EVALUATE EXPRESSION
DAEE- 24 11 1220 BIT VALTYP STRING OR FP VALUE?
DAF0- 30 DD 1230 BMI PR.STRING STRING
DAF2- 20 34 ED 1240 JSR FOUT FP: CONVERT INTO BUFFER
DAF5- 20 E7 E3 1250 JSR STRLIT MAKE BUFFER INTO STRING
DAF8- 4C CF DA 1260 JMP PR.STRING PRINT THE STRING
1270 *--------------------------------
DAFB- A9 0D 1280 CRDO LDA #$0D PRINT <RETURN>
DAFD- 20 5C DB 1290 JSR OUTDO
DB00- 49 FF 1300 NEGATE EOR #$FF <<< WHY??? >>>
DB02- 60 1310 RTS.8 RTS
1320 *--------------------------------
1330 * TAB TO NEXT COMMA COLUMN
1340 * <<< NOTE BUG IF WIDTH OF WINDOW LESS THAN 33 >>>
1350 PR.COMMA
DB03- A5 24 1360 LDA MON.CH
DB05- C9 18 1370 CMP #24 <<< BUG: IT SHOULD BE 32 >>>
DB07- 90 05 1380 BCC .1 NEXT COLUMN, SAME LINE
DB09- 20 FB DA 1390 JSR CRDO FIRST COLUMN, NEXT LINT
DB0C- D0 21 1400 BNE PR.NEXT.CHAR ...ALWAYS
DB0E- 69 10 1410 .1 ADC #16
DB10- 29 F0 1420 AND #$F0 ROUND TO 16 OR 32
DB12- 85 24 1430 STA MON.CH
DB14- 90 19 1440 BCC PR.NEXT.CHAR ...ALWAYS
1450 *--------------------------------
1460 PR.TAB.OR.SPC
DB16- 08 1470 PHP C=0 FOR SPC(, C=1 FOR TAB(
DB17- 20 F5 E6 1480 JSR GTBYTC GET VALUE
DB1A- C9 29 1490 CMP #')' TRAILING PARENTHESIS
DB1C- F0 03 1500 BEQ .1 GOOD
DB1E- 4C C9 DE 1510 JMP SYNERR NO, SYNTAX ERROR
DB21- 28 1520 .1 PLP TAB( OR SPC(
DB22- 90 07 1530 BCC .2 SPC(
DB24- CA 1540 DEX TAB(
DB25- 8A 1550 TXA CALCULATE SPACES NEEDED FOR TAB(
DB26- E5 24 1560 SBC MON.CH
DB28- 90 05 1570 BCC PR.NEXT.CHAR ALREADY PAST THAT COLUMN
DB2A- AA 1580 TAX NOW DO A SPC( TO THE SPECIFIED COLUMN
DB2B- E8 1590 .2 INX
DB2C- CA 1600 NXSPC DEX
DB2D- D0 06 1610 BNE DOSPC MORE SPACES TO PRINT
1620 *--------------------------------
1630 PR.NEXT.CHAR
DB2F- 20 B1 00 1640 JSR CHRGET
DB32- 4C D7 DA 1650 JMP PRINT2 CONTINUE PARSING PRINT LIST
1660 *--------------------------------
DB35- 20 57 DB 1670 DOSPC JSR OUTSP
DB38- D0 F2 1680 BNE NXSPC ...ALWAYS
1690 *--------------------------------
1700 * PRINT STRING AT (Y,A)
DB3A- 20 E7 E3 1710 STROUT JSR STRLIT MAKE (Y,A) PRINTABLE
1720 *--------------------------------
1730 * PRINT STRING AT (FACMO,FACLO)
1740 *--------------------------------
DB3D- 20 00 E6 1750 STRPRT JSR FREFAC GET ADDRESS INTO INDEX, (A)=LENGTH
DB40- AA 1760 TAX USE X-REG FOR COUNTER
DB41- A0 00 1770 LDY #0 USE Y-REG FOR SCANNER
DB43- E8 1780 INX
DB44- CA 1790 .1 DEX
DB45- F0 BB 1800 BEQ RTS.8 FINISHED
DB47- B1 5E 1810 LDA (INDEX),Y NEXT CHAR FROM STRING
DB49- 20 5C DB 1820 JSR OUTDO PRINT THE CHAR
DB4C- C8 1830 INY
1840 * <<< NEXT THREE LINES ARE USELESS >>>
DB4D- C9 0D 1850 CMP #$0D WAS IT <RETURN>?
DB4F- D0 F3 1860 BNE .1 NO
DB51- 20 00 DB 1870 JSR NEGATE EOR #$FF WOULD DO IT, BUT WHY?
1880 * <<< ABOVE THREE LINES ARE USELESS >>>
DB54- 4C 44 DB 1890 JMP .1
1900 *--------------------------------
DB57- A9 20 1910 OUTSP LDA #' ' PRINT A SPACE
DB59- 2C 1920 .HS 2C SKIP OVER NEXT LINE
DB5A- A9 3F 1930 OUTQUES LDA #'?' PRINT QUESTION MARK
1940 *--------------------------------
1950 * PRINT CHAR FROM (A)
1960 *
1970 * NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
1980 * OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
1990 * BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
2000 *--------------------------------
DB5C- 09 80 2010 OUTDO ORA #$80 PRINT (A)
DB5E- C9 A0 2020 CMP #$A0 CONTROL CHR?
DB60- 90 02 2030 BCC .1 SKIP IF SO
DB62- 05 F3 2040 ORA FLASH.BIT =$40 FOR FLASH, ELSE $00
DB64- 20 ED FD 2050 .1 JSR MON.COUT "AND"S WITH $3F (INVERSE), $7F (FLASH)
DB67- 29 7F 2060 AND #$7F
DB69- 48 2070 PHA
DB6A- A5 F1 2080 LDA SPEEDZ COMPLEMENT OF SPEED #
DB6C- 20 A8 FC 2090 JSR MON.WAIT SO SPEED=255 BECOMES (A)=1
DB6F- 68 2100 PLA
DB70- 60 2110 RTS
2120 *--------------------------------
2130 * INPUT CONVERSION ERROR: ILLEGAL CHARACTER
2140 * IN NUMERIC FIELD. MUST DISTINGUISH
2150 * BETWEEN INPUT, READ, AND GET
2160 *--------------------------------
2170 INPUTERR
DB71- A5 15 2180 LDA INPUTFLG
DB73- F0 12 2190 BEQ RESPERR TAKEN IF INPUT
DB75- 30 04 2200 BMI READERR TAKEN IF READ
DB77- A0 FF 2210 LDY #$FF FROM A GET
DB79- D0 04 2220 BNE ERLIN ...ALWAYS
2230 *--------------------------------
2240 READERR
DB7B- A5 7B 2250 LDA DATLIN TELL WHERE THE "DATA" IS, RATHER
DB7D- A4 7C 2260 LDY DATLIN+1 THAN THE "READ"
2270 *--------------------------------
DB7F- 85 75 2280 ERLIN STA CURLIN
DB81- 84 76 2290 STY CURLIN+1
DB83- 4C C9 DE 2300 JMP SYNERR
2310 *--------------------------------
DB86- 68 2320 INPERR PLA
2330 *--------------------------------
2340 RESPERR
DB87- 24 D8 2350 BIT ERRFLG "ON ERR" TURNED ON?
DB89- 10 05 2360 BPL .1 NO, GIVE REENTRY A TRY
DB8B- A2 FE 2370 LDX #254 ERROR CODE = 254
DB8D- 4C E9 F2 2380 JMP HANDLERR
DB90- A9 EF 2390 .1 LDA #ERR.REENTRY "?REENTER"
DB92- A0 DC 2400 LDY /ERR.REENTRY
DB94- 20 3A DB 2410 JSR STROUT
DB97- A5 79 2420 LDA OLDTEXT RE-EXECUTE THE WHOLE INPUT STATEMENT
DB99- A4 7A 2430 LDY OLDTEXT+1
DB9B- 85 B8 2440 STA TXTPTR
DB9D- 84 B9 2450 STY TXTPTR+1
DB9F- 60 2460 RTS
2470 *--------------------------------
2480 * "GET" STATEMENT
2490 *--------------------------------
DBA0- 20 06 E3 2500 GET JSR ERRDIR ILLEGAL IF IN DIRECT MODE
DBA3- A2 01 2510 LDX #INPUT.BUFFER+1 SIMULATE INPUT
DBA5- A0 02 2520 LDY /INPUT.BUFFER+1
DBA7- A9 00 2530 LDA #0
DBA9- 8D 01 02 2540 STA INPUT.BUFFER+1
DBAC- A9 40 2550 LDA #$40 SET UP INPUTFLG
DBAE- 20 EB DB 2560 JSR PROCESS.INPUT.LIST <<< CAN SAVE 1 BYTE HERE>>>
DBB1- 60 2570 RTS <<<BY "JMP PROCESS.INPUT.LIST">>>
2580 *--------------------------------
2590 * "INPUT" STATEMENT
2600 *--------------------------------
DBB2- C9 22 2610 INPUT CMP #'"' CHECK FOR OPTIONAL PROMPT STRING
DBB4- D0 0E 2620 BNE .1 NO, PRINT "?" PROMPT
DBB6- 20 81 DE 2630 JSR STRTXT MAKE A PRINTABLE STRING OUT OF IT
DBB9- A9 3B 2640 LDA #';' MUST HAVE ; NOW
DBBB- 20 C0 DE 2650 JSR SYNCHR
DBBE- 20 3D DB 2660 JSR STRPRT PRINT THE STRING
DBC1- 4C C7 DB 2670 JMP .2
DBC4- 20 5A DB 2680 .1 JSR OUTQUES NO STRING, PRINT "?"
DBC7- 20 06 E3 2690 .2 JSR ERRDIR ILLEGAL IF IN DIRECT MODE
DBCA- A9 2C 2700 LDA #',' PRIME THE BUFFER
DBCC- 8D FF 01 2710 STA INPUT.BUFFER-1
DBCF- 20 2C D5 2720 JSR INLIN
DBD2- AD 00 02 2730 LDA INPUT.BUFFER
DBD5- C9 03 2740 CMP #$03 CONTROL C?
DBD7- D0 10 2750 BNE INPUT.FLAG.ZERO NO
DBD9- 4C 63 D8 2760 JMP CONTROL.C.TYPED
2770 *--------------------------------
DBDC- 20 5A DB 2780 NXIN JSR OUTQUES PRINT "?"
DBDF- 4C 2C D5 2790 JMP INLIN
2800 *--------------------------------
2810 * "READ" STATEMENT
2820 *--------------------------------
DBE2- A6 7D 2830 READ LDX DATPTR Y,X POINTS AT NEXT DATA STATEMENT
DBE4- A4 7E 2840 LDY DATPTR+1
DBE6- A9 98 2850 LDA #$98 SET INPUTFLG = $98
DBE8- 2C 2860 .HS 2C TRICK TO PROCESS.INPUT.LIST
2870 *--------------------------------
2880 INPUT.FLAG.ZERO
DBE9- A9 00 2890 LDA #0 SET INPUTFLG = $00
2900 *--------------------------------
2910 * PROCESS INPUT LIST
2920 *
2930 * (Y,X) IS ADDRESS OF INPUT DATA STRING
2940 * (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
2950 * $40 FOR GET
2960 * $98 FOR READ
2970 *--------------------------------
2980 PROCESS.INPUT.LIST
DBEB- 85 15 2990 STA INPUTFLG
DBED- 86 7F 3000 STX INPTR ADDRESS OF INPUT STRING
DBEF- 84 80 3010 STY INPTR+1
3020 *--------------------------------
3030 PROCESS.INPUT.ITEM
DBF1- 20 E3 DF 3040 JSR PTRGET GET ADDRESS OF VARIABLE
DBF4- 85 85 3050 STA FORPNT
DBF6- 84 86 3060 STY FORPNT+1
DBF8- A5 B8 3070 LDA TXTPTR SAVE CURRENT TXTPTR,
DBFA- A4 B9 3080 LDY TXTPTR+1 WHICH POINTS INTO PROGRAM
DBFC- 85 87 3090 STA TXPSV
DBFE- 84 88 3100 STY TXPSV+1
DC00- A6 7F 3110 LDX INPTR SET TXTPTR TO POINT AT INPUT BUFFER
DC02- A4 80 3120 LDY INPTR+1 OR "DATA" LINE
DC04- 86 B8 3130 STX TXTPTR
DC06- 84 B9 3140 STY TXTPTR+1
DC08- 20 B7 00 3150 JSR CHRGOT GET CHAR AT PNTR
DC0B- D0 1E 3160 BNE INSTART NOT END OF LINE OR COLON
DC0D- 24 15 3170 BIT INPUTFLG DOING A "GET"?
DC0F- 50 0E 3180 BVC .1 NO
DC11- 20 0C FD 3190 JSR MON.RDKEY YES, GET CHAR
DC14- 29 7F 3200 AND #$7F
DC16- 8D 00 02 3210 STA INPUT.BUFFER
DC19- A2 FF 3220 LDX #INPUT.BUFFER-1
DC1B- A0 01 3230 LDY /INPUT.BUFFER-1
DC1D- D0 08 3240 BNE .2 ...ALWAYS
3250 *--------------------------------
DC1F- 30 7F 3260 .1 BMI FINDATA DOING A "READ"
DC21- 20 5A DB 3270 JSR OUTQUES DOING AN "INPUT", PRINT "?"
DC24- 20 DC DB 3280 JSR NXIN PRINT ANOTHER "?", AND INPUT A LINE
DC27- 86 B8 3290 .2 STX TXTPTR
DC29- 84 B9 3300 STY TXTPTR+1
3310 *--------------------------------
3320 INSTART
DC2B- 20 B1 00 3330 JSR CHRGET GET NEXT INPUT CHAR
DC2E- 24 11 3340 BIT VALTYP STRING OR NUMERIC?
DC30- 10 31 3350 BPL .5 NUMERIC
DC32- 24 15 3360 BIT INPUTFLG STRING -- NOW WHAT INPUT TYPE?
DC34- 50 09 3370 BVC .1 NOT A "GET"
DC36- E8 3380 INX "GET"
DC37- 86 B8 3390 STX TXTPTR
DC39- A9 00 3400 LDA #0
DC3B- 85 0D 3410 STA CHARAC NO OTHER TERMINATORS THAN $00
DC3D- F0 0C 3420 BEQ .2 ...ALWAYS
3430 *--------------------------------
DC3F- 85 0D 3440 .1 STA CHARAC
DC41- C9 22 3450 CMP #'"' TERMINATE ON $00 OR QUOTE
DC43- F0 07 3460 BEQ .3
DC45- A9 3A 3470 LDA #':' TERMINATE ON $00, COLON, OR COMMA
DC47- 85 0D 3480 STA CHARAC
DC49- A9 2C 3490 LDA #','
DC4B- 18 3500 .2 CLC
DC4C- 85 0E 3510 .3 STA ENDCHR
DC4E- A5 B8 3520 LDA TXTPTR
DC50- A4 B9 3530 LDY TXTPTR+1
DC52- 69 00 3540 ADC #0 SKIP OVER QUOTATION MARK, IF
DC54- 90 01 3550 BCC .4 THERE WAS ONE
DC56- C8 3560 INY
DC57- 20 ED E3 3570 .4 JSR STRLT2 BUILD STRING STARTING AT (Y,A)
3580 * TERMINATED BY $00, (CHARAC), OR (ENDCHR)
DC5A- 20 3D E7 3590 JSR POINT SET TXTPTR TO POINT AT STRING
DC5D- 20 7B DA 3600 JSR PUTSTR STORE STRING IN VARIABLE
DC60- 4C 72 DC 3610 JMP INPUT.MORE
3620 *--------------------------------
DC63- 48 3630 .5 PHA
DC64- AD 00 02 3640 LDA INPUT.BUFFER ANYTHING IN BUFFER?
DC67- F0 30 3650 BEQ INPFIN NO, SEE IF READ OR INPUT
3660 *--------------------------------
3670 INPUT.DATA
DC69- 68 3680 PLA "READ"
DC6A- 20 4A EC 3690 JSR FIN GET FP NUMBER AT TXTPTR
DC6D- A5 12 3700 LDA VALTYP+1
DC6F- 20 63 DA 3710 JSR LET2 STORE RESULT IN VARIABLE
3720 *--------------------------------
3730 INPUT.MORE
DC72- 20 B7 00 3740 JSR CHRGOT
DC75- F0 07 3750 BEQ .1 END OF LINE OR COLON
DC77- C9 2C 3760 CMP #',' COMMA IN INPUT?
DC79- F0 03 3770 BEQ .1 YES
DC7B- 4C 71 DB 3780 JMP INPUTERR NOTHING ELSE WILL DO
DC7E- A5 B8 3790 .1 LDA TXTPTR SAVE POSITION IN INPUT BUFFER
DC80- A4 B9 3800 LDY TXTPTR+1
DC82- 85 7F 3810 STA INPTR
DC84- 84 80 3820 STY INPTR+1
DC86- A5 87 3830 LDA TXPSV RESTORE PROGRAM POINTER
DC88- A4 88 3840 LDY TXPSV+1
DC8A- 85 B8 3850 STA TXTPTR
DC8C- 84 B9 3860 STY TXTPTR+1
DC8E- 20 B7 00 3870 JSR CHRGOT NEXT CHAR FROM PROGRAM
DC91- F0 33 3880 BEQ INPDONE END OF STATEMENT
DC93- 20 BE DE 3890 JSR CHKCOM BETTER BE A COMMA THEN
DC96- 4C F1 DB 3900 JMP PROCESS.INPUT.ITEM
3910 *--------------------------------
DC99- A5 15 3920 INPFIN LDA INPUTFLG "INPUT" OR "READ"
DC9B- D0 CC 3930 BNE INPUT.DATA "READ"
DC9D- 4C 86 DB 3940 JMP INPERR
3950 *--------------------------------
3960 FINDATA
DCA0- 20 A3 D9 3970 JSR DATAN GET OFFSET TO NEXT COLON OR EOL
DCA3- C8 3980 INY TO FIRST CHAR OF NEXT LINE
DCA4- AA 3990 TAX WHICH: EOL OR COLON?
DCA5- D0 12 4000 BNE .1 COLON
DCA7- A2 2A 4010 LDX #ERR.NODATA EOL: MIGHT BE OUT OF DATA
DCA9- C8 4020 INY CHECK HI-BYTE OF FORWARD PNTR
DCAA- B1 B8 4030 LDA (TXTPTR),Y END OF PROGRAM?
DCAC- F0 5F 4040 BEQ GERR YES, WE ARE OUT OF DATA
DCAE- C8 4050 INY PICK UP THE LINE #
DCAF- B1 B8 4060 LDA (TXTPTR),Y
DCB1- 85 7B 4070 STA DATLIN
DCB3- C8 4080 INY
DCB4- B1 B8 4090 LDA (TXTPTR),Y
DCB6- C8 4100 INY POINT AT FIRST TEXT CHAR IN LINE
DCB7- 85 7C 4110 STA DATLIN+1
DCB9- B1 B8 4120 .1 LDA (TXTPTR),Y GET 1ST TOKEN OF STATEMENT
DCBB- AA 4130 TAX SAVE TOKEN IN X-REG
DCBC- 20 98 D9 4140 JSR ADDON ADD (Y) TO TXTPTR
DCBF- E0 83 4150 CPX #TOKEN.DATA DID WE FIND A "DATA" STATEMENT?
DCC1- D0 DD 4160 BNE FINDATA NOT YET
DCC3- 4C 2B DC 4170 JMP INSTART YES, READ IT
4180 *---NO MORE INPUT REQUESTED------
4190 INPDONE
DCC6- A5 7F 4200 LDA INPTR GET POINTER IN CASE IT WAS "READ"
DCC8- A4 80 4210 LDY INPTR+1
DCCA- A6 15 4220 LDX INPUTFLG "READ" OR "INPUT"?
DCCC- 10 03 4230 BPL .1 "INPUT"
DCCE- 4C 53 D8 4240 JMP SETDA "DATA", SO STORE (Y,X) AT DATPTR
DCD1- A0 00 4250 .1 LDY #0 "INPUT": ANY MORE CHARS ON LINE?
DCD3- B1 7F 4260 LDA (INPTR),Y
DCD5- F0 07 4270 BEQ .2 NO, ALL IS WELL
DCD7- A9 DF 4280 LDA #ERR.EXTRA YES, ERROR
DCD9- A0 DC 4290 LDY /ERR.EXTRA "EXTRA IGNORED"
DCDB- 4C 3A DB 4300 JMP STROUT
DCDE- 60 4310 .2 RTS
4320 *--------------------------------
4330 ERR.EXTRA
DCDF- 3F 45 58
DCE2- 54 52 41
DCE5- 20 49 47
DCE8- 4E 4F 52
DCEB- 45 44 4340 .AS '?EXTRA IGNORED'
DCED- 0D 00 4350 .HS 0D00
4360 ERR.REENTRY
DCEF- 3F 52 45
DCF2- 45 4E 54
DCF5- 45 52 4370 .AS '?REENTER'
DCF7- 0D 00 4380 .HS 0D00
4390 *--------------------------------
S.D912