10 ORG $E000 20 LST OFF 30 XC OFF ;6502 only 40 EXP ON ;print only macro call 50 LSTDO OFF ;don't list conditional code 60 TR OFF ;don't truncate listing to 3 bytes 70 CYC OFF ;don't print cycle times 80 USE MACROS 90 LST ON 100 ************************************************* 110 * * 120 * INTEGER BASIC * 130 * * 140 * WOZ * 150 * * 160 ************************************************* 170 * * 180 * "That BASIC, which we shipped with the first * 190 * Apple II's, was never assembled -- ever. * 200 * There was one handwritten copy, all * 210 * handwritten, all hand assembled." * 220 * * 230 * Steve Wozniak * 240 * Call-A.P.P.L.E., October 1986 * 250 * * 260 ************************************************* 270 280 * Computer Apple II family 290 * O/S none needed, but usually DOS 3.3 300 * Language 6502 assembly -- Merlin assembler 310 * Disassembled by: 320 * Paul R. Santa-Maria 330 * P.O. Box 924 340 * Monroe MI 48161 350 * Revised 1 May 2000 360 * Reference "What's Where in the Apple"; William F. Luebbert 370 * Peeking at Call-A.P.P.L.E. Vol 2 1979; pp44-61 380 390 ************************************************* 400 410 * zero-page 420 430 LOMEM = $004A ;ptr: start of vars 440 HIMEM = $004C ;ptr: end of BASIC program 450 NOUNSTKL = $0050 ;noun stack low bytes (80-87) 460 SYNSTKH = $0058 ;syntax stack high byte 470 NOUNSTKH = $0078 ;noun stack high bytes (78-97) 480 SYNSTKL = $0080 ;syntax stack low bytes (80-9F) 490 NOUNSTKC = $00A0 ;noun stack counter (A0-BF) 500 TXTNDXSTK = $00A8 ;text index stack (A8-C7) 510 TXTNDX = $00C8 ;text index val (OUTVAL) 520 LEADBL = $00C9 ;leading blanks index (YTEMP) 530 PP = $00CA ;ptr: start of program 540 PV = $00CC ;ptr: end of vars 550 ACC = $00CE ;word: main accumulator 560 SRCH = $00D0 ;ptr to search var tbl 570 TOKNDXSTK = $00D1 ;token index stack (D1-F0) 580 SRCH2 = $00D2 ;second var search ptr 590 IFFLAG = $00D4 ;IF/THEN fail flag 600 CRFLAG = $00D5 ;carriage return flag 610 VERBNOW = $00D6 ;verb currently in use 620 PRFLAG = $00D7 ;print it now flag 630 XSAVE = $00D8 ;temp Xreg save 640 RUNFLAG = $00D9 ;run mode flag 650 AUX = $00DA ;word: aux ctr 660 PR = $00DC ;word: current line value 670 *PN = $00DE ;ptr to current noun 680 PX = $00E0 ;ptr to current verb 690 P1 = $00E2 ;aux ptr 1 (delete line ptr) 700 P2 = $00E4 ;aux ptr 2 ... 710 * (line num adr) (next line num) (general flag) 720 P3 = $00E6 ;aux ptr 3 (next ptr) 730 TOKNDX = $00F1 ;token index val 740 PCON = $00F2 ;continue ptr (PRDEC low/high) 750 AUTOINC = $00F4 ;auto line increment 760 AUTOLN = $00F6 ;current auto line 770 AUTOFLAG = $00F8 ;auto line mode flag ($FF = on) 780 CHAR = $00F9 ;current char 790 LEADZR = $00FA ;leading zeros index ($00,$A0,$B0) 800 FORNDX = $00FB ;FOR-NEXT loop index 810 GOSUBNDX = $00FC ;GOSUB index 820 SYNSTKDX = $00FD ;syntax stack index val 830 SYNPAG = $00FE ;ptr: syntax page 840 *if SYNPAG+1 <> 0 then error condition exists 850 860 STACK = $0100 ;6502 STACK 870 880 * GOSUB/RETURN usage 890 900 STK_00 = STACK+$00 910 STK_10 = STACK+$10 920 STK_20 = STACK+$20 930 STK_30 = STACK+$30 940 950 * FOR/NEXT/STEP usage 960 970 STK_40 = STACK+$40 980 STK_50 = STACK+$50 990 STK_60 = STACK+$60 1000 STK_70 = STACK+$70 1010 STK_80 = STACK+$80 1020 STK_90 = STACK+$90 1030 STK_A0 = STACK+$A0 1040 STK_B0 = STACK+$B0 1050 STK_C0 = STACK+$C0 1060 STK_D0 = STACK+$D0 1070 1080 * I/O addresses 1090 1100 KBD = $C000 1110 KBDSTRB = $C010 1120 1130 * Monitor zero page and low memory 1140 1150 WNDWDTH = $0021 1160 CH = $0024 1170 CV = $0025 1180 GBAS = $0026 1190 H2 = $002C 1200 V2 = $002D 1210 A1 = $003C 1220 A2 = $003E 1230 PROMPT = $0033 1240 RNDL = $004E 1250 RNDH = $004F 1260 1270 IN = $0200 1280 1290 * Monitor routines 1300 1310 PLOT = $F800 1320 HLINE = $F819 1330 VLINE = $F828 1340 GBASCALC = $F847 1350 SETCOL = $F864 1360 PREAD = $FB1E 1370 SETTXT = $FB39 1380 SETGR = $FB40 1390 VTAB = $FC22 1400 WRITE = $FECD 1410 WRITE0 = $FECF 1420 READ = $FEFD 1430 NXTCHAR = $FD75 1440 CROUT = $FD8E 1450 COUT = $FDED 1460 INPORT = $FE8B 1470 OUTPORT = $FE95 1480 BELL = $FF3A 1490 1500 * ASCII (excess $8000 for xref listing) 1510 1520 ETX = $8003 ;CTRL-C 1530 LF = $800A 1540 CR = $800D 1550 BLANK = $8020 1560 DQT = $8022 1570 SQT = $8027 1580 1590 ************************************************** 1600 * ;Z = unreferenced area 1610 * ;V = referenced in verb table 1620 * ;VO = referenced in verb table only 1630 * ;solo = one reference only (could be in-line) 1640 1650 PUT PART1 1660 BASIC JSR COLD 1670 BASIC2 JMP WARM 1680 1690 SetPrompt ;solo 1700 STA PROMPT 1710 JMP COUT 1720 *> 1730 1740 RTS ;Z 1750 ** 1760 1770 HE00C 1780 TXA ;?print a trailing blank? 1790 AND #$20 1800 BEQ HE034 ;=>RTS 1810 HE011 ;solo 1820 LDA #BLANK+$80 1830 STA P2 1840 JMP COUT 1850 *> 1860 1870 HE018 ;solo 1880 LDA #32 ;check line length 1890 HE01A 1900 CMP CH 1910 BCS NextByte ;=HS> line too short 1920 LDA #CR+$80 ;print CR, then 7 blanks 1930 LDY #7 1940 *!LOOP 1950 JSR COUT 1960 LDA #BLANK+$80 1970 DEY 1980 *!UNTIL 1990 2000 NextByte ;get next byte 16-bit ptr 2010 LDY #0 2020 LDA (P1),Y 2030 INCW P1 2040 HE034 2050 RTS 2060 ** 2070 2080 * tkn $75 , (with tkn $74 LIST) 2090 * LIST 5,30 2100 2110 COMMA_LIST ;VO 2120 JSR GET16BIT 2130 JSR HE576 2140 HE03B 2150 CMPW P1;P3 2160 BCS HE034 ;=>P1 P3, RTS 2170 JSR UNPACK 2180 JMP HE03B 2190 *> 2200 2210 2220 * tkn $76 LIST 2230 * list entire program 2240 2250 LIST ;VO 2260 MOVW PP;P1 2270 MOVW HIMEM;P3 2280 BNE HE03B ;=>always 2290 2300 * tkn $74 LIST 2310 * specific line number or range of numbers 2320 * LIST 10: LIST 5,30 2330 2340 LISTNUM ;VO 2350 JSR GET16BIT 2360 JSR HE56D 2370 MOVW P2;P1 2380 BCS HE034 ;=>RTS 2390 UNPACK ;unpack tokens to mnemonics 2400 STX XSAVE 2410 LDA #BLANK+$80 2420 STA LEADZR 2430 JSR NextByte 2440 TYA 2450 HE077 2460 STA P2 2470 JSR NextByte 2480 TAX 2490 JSR NextByte 2500 JSR PRDEC 2510 *!LOOP 2520 JSR HE018 2530 STY LEADZR 2540 TAX 2550 BPL HE0A3 ;=> 2560 ASL 2570 BPL HE077 ;=> 2580 LDA P2 2590 *! IF 2600 JSR HE011 2610 *! ENDIF 2620 TXA 2630 *! LOOP 2640 JSR COUT 2650 HE099 2660 LDA #$25 2670 JSR HE01A 2680 TAX 2690 *! UNTIL 2700 STA P2 2710 HE0A3 2720 CMP #$01 2730 *! IF 2740 LDX XSAVE 2750 JMP CROUT 2760 *! ENDIF 2770 PHA 2780 STY ACC 2790 LDX #>SYNTABL2 2800 STX ACC+1 2810 CMP #$51 ;END tkn 2820 *! IF 2830 DEC ACC+1 ; in SYNTABL 2840 SBC #$50 ;TAB tkn 2850 *! ENDIF 2860 *! LOOP 2870 PHA 2880 LDA (ACC),Y 2890 *! LOOP 2900 *! LOOP 2910 TAX 2920 DEY 2930 LDA (ACC),Y 2940 *! UNTIL 2950 CPX #$C0 2960 *! WHILE 2970 CPX #0 2980 *! UNTIL 2990 TAX 3000 PLA 3010 SBC #1 ;carry is set 3020 *! UNTIL 3030 BIT P2 3040 *! IF 3050 JSR HEFF8 3060 *! ENDIF 3070 *! LOOP 3080 LDA (ACC),Y 3090 *! WHILE 3100 TAX 3110 AND #$3F 3120 STA P2 3130 CLC 3140 ADC #BLANK+$80 3150 JSR COUT 3160 DEY 3170 CPX #$C0 3180 *! UNTIL 3190 JSR HE00C 3200 PLA 3210 CMP #$5D ;93 ] 3220 BEQ HE099 ;=> 3230 CMP #$28 ;40 ( 3240 *!UNTIL 3250 BEQ HE099 ;=>always 3260 3270 * tkn $2A ( 3280 * substring 3290 * PRINT A$(12,14) 3300 3310 PAREN_SUBSTR ;VO 3320 JSR HE118 3330 STA NOUNSTKL,X 3340 CMP NOUNSTKH,X 3350 HE102 3360 BCC HE115 ;=LO> 3370 HE104 3380 LDY #ErrMsg05 ;"STRING" 3390 HE106 3400 JMP ERRMESS 3410 *> 3420 3430 * tkn $23 , 3440 * substring 3450 * PRINT A$(3,3) 3460 3470 COMMA_SUBSTR ;VO 3480 JSR GETBYTE 3490 CMP NOUNSTKL,X 3500 BCC HE104 ;=LO>"STRING" 3510 JSR HEFE4 3520 STA NOUNSTKH,X 3530 HE115 3540 JMP HE823 3550 *> 3560 3570 HE118 3580 JSR GETBYTE 3590 BEQ HE104 ;=>"STRING" 3600 SEC 3610 SBC #1 3620 RTS 3630 ** 3640 3650 * tkn $42 ( 3660 * string array is destination of the data 3670 * A$(1)="HELLO" 3680 3690 HE121 ;VO 3700 JSR HE118 3710 STA NOUNSTKL,X 3720 CLC 3730 SBC NOUNSTKH,X 3740 JMP HE102 3750 *> 3760 3770 HE12C 3780 LDY #ErrMsg03 ;"MEM FULL" 3790 BNE HE106 ;=>always 3800 3810 * tkn $43 , 3820 * next var in DIM statement is string 3830 * DIM X(5),A$(5) 3840 3850 * tkn $4E DIM 3860 * string var. uses tkn $22 ( 3870 * DIM A$(5) 3880 3890 DIMSTR ;VO 3900 JSR HE118 3910 INX 3920 HE134 3930 LDA NOUNSTKL,X 3940 STA AUX 3950 ADC ACC 3960 PHA 3970 TAY 3980 LDA NOUNSTKH,X 3990 STA AUX+1 4000 ADC ACC+1 4010 PHA 4020 CPY PP 4030 SBC PP+1 4040 BCS HE12C ;=HS>"MEM FULL" error 4050 LDA AUX ;AUX := AUX-2 4060 ADC #<0-2 4070 STA AUX 4080 LDA #>0-2 4090 TAY 4100 ADC AUX+1 4110 STA AUX+1 4120 *!LOOP 4130 INY 4140 LDA (AUX),Y 4150 CMP PV,Y 4160 BNE DimErr ;=> 4170 TYA 4180 *!UNTIL 4190 *!LOOP 4200 PLA 4210 STA (AUX),Y 4220 STA PV,Y 4230 DEY 4240 *!UNTIL 4250 INX 4260 RTS 4270 ** 4280 4290 NOP ;Z 4300 DimErr 4310 LDY #ErrMsg17 ;"DIM" 4320 HE16F 4330 BNE HE106 ;=>always 4340 4350 INPUTSTR ;input a string 4360 LDA #0 4370 JSR HE70A 4380 LDY #$02 4390 STY NOUNSTKH,X 4400 JSR HE70A 4410 STX XSAVE 4420 TAX 4430 INC PROMPT ;change '>' to '?' 4440 JSR RDKEY 4450 DEC PROMPT ;change '?' to '>' 4460 TXA 4470 LDX XSAVE 4480 STA NOUNSTKH,X 4490 4500 * tkn $70 = 4510 * string - non-conditional 4520 * A$ = "HELLO" 4530 4540 HE18C ;VO 4550 LDA NOUNSTKL+1,X 4560 STA ACC 4570 LDA NOUNSTKH+1,X 4580 STA ACC+1 4590 INX 4600 INX 4610 JSR HE1BC 4620 *!LOOP 4630 LDA NOUNSTKL-2,X 4640 CMP NOUNSTKH-2,X 4650 *!WHILE 4660 INC NOUNSTKL-2,X 4670 TAY 4680 LDA (ACC),Y 4690 LDY NOUNSTKL,X 4700 CPY P2 4710 *! IF 4720 LDY #ErrMsg18 ;"STR OVFL" 4730 BNE HE16F ;=>always 4740 *! ENDIF 4750 STA (AUX),Y 4760 INC NOUNSTKL,X 4770 *!UNTIL 4780 LDY NOUNSTKL,X 4790 TXA 4800 STA (AUX),Y 4810 JMP HF223 4820 *> 4830 4840 HE1BC ;solo 4850 LDA NOUNSTKL+1,X 4860 STA AUX 4870 SEC 4880 SBC #2 4890 STA P2 4900 LDA NOUNSTKH+1,X 4910 STA AUX+1 4920 SBC #0 4930 STA P2+1 4940 LDY #0 4950 LDA (P2),Y 4960 CLC 4970 SBC AUX 4980 STA P2 4990 RTS 5000 ** 5010 5020 * tkn $39 = 5030 * string logic op 5040 * IF A$ = "CAT" THEN END 5050 5060 HE1D7 ;V 5070 LDA NOUNSTKL+3,X 5080 STA ACC 5090 LDA NOUNSTKH+3,X 5100 STA ACC+1 5110 LDA NOUNSTKL+1,X 5120 STA AUX 5130 LDA NOUNSTKH+1,X 5140 STA AUX+1 5150 INX 5160 INX 5170 INX 5180 LDY #0 5190 STY NOUNSTKH,X 5200 STY NOUNSTKC,X 5210 INY 5220 STY NOUNSTKL,X 5230 *!LOOP 5240 LDA HIMEM+1,X 5250 CMP NOUNSTKH-3,X 5260 PHP 5270 PHA 5280 LDA NOUNSTKL-1,X 5290 CMP NOUNSTKH-1,X 5300 *! IF 5310 PLA 5320 PLP 5330 *! IF 5340 HE203 5350 LSR NOUNSTKL,X 5360 *! ENDIF 5370 RTS 5380 5390 *! ENDIF 5400 TAY 5410 LDA (ACC),Y 5420 STA P2 5430 PLA 5440 TAY 5450 PLP 5460 BCS HE203 ;=>EXIT LOOP 5470 LDA (AUX),Y 5480 CMP P2 5490 BNE HE203 ;=>EXIT LOOP 5500 INC NOUNSTKL-1,X 5510 INC HIMEM+1,X 5520 *!UNTIL 5530 * always 5540 5550 * tkn $3A # 5560 * string logic op 5570 * IF A$ # "CAT" THEN END 5580 5590 HE21C ;VO 5600 JSR HE1D7 5610 JMP NOT 5620 *> 5630 5640 * tkn $14 * 5650 * num math op 5660 * A = 27 * 2 5670 5680 MULT ;V 5690 JSR HE254 5700 *!LOOP 5710 ASL ACC 5720 ROL ACC+1 ;add partial product if C flag set 5730 *! IF 5740 ADDW P3;AUX;P3 5750 *! ENDIF 5760 DEY 5770 BEQ HE244 ;=>EXIT LOOP 5780 ASL P3 5790 ROL P3+1 5800 *!UNTIL 5810 JMP HE77E 5820 *> 5830 5840 HE244 5850 LDA P3 5860 JSR HE708 5870 LDA P3+1 5880 STA NOUNSTKC,X 5890 ASL P2+1 5900 BCC HE279 ;=>RTS 5910 JMP NEGATE 5920 *> 5930 5940 HE254 5950 LDA #$55 5960 STA P2+1 5970 JSR HE25B 5980 HE25B 5990 MOVW ACC;AUX 6000 JSR GET16BIT 6010 STY P3 ;P3 := 0 6020 STY P3+1 6030 LDA ACC+1 6040 *!IF 6050 DEX 6060 ASL P2+1 6070 JSR NEGATE 6080 JSR GET16BIT 6090 *!ENDIF 6100 LDY #$10 6110 HE279 6120 RTS 6130 ** 6140 6150 * tkn $1F MOD 6160 * num op 6170 * IF X MOD 13 THEN END 6180 6190 MOD ;V 6200 JSR HEE6C 6210 BEQ HE244 ;=>always 6220 6230 DB $FF ;Z 6240 6250 HE280 ;solo 6260 INC PROMPT ;change '>' to '?' 6270 LDY #0 6280 JSR GETCMD 6290 DEC PROMPT ;change '?' to '>' 6300 RTS 6310 ** 6320 6330 * tkn $3D SCRN( 6340 * PRINT SCRN(X,Y) 6350 6360 SCRN ;VO 6370 JSR GETBYTE 6380 LSR ;Areg := Areg/2 6390 PHP ;stash carry (lsb) 6400 JSR GBASCALC 6410 JSR GETBYTE 6420 TAY 6430 LDA (GBAS),Y ;get screen byte 6440 PLP ;retrieve carry 6450 *!IF 6460 LSR ;odd, upper half 6470 LSR 6480 LSR 6490 LSR 6500 *!ENDIF 6510 AND #$0F ;Areg := color number 6520 LDY #0 6530 JSR HE708 6540 STY NOUNSTKC,X 6550 DEY 6560 STY PRFLAG ;PRFLAG := $FF 6570 6580 * tkn $3E , 6590 * PRINT SCRN(X,Y) 6600 6610 COMMA_SCRN ;VO 6620 RTS 6630 ** 6640 6650 DB $FF,$FF,$FF,$FF ;Z 6660 6670 JSR HEFD3 ;old 4K cold start ;Z 6672 6674 * Warm start 6676 6680 WARM ;main compile/execute code 6690 JSR CROUT ;emit blank line 6700 HE2B6 6710 LSR RUNFLAG ;not running 6720 LDA #">" 6730 JSR SetPrompt ;set and print prompt char 6740 LDY #0 6750 STY LEADZR ;no leading zeros for AUTOLN 6760 BIT AUTOFLAG ;AUTO? 6762 * if AUTOLN active 6770 *!IF 6780 LDX AUTOLN ;yes, print line number 6790 LDA AUTOLN+1 6800 JSR PRDEC 6810 LDA #BLANK+$80 ;and a blank 6820 JSR COUT 6830 *!ENDIF 6840 LDX #$FF ;init Sreg 6850 TXS 6860 JSR GETCMD 6870 STY TOKNDX 6880 TXA 6890 STA TXTNDX 6900 LDX #$20 6910 JSR HE491 6920 LDA TXTNDX ;PX := TXTNDX+$0200+C flag 6930 ADC #<$0200 6940 STA PX 6950 LDA #0 6960 TAX 6970 ADC #>$0200 6980 STA PX+1 6990 LDA (PX,X) 7000 AND #$F0 7010 CMP #"0" 7020 *!IF 7030 JMP HE883 7040 *!ENDIF 7050 LDY #2 ;move two bytes 7060 *!LOOP 7070 LDA (PX),Y 7080 STA ACC-1,Y 7090 DEY 7100 *!UNTIL 7110 JSR HE38A 7120 LDA TOKNDX 7130 SBC TXTNDX 7140 CMP #$04 7150 BEQ HE2B6 ;=> 7160 STA (PX),Y 7170 LDA PP ;P2 := PP-(PX),Y 7180 SBC (PX),Y 7190 STA P2 7200 LDA PP+1 7210 SBC #0 7220 STA P2+1 7230 CMPW P2;PV 7240 BCC MEMFULL ;=>P2 PV 7250 *!LOOP 7260 LDA PP ;P3 := PP-(PX),Y 7270 SBC (PX),Y 7280 STA P3 7290 LDA PP+1 7300 SBC #0 7310 STA P3+1 7320 LDA (PP),Y 7330 STA (P3),Y 7340 INCW PP 7350 CMPW P1;PP 7360 *!UNTIL 7370 *!LOOP 7380 LDA P2,X 7390 STA PP,X 7400 DEX 7410 *!UNTIL 7420 LDA (PX),Y 7430 TAY 7440 *!LOOP 7450 DEY 7460 LDA (PX),Y 7470 STA (P3),Y 7480 TYA 7490 *!UNTIL 7500 BIT AUTOFLAG ;auto line? 7510 *!IF 7520 * yes 7530 *! LOOP 7540 LDA AUTOLN+1,X ;AUTOLN := AUTOLN+AUTOINC 7550 ADC AUTOINC+1,X 7560 STA AUTOLN+1,X 7570 INX 7580 *! UNTIL 7590 *!ENDIF 7600 BPL HE3E5 ;=>always 7610 7620 DB $00,$00,$00,$00 ;Z 7630 7640 MEMFULL 7650 LDY #ErrMsg03 ;"MEM FULL" 7660 BNE ERRMESS ;=>always 7670 7680 * tkn $0A , 7690 * DEL 0,10 7700 7710 COMMA_DEL ;VO 7720 JSR GET16BIT 7730 MOVW P1;P3 7740 JSR HE575 7750 MOVW P1;P2 7760 BNE HE395 ;=>always? 7770 7780 * tkn $09 DEL 7790 7800 DEL ;VO 7810 JSR GET16BIT 7820 HE38A 7830 JSR HE56D 7840 MOVW P3;P1 7850 HE395 7860 LDY #0 7870 * memory move: P3PP P2 7910 DECW P2 7920 DECW P3 7930 LDA (P2),Y 7940 STA (P3),Y 7950 *!UNTIL 7960 * always 7970 7980 HE3B7 ;solo 7990 MOVW P3;PP 8000 RTS 8010 ** 8020 8030 *!LOOP 8040 JSR COUT ;print error message 8050 INY 8060 ERRORMESS ;print error message 8070 LDA ErrorMsgs,Y ;routine entry point 8080 *!UNTIL 8090 ORA #$80 8100 JMP COUT 8110 *> 8120 8130 GETCMD 8140 TYA 8150 TAX 8160 JSR NXTCHAR ; 8170 TXA 8180 TAY 8190 LDA #"_" ;underline problem? 8200 STA IN,Y 8210 LDX #$FF 8220 RTS 8230 ** 8240 8250 RTS ;Z 8260 ** 8270 8280 HE3DE 8290 LDY #ErrMsg01 ;"TOO LONG" 8300 ERRMESS ;print error message and goto mainline 8310 JSR PRINTERR 8320 *$E3E3 DOS 3.3 chains here when processing errors 8330 BIT RUNFLAG 8340 HE3E5 8350 *!IF 8360 JMP HE2B6 8370 *!ENDIF 8380 JMP HEB9A 8390 *> 8400 8410 HE3ED ;solo 8420 ROL 8430 ADC #$A0 8440 CMP IN,X 8450 BNE HE448 ;=> 8460 LDA (SYNPAG),Y 8470 ASL 8480 *!IF 8490 DEY 8500 LDA (SYNPAG),Y 8510 BMI HE428 ;=> 8520 INY 8530 *!ENDIF 8540 STX TXTNDX 8550 TYA 8560 PHA 8570 LDX #0 8580 LDA (SYNPAG,X) 8590 TAX 8600 *!LOOP 8610 LSR 8620 EOR #$40 8630 ORA (SYNPAG),Y 8640 CMP #$C0 8650 *! IF 8660 INX 8670 *! ENDIF 8680 INY 8690 *!UNTIL 8700 PLA 8710 TAY 8720 TXA 8730 JMP HF2F8 8740 *> 8750 8760 HE41C 8770 INC TOKNDX 8780 LDX TOKNDX 8790 BEQ HE3DE ;=>"TOO LONG" 8800 STA IN,X 8810 HE425 8820 RTS 8830 ** 8840 8850 HE426 ;solo 8860 LDX TXTNDX 8870 HE428 8880 LDA #BLANK+$80 8890 *!LOOP 8900 INX 8910 CMP IN,X 8920 *!UNTIL 8930 LDA (SYNPAG),Y 8940 AND #$3F 8950 LSR 8960 BNE HE3ED ;=> 8970 LDA IN,X 8980 *!IF 8990 ADC #$3F 9000 CMP #$1A 9010 BCC HE4B1 ;=LO> 9020 *!ENDIF 9030 ADC #$4F 9040 CMP #$0A 9050 BCC HE4B1 ;=LO> 9060 HE448 9070 LDX SYNSTKDX 9080 *!LOOP 9090 INY 9100 LDA (SYNPAG),Y 9110 AND #$E0 9120 CMP #$20 9130 BEQ HE4CD ;=> 9140 LDA TXTNDXSTK,X 9150 STA TXTNDX 9160 LDA TOKNDXSTK,X 9170 STA TOKNDX 9180 *! LOOP 9190 DEY 9200 LDA (SYNPAG),Y 9210 ASL ;dbl 9220 *! UNTIL 9230 DEY 9240 BCS HE49C ;=> 9250 ASL ;dbl 9260 BMI HE49C ;=> 9270 LDY SYNSTKH,X 9280 STY SYNPAG+1 9290 LDY SYNSTKL,X 9300 INX 9310 *!UNTIL 9320 HE470 9330 BEQ HE425 ;=>RTS 9340 CMP #$7E 9350 BCS HE498 ;=HS> 9360 DEX 9370 *!IF 9380 LDY #ErrMsg01 ;"TOO LONG" 9390 * BUG FIX: ABOVE LINE SHOULD BE 9400 * LDY #ErrMsg04 ;"TOO MANY PARENS" 9410 * REF: CALL-APPLE MAR 1983 P.114 9420 BPL HE4A6 ;=>always 9430 *!ENDIF 9440 STY SYNSTKL,X 9450 LDY SYNPAG+1 9460 STY SYNSTKH,X 9470 LDY TXTNDX 9480 STY TXTNDXSTK,X 9490 LDY TOKNDX 9500 STY TOKNDXSTK,X 9510 AND #$1F 9520 TAY 9530 LDA SYNTABLNDX,Y 9540 HE491 9550 ASL ;dbl 9560 TAY 9570 LDA #>SYNTABL/2 9580 ROL 9590 STA SYNPAG+1 9600 HE498 9610 *!IF 9620 INY 9630 *!ENDIF 9640 INY 9650 HE49C 9660 STX SYNSTKDX 9670 LDA (SYNPAG),Y 9680 BMI HE426 ;=> 9690 *!IF 9700 LDY #ErrMsg02 ;"SYNTAX" 9710 HE4A6 9720 JMP ERRMESS 9730 *!ENDIF 9740 CMP #$03 9750 BCS HE470 ;=HS> 9760 LSR ;half 9770 LDX TXTNDX 9780 INX 9790 HE4B1 9800 LDA IN,X 9810 BCC HE4BA ;=> 9820 CMP #DQT+$80 9830 BEQ HE4C4 ;=> 9840 HE4BA 9850 CMP #"_" ;underline problem? 9860 BEQ HE4C4 ;=> 9870 STX TXTNDX 9880 HE4C0 9890 *!LOOP 9900 JSR HE41C 9910 INY 9920 HE4C4 9930 DEY 9940 LDX SYNSTKDX 9950 *! LOOP 9960 LDA (SYNPAG),Y 9970 DEY 9980 ASL 9990 BPL HE49C ;=> 10000 HE4CD 10010 LDY SYNSTKH,X 10020 STY SYNPAG+1 10030 LDY SYNSTKL,X 10040 INX 10050 LDA (SYNPAG),Y 10060 AND #%10011111 10070 *! UNTIL 10080 STA PCON 10090 STA PCON+1 10100 TYA 10110 PHA 10120 STX SYNSTKDX 10130 LDY TOKNDXSTK-1,X 10140 STY LEADBL 10150 CLC 10160 *! LOOP 10170 LDA #$0A 10180 STA CHAR 10190 LDX #0 10200 INY 10210 LDA IN,Y 10220 AND #$0F 10230 *! LOOP 10240 ADC PCON 10250 PHA 10260 TXA 10270 ADC PCON+1 10280 BMI HE517 ;=> 10290 TAX 10300 PLA 10310 DEC CHAR 10320 *! UNTIL 10330 STA PCON 10340 STX PCON+1 10350 CPY TOKNDX 10360 *! UNTIL 10370 LDY LEADBL 10380 INY 10390 STY TOKNDX 10400 JSR HE41C 10410 PLA 10420 TAY 10430 LDA PCON+1 10440 *!UNTIL 10450 HE517 10460 LDY #ErrMsg00 ;">32767" 10470 BPL HE4A6 ;=>always 10480 10490 *----------------------------- 10500 * Name PRDEC 10510 * Purpose Print a 16-bit number in decimal. 10520 * Input Areg = high byte 10530 * Xreg = low byte 10540 * Output 10550 * Uses 10560 * Calls 10570 * Note 10580 10590 PRDEC 10600 STA PCON+1 10610 STX PCON 10620 LDX #4 10630 STX LEADBL 10640 *!LOOP 10650 LDA #"0" 10660 STA CHAR 10670 *! LOOP 10680 LDA PCON 10690 CMP NUMLOW,X 10700 LDA PCON+1 10710 SBC NUMHI,X 10720 *! WHILE 10730 STA PCON+1 10740 LDA PCON 10750 SBC NUMLOW,X 10760 STA PCON 10770 INC CHAR 10780 *! UNTIL 10790 *GETDIG 10800 LDA CHAR 10810 INX 10820 DEX 10830 BEQ PRDEC5 ;=> 10840 CMP #"0" 10850 *! IF 10860 STA LEADBL 10870 *! ENDIF 10880 * if LEADBL is or LEADZR #0 10890 BIT LEADBL 10900 BMI PRDEC5 ;=> 10910 LDA LEADZR 10920 BEQ PRDEC6 ;=> 10930 * then 10940 PRDEC5 ;PRINT 10950 JSR COUT 10960 BIT AUTOFLAG ;auto line? 10970 *! IF 10980 STA IN,Y 10990 INY 11000 *! ENDIF 11010 PRDEC6 ;NXTX 11020 DEX 11030 *!UNTIL 11040 RTS 11050 ** 11060 11070 NUMLOW 11080 DB 1 11090 DB 10 11100 DB 100 11110 DB 1000 11120 DB 10000 11130 11140 NUMHI 11150 DB 1/$0100 11160 DB 10/$0100 11170 DB 100/$0100 11180 DB 1000/$0100 11190 DB 10000/$0100 11200 11210 HE56D 11220 MOVW PP;P3 11230 HE575 11240 INX 11250 HE576 11260 *!LOOP 11270 * MOVW P3;P2 11280 LDA P3+1 ;P2 := P3 11290 STA P2+1 11300 LDA P3 11310 STA P2 11320 * CMPW P2;HIMEM 11330 CMP HIMEM ;is P2 HIMEM? 11340 LDA P2+1 11350 SBC HIMEM+1 11360 *!WHILE 11370 LDY #1 11380 LDA (P2),Y 11390 SBC ACC 11400 INY 11410 LDA (P2),Y 11420 SBC ACC+1 11430 *!WHILE 11440 LDY #0 11450 LDA P3 ;P3 := P3.W + (P2).B 11460 ADC (P2),Y 11470 STA P3 11480 *! IF 11490 INC P3+1 11500 CLC 11510 *! ENDIF 11520 INY 11530 LDA ACC :is ACC+1 (P2),Y ? 11540 SBC (P2),Y 11550 INY 11560 LDA ACC+1 11570 SBC (P2),Y 11580 *!UNTIL 11590 RTS 11600 ** 11610 11620 * tkn $0B NEW 11621 * turn off AUTO 11630 * remove program 11632 * fall into CLR 11640 11650 NEW ;V 11660 LSR AUTOFLAG ;manual 11670 MOVW HIMEM;PP 11680 11690 * tkn $0C CLR 11700 * remove variables 11702 * remove FOR loops and GOSUBs 11710 11720 CLR ;V 11730 MOVW LOMEM;PV 11740 LDA #0 11750 STA FORNDX ;no FORs 11760 STA GOSUBNDX ;no GOSUBs 11770 STA SYNPAG 11780 LDA #0 ;Z 11790 STA $1D ;Z 11800 RTS 11810 ** 11820 11830 LDA SRCH ;Z 11840 HE5CE 11850 JMP MEMFULL 11860 *> 11870 11880 *!LOOP 11890 *! LOOP 11900 LDY #$FF 11910 HE5D3 11920 STY XSAVE 11930 *! LOOP 11940 INY 11950 LDA (PX),Y 11960 *! IF 11970 CMP #$40 11980 BNE HE646 ;=>EXIT LOOP 11990 STA XSAVE 12000 *! ENDIF 12010 CMP (SRCH),Y 12020 *! UNTIL 12030 *! LOOP 12040 LDA (SRCH),Y 12050 HE5E6 12060 INY 12070 LSR 12080 *! UNTIL 12090 LDA (SRCH),Y 12100 PHA 12110 INY 12120 LDA (SRCH),Y 12130 TAY 12140 PLA 12150 HE5F2 12160 STA SRCH 12170 STY SRCH+1 12180 CMP PV 12190 *! UNTIL 12200 CPY PV+1 12210 *!UNTIL 12220 LDY #0 12230 *!LOOP 12240 *! LOOP 12250 INY 12260 LDA (PX),Y 12270 *! UNTIL 12280 EOR #$40 12290 *!UNTIL 12300 TYA 12310 ADC #$04 12320 PHA 12330 ADC SRCH 12340 TAY 12350 LDA SRCH+1 12360 ADC #0 12370 PHA 12380 CPY PP 12390 SBC PP+1 12400 BCS HE5CE ;=HS>"MEM FULL" error 12410 STY PV 12420 PLA 12430 STA PV+1 12440 PLA 12450 TAY 12460 LDA #0 12470 DEY 12480 STA (SRCH),Y 12490 DEY 12500 STA (SRCH),Y 12510 DEY 12520 LDA PV+1 12530 STA (SRCH),Y 12540 DEY 12550 LDA PV 12560 STA (SRCH),Y 12570 DEY 12580 LDA #0 12590 *!LOOP 12600 STA (SRCH),Y 12610 DEY 12620 BMI HE5D3 ;=> 12630 LDA (PX),Y 12640 *!UNTIL 12650 HE640 12660 LDA LOMEM 12670 LDY LOMEM+1 12680 BNE HE5F2 ;=>always 12690 12700 HE646 12710 LDA (SRCH),Y 12720 CMP #$40 12730 BCS HE5E6 ;=HS> 12740 STA NOUNSTKC-1,X 12750 TYA 12760 ADC #$03 12770 PHA 12780 ADC SRCH 12790 JSR HE70A 12800 *!LOOP 12810 JSR GETVERB 12820 DEY 12830 *!UNTIL 12840 TYA 12850 ADC SRCH+1 12860 STA NOUNSTKH,X 12870 PLA 12880 BIT XSAVE 12890 BMI HE684 ;=> 12900 TAY 12910 LDA #0 12920 JSR HE70A 12930 STA NOUNSTKH,X 12940 *!LOOP 12950 LDA (SRCH),Y 12960 BPL HE682 ;=>EXIT LOOP 12970 INC NOUNSTKH,X 12980 INY 12990 *!UNTIL 13000 * always 13010 13020 DB 9 ;Z 13030 13040 HE679 ;solo 13050 LDA #0 13060 STA IFFLAG ;pos 13070 STA CRFLAG ;pos 13080 LDX #$20 13090 HE681 13100 PHA 13110 HE682 13120 LDY #0 13130 HE684 13140 LDA (PX),Y 13150 *!LOOP 13160 BPL HE6A0 ;=>EXIT LOOP 13170 ASL 13180 BMI HE640 ;=> 13190 JSR GETVERB 13200 JSR HE708 13210 JSR GETVERB 13220 STA NOUNSTKC,X 13230 HE696 13240 BIT IFFLAG 13250 *! IF 13260 DEX 13270 *! ENDIF 13280 HE69B 13290 JSR GETVERB 13300 *!UNTIL 13310 HE6A0 13320 CMP #$28 13330 *!IF 13340 LDA PX 13350 JSR HE70A 13360 LDA PX+1 13370 STA NOUNSTKH,X 13380 BIT IFFLAG 13390 BMI HE6BC ;=> 13400 LDA #$01 13410 JSR HE70A 13420 LDA #0 13430 STA NOUNSTKH,X 13440 *! LOOP 13450 INC NOUNSTKH,X 13460 HE6BC 13470 JSR GETVERB 13480 *! UNTIL 13490 BCS HE696 ;=> 13500 *!ENDIF 13510 BIT IFFLAG 13520 *!IF 13530 CMP #$04 13540 BCS HE69B ;=HS> 13550 LSR IFFLAG ;pos 13560 *!ENDIF 13570 TAY 13580 STA VERBNOW 13590 LDA HE980,Y 13600 AND #%01010101 ;even bits only 13610 ASL 13620 STA PRFLAG ;temp 13630 HE6D8 13640 PLA 13650 TAY 13660 LDA HE980,Y 13670 AND #%10101010 ;odd bits only 13680 CMP PRFLAG 13690 *!IF 13700 TYA 13710 PHA 13720 JSR HF3EB 13730 LDA VERBNOW 13740 BCC HE681 ;=LT> always 13750 *!ENDIF 13760 13770 * BRANCH: get high/low then JSR 13780 13790 LDA VERBADRL,Y 13800 STA ACC 13810 LDA VERBADRH,Y 13820 STA ACC+1 13830 JSR HE6FC 13840 JMP HE6D8 13850 *> 13860 13870 HE6FC 13880 JMP (ACC) 13890 *> 13900 13910 GETVERB ;get next verb to use 13920 INCW PX 13930 LDA (PX),Y 13940 RTS 13950 ** 13960 13970 HE708 13980 STY NOUNSTKH-1,X 13990 HE70A 14000 DEX 14010 *!IF 14020 STA NOUNSTKL,X 14030 RTS 14040 *!ENDIF 14050 14060 LDY #$66 ;"PPED AT" ;Z? 14070 HE712 14080 JMP ERRMESS 14090 *> 14100 14110 *--------- 14120 * Output Yreg := 0 14130 14140 GET16BIT ;get a 16 bit value 14150 LDY #0 14160 LDA NOUNSTKL,X 14170 STA ACC 14180 LDA NOUNSTKC,X 14190 STA ACC+1 14200 LDA NOUNSTKH,X 14210 *!IF 14220 STA ACC+1 14230 LDA (ACC),Y ;ACC := (ACC),Y 14240 PHA ;save low byte 14250 INY ;Yreg := 1 14260 LDA (ACC),Y 14270 STA ACC+1 14280 PLA ;restore low byte 14290 STA ACC 14300 DEY ;Yreg := 0 14310 *!ENDIF 14320 INX 14330 RTS 14340 ** 14350 14360 * tkn $16 = 14370 * num var logic op 14380 * IF X = 13 THEN END 14390 14400 HE733 ;VO 14410 JSR HE74A 14420 14430 * tkn $37 NOT 14440 * numeric 14450 * IF NOT X THEN END 14460 14470 NOT ;V 14480 JSR GET16BIT 14490 TYA ;Areg := 0 14500 JSR HE708 14510 STA NOUNSTKC,X 14520 CMP ACC 14530 *!IF 14540 CMP ACC+1 14550 *! IF 14560 INC NOUNSTKL,X 14570 *! ENDIF 14580 *!ENDIF 14590 RTS 14600 ** 14610 14620 * tkn $17 # 14630 * num var logic op 14640 * IF X # 13 THEN END 14650 14660 * tkn $1B <> 14670 * num var logic op 14680 * IF X <> 13 THEN END 14690 14700 HE74A ;V 14710 JSR SUBTRACT 14720 JSR SGN 14730 14740 * tkn $31 ABS 14750 14760 ABS ;VO 14770 JSR GET16BIT 14780 BIT ACC+1 14790 BMI HE772 ;=> 14800 HE757 ;solo 14810 DEX 14820 HE758 14830 RTS 14840 ** 14850 14860 * tkn $30 SGN 14870 14880 SGN ;V 14890 JSR GET16BIT 14900 LDA ACC+1 ;is ACC zero? 14910 *!IF 14920 LDA ACC 14930 BEQ HE757 ;=>yes 14940 *!ENDIF 14950 LDA #$FF 14960 JSR HE708 14970 STA NOUNSTKC,X 14980 BIT ACC+1 14990 BMI HE758 ;=>RTS 15000 15010 * tkn $36 - 15020 * unary sign of number 15030 * X = -5 15040 15050 NEGATE ;V 15060 JSR GET16BIT 15070 HE772 15080 TYA ;Areg := 0 15090 SEC 15100 SBC ACC 15110 JSR HE708 15120 TYA 15130 SBC ACC+1 15140 BVC HE7A1 ;=> 15150 HE77E 15160 LDY #ErrMsg00 ;">32767" 15170 BPL HE712 ;=>always 15180 15190 * tkn $13 - 15200 * num op 15210 * X=27-2 15220 15230 SUBTRACT ;V 15240 JSR NEGATE ;negate, then add 15250 15260 * tkn $12 + 15270 * num op 15280 * X=27+2 15290 15300 ADDITION ;VO 15310 JSR GET16BIT 15320 MOVW ACC;AUX 15330 JSR GET16BIT 15340 HE793 15350 CLC 15360 LDA ACC 15370 ADC AUX 15380 JSR HE708 15390 LDA ACC+1 15400 ADC AUX+1 15410 BVS HE77E ;=> 15420 HE7A1 15430 STA NOUNSTKC,X 15440 15450 * tkn $35 + 15460 * unary sign of number 15470 * X = +5 15480 15490 POSITIVE ;VO 15500 RTS 15510 ** 15520 15530 * tkn $50 TAB 15540 15550 TAB ;VO 15560 JSR GETBYTE 15570 TAY 15580 *!IF 15590 JMP HEECB ;range error? 15600 *!ENDIF 15610 DEY 15620 HE7AE ;solo 15630 JMP HF3F4 15640 *> 15650 15660 * comma tab to next tab posn (every 8 spaces) 15670 15680 HE7B1 15690 LDA CH ;get horiz posn 15700 ORA #$07 ;set bits 0-2 15710 TAY 15720 INY ;incr, is it zero? 15730 HE7B7 ;Z 15740 BNE HE7AE ;=>no, adjust CH 15750 INY ;yes, go to next tab posn 15760 BNE HE7B1 ;=>always 15770 BCS HE7B7 ;=>;Z 15780 RTS ;Z 15790 ** 15800 15810 DB 0,0 ;Z 15820 15830 * tkn $49 , 15840 * num print follows 15850 * PRINT A$,X 15860 15870 HE7C1 ;VO 15880 JSR HE7B1 15890 15900 * tkn $46 ; 15910 * num print follows 15920 * PRINT A$ ; X 15930 15940 * tkn $62 PRINT 15950 * num value 15960 * PRINT 123: PRINT X: PRINT ASC(A$) 15970 15980 PRNTNUM ;VO branch 15990 JSR GET16BIT 16000 HE7C7 ;solo 16010 LDA ACC+1 ;is it positive? 16020 *!IF 16030 LDA #"-" ;no, print minus sign 16040 JSR COUT 16050 JSR HE772 16060 BVC PRNTNUM ;=>always 16070 *!ENDIF 16080 DEY ;Yreg := $FF 16090 STY CRFLAG ;CRFLAG := $FF 16100 STX ACC+1 ;save Xreg 16110 LDX ACC 16120 JSR PRDEC 16130 LDX ACC+1 ;restore Xreg 16140 RTS 16150 ** 16160 16170 * tkn $0D AUTO 16180 16190 AUTO ;VO 16200 JSR GET16BIT 16210 MOVW ACC;AUTOLN 16220 DEY 16230 STY AUTOFLAG ;AUTOFLAG := $FF 16240 INY 16250 LDA #10 ;default increment 16260 HE7F3 16270 STA AUTOINC 16280 STY AUTOINC+1 16290 RTS 16300 ** 16310 16320 * tkn $0E , 16330 * AUTO 10,20 16340 16350 COMMA_AUTO ;VO 16360 JSR GET16BIT 16370 LDA ACC 16380 LDY ACC+1 16390 BPL HE7F3 ;=>always 16400 16410 * tkn $56 = 16420 * FOR X = 5 TO 10 16430 16440 * tkn $71 = 16450 * num - non-conditional 16460 * X = 5 16470 16480 HE801 ;V 16490 JSR GET16BIT 16500 LDA NOUNSTKL,X 16510 STA AUX 16520 LDA NOUNSTKH,X 16530 STA AUX+1 16540 LDA ACC 16550 STA (AUX),Y 16560 INY 16570 LDA ACC+1 16580 JMP HF207 16590 *> 16600 16610 * tkn $25 THEN 16620 * IF X = 3 THEN Y = 5 16630 16640 * tkn $5E LET 16650 16660 LET ;VO 16670 RTS 16680 ** 16690 16700 * tkn $00 16710 * internal begin-of-line 16720 16730 BEGIN_LINE ;VO 16740 PLA 16750 PLA 16760 16770 * tkn $03 : 16780 * statement separation 16790 * X = 5: A$ = "HELLO" 16800 16810 COLON ;VO 16820 BIT CRFLAG 16830 BPL HE822 ;=>RTS 16840 16850 * tkn $63 PRINT 16860 * dummy print 16870 * PRINT: PRINT 16880 16890 PRINT_CR ;VO 16900 JSR CROUT 16910 16920 * tkn $47 ; 16930 * end of print statement 16940 * PRINT A$; 16950 16960 HE820 ;VO 16970 LSR CRFLAG ;pos 16980 HE822 16990 RTS 17000 ** 17010 17020 * tkn $22 ( 17030 * string DIM 17040 * DIM A$(X) 17050 17060 * tkn $34 ( 17070 * num DIM 17080 * DIM X(5) 17090 17100 * tkn $38 ( 17110 * logic statements and num operations 17120 * IF C AND (A=14 OR B=12) THEN X=(27+3)/13 17130 17140 * tkn $3F ( 17150 * used after PEEK, RND, SGN, ABS, and PDL 17160 17170 HE823 ;V 17180 LDY #$FF 17190 STY PRFLAG ;PRFLAG := $FF 17200 17210 * tkn $72 ) 17220 * the only right parenthesis token 17230 17240 RIGHT_PAREN ;VO 17250 RTS 17260 ** 17270 17280 * tkn $60 IF 17290 17300 IF ;VO 17310 JSR HEFCD 17320 *!IF 17330 LDA #$25 ;THEN token? 17340 STA VERBNOW 17350 DEY 17360 STY IFFLAG 17370 *!ENDIF 17380 INX 17390 RTS 17400 ** 17410 17420 * RUN without CLR 17430 * DOS 3.3 chains here to run a program 17440 17450 RUNWARM ;solo 17460 LDA PP 17470 LDY PP+1 17480 BNE HE896 ;=>always 17490 17500 * tkn $5C GOSUB 17510 17520 GOSUB ;VO 17530 LDY #ErrMsg08 ;"16 GOSUBS" 17540 LDA GOSUBNDX 17550 CMP #16 ;sixteen GOSUBs? 17560 BCS HE8A2 ;=HS> yes, error 17570 TAY 17580 INC GOSUBNDX 17590 17600 LDA PX 17610 STA STK_00,Y 17620 LDA PX+1 17630 STA STK_10,Y 17640 17650 LDA PR 17660 STA STK_20,Y 17670 LDA PR+1 17680 STA STK_30,Y 17690 17700 * tkn $24 THEN 17710 * followed by a line number 17720 * IF X=3 THEN 10 17730 17740 * tkn $5F GOTO 17750 17760 GOTO ;V 17770 JSR GET16BIT 17780 JSR HE56D 17790 *!IF 17800 LDY #ErrMsg07 ;"BAD BRANCH" 17810 BNE HE8A2 ;=>always 17820 *!ENDIF 17830 LDA P2 17840 LDY P2+1 17850 17860 * main loop for running Integer BASIC programs 17870 17880 *!LOOP 17890 *! LOOP 17900 STA PR 17910 STY PR+1 17920 CLC 17930 ADC #$03 17940 *! IF 17950 INY 17960 *! ENDIF 17970 GETNEXT ;fetch next statement from text source 17980 LDX #$FF 17990 STX RUNFLAG ;neg 18000 TXS 18010 STA PX 18020 STY PX+1 18030 JSR HF02E ;test for ctrl-C & TRACE mode 18040 LDY #0 18050 HE883 18060 JSR HE679 ;execute statement 18070 BIT RUNFLAG 18080 BPL END ;=> 18090 CLC 18100 LDY #0 18110 LDA PR 18120 ADC (PR),Y 18130 LDY PR+1 18140 *! IF 18150 INY 18160 *! ENDIF 18170 HE896 18180 CMP HIMEM 18190 *! UNTIL 18200 CPY HIMEM+1 18210 *!UNTIL 18220 LDY #ErrMsg06 ;"NO END" 18230 LSR RUNFLAG ;pos 18240 HE8A2 18250 JMP ERRMESS 18260 *> 18270 18280 * tkn $5B RETURN 18290 18300 RETURN ;V 18310 LDY #ErrMsg09 ;"BAD RETURN" 18320 LDA GOSUBNDX 18330 BEQ HE8A2 ;=> 18340 DEC GOSUBNDX 18350 TAY 18360 LDA STK_20-1,Y 18370 STA PR 18380 LDA STK_30-1,Y 18390 STA PR+1 18400 LDX: STK_00-1,Y 18410 LDA STK_10-1,Y 18420 HE8BE 18430 TAY 18440 TXA 18450 JMP GETNEXT 18460 *> 18470 18480 STOPPED_AT 18490 LDY #ErrMsg12 ;"STOPPED AT " 18500 JSR ERRORMESS 18510 LDY #1 18520 LDA (PR),Y 18530 TAX 18540 INY 18550 LDA (PR),Y 18560 JSR PRDEC 18570 18580 * tkn $51 END 18590 18600 END ;V 18610 JMP WARM 18620 *> 18630 18640 *!LOOP 18650 *! LOOP 18660 DEC FORNDX 18670 18680 * tkn $59 NEXT 18690 18700 * tkn $5A , 18710 * NEXT X,Y 18720 18730 NEXT ;VO 18740 LDY #ErrMsg11 ;"BAD NEXT" 18750 LDA FORNDX 18760 HE8DC 18770 BEQ HE8A2 ;=>no more FORs 18780 TAY 18790 LDA NOUNSTKL,X 18800 CMP STK_40-1,Y 18810 *! UNTIL 18820 LDA NOUNSTKH,X 18830 CMP STK_50-1,Y 18840 *!UNTIL 18850 18860 LDA STK_60-1,Y 18870 STA AUX 18880 LDA STK_70-1,Y 18890 STA AUX+1 18900 18910 JSR GET16BIT 18920 DEX 18930 JSR HE793 18940 JSR HE801 18950 DEX 18960 LDY FORNDX 18970 LDA STK_D0-1,Y 18980 STA NOUNSTKC-1,X 18990 LDA STK_C0-1,Y 19000 LDY #0 19010 JSR HE708 19020 JSR SUBTRACT 19030 JSR SGN 19040 JSR GET16BIT 19050 LDY FORNDX 19060 LDA ACC 19070 *!IF 19080 EOR STK_70-1,Y 19090 BPL HE937 ;=> 19100 *!ENDIF 19110 19120 LDA STK_80-1,Y 19130 STA PR 19140 LDA STK_90-1,Y 19150 STA PR+1 19160 19170 LDX STK_A0-1,Y 19180 LDA STK_B0-1,Y 19190 BNE HE8BE ;=> 19200 HE937 19210 DEC FORNDX 19220 RTS 19230 ** 19240 19250 * tkn $55 FOR 19260 19270 FOR ;VO 19280 LDY #ErrMsg10 ;"16 FORS" 19290 LDA FORNDX 19300 CMP #16 ;sixteen FORs? 19310 BEQ HE8DC ;=>yes, error 19320 INC FORNDX 19330 TAY 19340 LDA NOUNSTKL,X 19350 STA STK_40,Y 19360 LDA NOUNSTKH,X 19370 JMP HF288 19380 *> 19390 19400 RTS ;Z 19410 ** 19420 19430 * tkn $57 TO 19440 19450 TO ;VO 19460 JSR GET16BIT 19470 LDY FORNDX 19480 19490 LDA ACC 19500 STA STK_C0-1,Y 19510 LDA ACC+1 19520 STA STK_D0-1,Y 19530 19540 LDA #<$0001 19550 STA STK_60-1,Y 19560 LDA #>$0001 19570 HE966 ;solo 19580 STA STK_70-1,Y 19590 19600 LDA PR 19610 STA STK_80-1,Y 19620 LDA PR+1 19630 STA STK_90-1,Y 19640 19650 LDA PX 19660 STA STK_A0-1,Y 19670 LDA PX+1 19680 STA STK_B0-1,Y 19690 RTS 19700 ** 19710 19720 DB $20,$15 ;Z 19730 19740 19750 PUT TABLE1 19760 HE980 19770 DB $00,$00,$00,$AB,$03,$03,$03,$03 19780 DB $03,$03,$03,$03,$03,$03,$03,$03 19790 DB $03,$03,$3F,$3F,$C0,$C0,$3C,$3C 19800 DB $3C,$3C,$3C,$3C,$3C,$30,$0F,$C0 19810 DB $C3,$FF,$55,$00,$AB,$AB,$03,$03 19820 DB $FF,$FF,$55,$FF,$FF,$55,$CF,$CF 19830 DB $CF,$CF,$CF,$FF,$55,$C6,$C6,$C6 19840 DB $55,$F0,$F0,$CF,$CF,$55,$01,$55 19850 DB $FF,$FF,$55,$03,$03,$03,$03,$03 19860 DB $03,$03,$03,$03,$03,$03,$03,$03 19870 DB $03,$03,$03,$03,$03,$03,$03,$03 19880 DB $03,$03,$03,$03,$03,$00,$AB,$03 19890 DB $57,$03,$03,$03,$03,$07,$03,$03 19900 DB $03,$03,$03,$03,$03,$03,$03,$03 19910 DB $03,$03,$AA,$FF,$03,$03,$03,$03 19920 DB $03,$03,$03,$03,$03,$03,$03,$03 19930 19940 * token address tables (verb dispatch tables) 19950 19960 VERBADRL 19970 DB BEGIN_LINE,>$FFFF,>$FFFF,>COLON 20320 DB >LOAD,>SAVE,>CON,>RUNNUM 20330 DB >RUN,>DEL,>COMMA_DEL,>NEW 20340 DB >CLR,>AUTO,>COMMA_AUTO,>MAN 20350 DB >VHIMEM,>VLOMEM,>ADDITION,>SUBTRACT 20360 DB >MULT,>DIVIDE,>HE733,>HE74A 20370 DB >HF25B,>HF24E,>HF253,>HE74A 20380 DB >HF249,>VAND,>VOR,>MOD 20390 DB >EXP,>$FFFF,>HE823,>COMMA_SUBSTR 20400 DB >GOTO,>LET,>HEFB6,>HEBCB 20410 DB >$FFFF,>$FFFF,>PAREN_SUBSTR,>$FFFF 20420 DB >$FFFF,>HEF24,>PEEK,>RND 20430 DB >SGN,>ABS,>PDL,>$FFFF 20440 DB >HE823,>POSITIVE,>NEGATE,>NOT 20450 DB >HE823,>HE1D7,>HE21C,>LEN 20460 DB >ASC,>SCRN,>COMMA_SCRN,>HE823 20470 DB >$FFFF,>$FFFF,>HE121,>DIMSTR 20480 DB >DIMNUM,>PRNTSTR,>PRNTNUM,>HE820 20490 DB >HEE00,>HE7C1,>HF3BA,>SETTXT 20500 DB >SETGR,>CALL,>DIMSTR,>DIMNUM 20510 DB >TAB,>END,>HEFB6,>INPUT_PROMPT 20520 DB >HEBAA,>FOR,>HE801,>TO 20530 DB >STEP,>NEXT,>NEXT,>RETURN 20540 DB >GOSUB,>$FFFF,>LET,>GOTO 20550 DB >IF,>PRNTSTR,>PRNTNUM,>PRINT_CR 20560 DB >POKE,>GETVAL255,>COLOR,>GETVAL255 20570 DB >COMMA_PLOT,>GETVAL255,>COMMA_HLIN,>AT_HLIN 20580 DB >GETVAL255,>COMMA_VLIN,>AT_VLIN,>IVTAB 20590 DB >HE18C,>HE801,>RIGHT_PAREN,>$FFFF 20600 DB >LISTNUM,>COMMA_LIST,>LIST,>POP 20610 DB >NODSP_STR,>NODSP_NUM,>NOTRACE,>DSP_NUM 20620 DB >DSP_STR,>TRACE,>PRSLOT,>INSLOT 20630 20640 ErrorMsgs 20650 20660 ErrMsg00 = *-ErrorMsgs+$8100 ;00 20670 DCI ">32767" 20680 20690 ErrMsg01 = *-ErrorMsgs+$8100 ;06 20700 DCI "TOO LONG" 20710 20720 ErrMsg02 = *-ErrorMsgs+$8100 ;0E 20730 DCI "SYNTAX" 20740 20750 ErrMsg03 = *-ErrorMsgs+$8100 ;14 20760 DCI "MEM FULL" 20770 20780 ErrMsg04 = *-ErrorMsgs+$8100 ;1C 20790 DCI "TOO MANY PARENS" 20800 20810 ErrMsg05 = *-ErrorMsgs+$8100 ;2B 20820 DCI "STRING" 20830 20840 ErrMsg06 = *-ErrorMsgs+$8100 ;31 20850 DCI "NO END" 20860 20870 ErrMsg07 = *-ErrorMsgs+$8100 ;37 20880 DCI "BAD BRANCH" 20890 20900 ErrMsg08 = *-ErrorMsgs+$8100 ;41 20910 DCI "16 GOSUBS" 20920 20930 ErrMsg09 = *-ErrorMsgs+$8100 ;4A 20940 DCI "BAD RETURN" 20950 20960 ErrMsg10 = *-ErrorMsgs+$8100 ;54 20970 DCI "16 FORS" 20980 20990 ErrMsg11 = *-ErrorMsgs+$8100 ;5B 21000 DCI "BAD NEXT" 21010 21020 ErrMsg12 = *-ErrorMsgs+$8100 ;63 21030 DCI "STOPPED AT " 21040 21050 ErrMsg13 = *-ErrorMsgs+$8100 ;6E 21060 DCI "*** " 21070 21080 ErrMsg14 = *-ErrorMsgs+$8100 ;72 21090 ASC " ERR" 21100 DB CR 21110 21120 ErrMsg15 = *-ErrorMsgs+$8100 ;77 21130 DCI ">255" 21140 21150 ErrMsg16 = *-ErrorMsgs+$8100 ;7B 21160 DCI "RANGE" 21170 21180 ErrMsg17 = *-ErrorMsgs+$8100 ;80 21190 DCI "DIM" 21200 21210 ErrMsg18 = *-ErrorMsgs+$8100 ;83 21220 DCI "STR OVFL" 21230 21240 ASC "\" ;8B 21250 DB CR 21260 21270 ErrMsg20 = *-ErrorMsgs+$8100 ;8D 21280 ASC "RETYPE LINE" 21290 DB CR+$80 21300 21310 ErrMsg21 = *-ErrorMsgs+$8100 ;99 21320 ASC '?' 21330 21340 PUT PART2 21350 21360 *continue run w/o deleting vars? 21370 21380 HEB9A ;solo 21390 LSR RUNFLAG ;pos 21400 *!IF 21410 JMP STOPPED_AT 21420 *!ENDIF 21430 LDX ACC+1 21440 TXS 21450 LDX ACC 21460 LDY #ErrMsg20 ;"RETYPE LINE",CR,"?" 21470 BNE HEBAC ;=>always 21480 21490 * tkn $54 INPUT 21500 * num with no prompt 21510 * INPUT X 21520 21530 HEBAA ;VO branch 21540 LDY #ErrMsg21 ;'?' for INPUT 21550 HEBAC 21560 JSR ERRORMESS 21570 STX ACC 21580 TSX 21590 STX ACC+1 21600 JSR HF366 21610 STY TOKNDX 21620 LDA #$FF 21630 STA TXTNDX 21640 ASL 21650 STA RUNFLAG ;neg 21660 LDX #$20 21670 LDA #$15 21680 JSR HE491 21690 INC RUNFLAG 21700 LDX ACC 21710 21720 * tkn $27 , 21730 * num inputs 21740 * INPUT "QUANTITY",Q 21750 21760 HEBCB ;VO 21770 LDY TXTNDX 21780 ASL 21790 *!LOOP 21800 STA ACC 21810 INY 21820 LDA IN,Y 21830 CMP #$80 21840 BEQ HEBAA ;=>end of input? 21850 EOR #"0" 21860 CMP #10 21870 *!UNTIL 21880 INY 21890 INY 21900 STY TXTNDX 21910 LDA IN,Y 21920 PHA 21930 LDA IN-1,Y 21940 LDY #0 21950 JSR HE708 21960 PLA 21970 STA NOUNSTKC,X 21980 LDA ACC 21990 CMP #$33 22000 *!IF 22010 JSR NEGATE 22020 *!ENDIF 22030 JMP HE801 22040 *> 22050 22060 22070 22080 DB $FF,$FF,$FF ;Z 22090 22100 PUT TABLE2 22110 * token/syntax table 22120 22130 SYNTABL 22140 DB $50 22150 22160 DB $20,$4F,$C0 ;Z 22170 DB "T"+32,"A"-32 ;Z 22180 DB "D"+32,"O"-32,"M"-32 ;Z 22190 DB "R"+32,"O"-32 ;Z 22200 DB "D"+32,"N"-32,"A"-32 ;Z 22210 DB "P"+32,"E"-32,"T"-32,"S"-32 ;Z 22220 DB "O"+32,"T"-32 ;Z 22230 DB "N"+32,"E"-32,"H"-32,"T"-32 ;Z 22240 22250 DB $5C,$80,$00,$40 22260 DB $60,$8D,$60,$8B,$7F,$1D,$20,$7E 22270 DB $8C,$33,$00,$00,$60,$03,$BF,$12 22280 22290 DB $47,"#"-32,"N"-32,"I"-32 ;IN# 22300 DB $67,"#"-32,"R"-32,"P"-32 ;PR# 22310 DB "E"+32,"C"-32,"A"-32,"R"-32,"T"-32 ;TRACE 22320 DB $79,"P"-32,"S"-32,"D"-32 ;DSP 22330 DB $69,"P"-32,"S"-32,"D"-32 ;DSP 22340 DB "E"+32,"C"-32,"A"-32,"R"-32,"T"-32,"O"-32,"N"-32 ;NOTRACE 22350 DB $79,"P"-32,"S"-32,"D"-32,"O"-32,"N"-32 ;NODSP 22360 DB $69,"P"-32,"S"-32,"D"-32,"O"-32,"N"-32 ;NODSP 22370 DB "P"+32,"O"-32,"P"-32 ;POP 22380 DB "T"+32,"S"-32,"I"-32,"L"-32 ;LIST 22390 DB $60,","-32 ; 22400 DB $20,"T"-32,"S"-32,"I"-32,"L"-32 ;LIST 22410 DB 0 22420 DB $40,$89 22430 DB ")"+32 ; 22440 DB $47,"="-32 ; 22450 DB $17,$68,"="-32 ; 22460 DB $0A,$58,$7B,$67,"B"-32,"A"-32,"T"-32,"V"-32 ;VTAB 22470 DB $67,"T"-32,"A"-32 ;AT 22480 DB $07,","-32 ; 22490 DB $07,"N"-32,"I"-32,"L"-32,"V"-32 ;VLIN 22500 DB $67,"T"-32,"A"-32 ;AT 22510 DB $07,","-32 ; 22520 DB $07,"N"-32,"I"-32,"L"-32,"H"-32 ;HLIN 22530 DB $67,","-32 ; 22540 DB $07,"T"-32,"O"-32,"L"-32,"P"-32 ;PLOT 22550 DB $67,"="-32,"R"-32,"O"-32,"L"-32,"O"-32,"C"-32 ;COLOR= 22560 DB $67,","-32 ; 22570 DB $07,"E"-32,"K"-32,"O"-32,"P"-32 ;POKE 22580 DB "T"+32,"N"-32,"I"-32,"R"-32,"P"-32 ;PRINT 22590 DB $7F,$0E,$27,"T"-32,"N"-32,"I"-32,"R"-32,"P"-32 ;PRINT 22600 DB $7F,$0E,$28,"T"-32,"N"-32,"I"-32,"R"-32,"P"-32 ;PRINT 22610 DB $64,$07,"F"-32,"I"-32 ;IF 22620 DB $67,"O"-32,"T"-32,"O"-32,"G"-32 ;GOTO 22630 DB $78,"T"-32,"E"-32,"L"-32 ;LET 22640 DB $6B,$7F,$02,"M"-32,"E"-32,"R"-32 ;REM 22650 DB $67,"B"-32,"U"-32,"S"-32,"O"-32,"G"-32 ;GOSUB 22660 DB "N"+32,"R"-32,"U"-32,"T"-32,"E"-32,"R"-32 ;RETURN 22670 DB $7E,","-32 ; 22680 DB $39,"T"-32,"X"-32,"E"-32,"N"-32 ;NEXT 22690 DB $67,"P"-32,"E"-32,"T"-32,"S"-32 ;STEP 22700 DB $27,"O"-32,"T"-32 ;TO 22710 DB $07,"="-32 ; 22720 DB $19,"R"-32,"O"-32,"F"-32 ;FOR 22730 DB $7F,$05,$37,"T"-32,"U"-32,"P"-32,"N"-32,"I"-32 ;INPUT 22740 DB $7F,$05,$28,"T"-32,"U"-32,"P"-32,"N"-32,"I"-32 ;INPUT 22750 DB $7F,$05,$2A,"T"-32,"U"-32,"P"-32,"N"-32,"I"-32 ;INPUT 22760 DB "D"+32,"N"-32,"E"-32 ;END (tkn $51) 22770 22780 SYNTABL2 22790 DB 0 22800 DB $47,"B"-32,"A"-32,"T"-32 ;TAB (tkn $50) 22810 DB $7F,$0D,$30,"M"-32,"I"-32,"D"-32 ;DIM 22820 DB $7F,$0D,$23,"M"-32,"I"-32,"D"-32 ;DIM 22830 DB $67,"L"-32,"L"-32,"A"-32,"C"-32 ;CALL 22840 DB "R"+32,"G"-32 ;GR 22850 DB "T"+32,"X"-32,"E"-32,"T"-32 ;TEXT 22860 DB 0 ;above are statements 22870 DB $4D,","+32 ; 22880 DB $67,","-32 ; 22890 DB $68,","-32 ; 22900 DB ";"+32 ; 22910 DB $67,";"-32 ; 22920 DB $68,";"-32 ; 22930 DB $50,","-32 ; 22940 DB $63,","-32 ; 22950 DB $7F,$01,$51,$07,"("-32 ; 22960 DB $29,$84 22970 DB $80,"$"+32 ; 22980 DB $19,$57,$71,$07,"("-32 ; 22990 DB $14,$71,$07,","-32 ; 23000 DB $07,"("-32,"N"-32,"R"-32,"C"-32,"S"-32 ;SCRN( 23010 DB $71,$08,"("-32,"C"-32,"S"-32,"A"-32 ;ASC( 23020 DB $71,$08,"("-32,"N"-32,"E"-32,"L"-32 ;LEN( 23030 DB $68,"#"-32 ; 23040 DB $08,$68,"="-32 ; 23050 DB $08,$71,$07,"("-32 ; 23060 DB $60,$75,"T"-32,"O"-32,"N"-32 ;NOT 23070 DB $75,"-"-32 ; 23080 DB $75,"+"-32 ; 23090 DB $51,$07,"("-32,$19 ; 23100 DB "X"-32,"D"-32,"N"-32,"R"-32 23110 DB "L"+32,"D"-32,"P"-32 ;PDL 23120 DB "S"+32,"B"-32,"A"-32 ;ABS 23130 DB "N"+32,"G"-32,"S"-32 ;SGN 23140 DB "D"+32,"N"-32,"R"-32 ;RND 23150 DB "K"+32,"E"-32,"E"-32,"P"-32 ;PEEK 23160 DB $51,$07,"("-32 ; 23170 DB $39,$81,$C1,$4F,$7F,$0F,$2F 23180 DB 0 ;above are functions 23190 DB $51,$06,"("-32 ; 23200 DB $29,"""+32 ;open quote 23210 DB $0C,"""-32 ;close quote 23220 DB $57,","-32 ; 23230 DB $6A,","-32 ; 23240 DB $42,"N"-32,"E"-32,"H"-32,"T"-32 ;THEN 23250 DB $60,"N"-32,"E"-32,"H"-32,"T"-32 ;THEN 23260 DB $4F,$7E,$1E,$35,","-32 ; 23270 DB $27,$51,$07,"("-32 ; 23280 DB $09,"+"-32 23290 DB "^"+32 ;exponent 23300 DB "D"+32,"O"-32,"M"-32 ;MOD 23310 DB "R"+32,"O"-32 ;OR 23320 DB "D"+32,"N"-32,"A"-32 ;AND 23330 DB "<"+32 ;less than 23340 DB ">"+32,"<"-32 ;not equal 23350 DB "="+32,"<"-32 ;less or equal 23360 DB ">"+32 ;greater than 23370 DB "="+32,">"-32 ;greater or equal 23380 DB "#"+32 ;not equal 23390 DB "="+32 ;equal 23400 DB "/"+32 ;divide 23410 DB "*"+32 ;multiply 23420 DB "-"+32 ;subtract 23430 DB "+"+32 ;add 23440 DB 0 ;above 4 are num ops 23450 DB $47,":"-32,"M"-32,"E"-32,"M"-32,"O"-32,"L"-32 ;LOMEM: 23460 DB $67,":"-32,"M"-32,"E"-32,"M"-32,"I"-32,"H"-32 ;HIMEM: 23470 DB "N"+32,"A"-32,"M"-32 ;MAN 23480 DB $60,","-32 ;comma for AUTO 23490 DB $20,"O"-32,"T"-32,"U"-32,"A"-32 ;AUTO 23500 DB "R"+32,"L"-32,"C"-32 ;CLR 23510 DB "W"+32,"E"-32,"N"-32 ;NEW 23520 DB $60,","-32 ;comma for DEL 23530 DB $20,"L"-32,"E"-32,"D"-32 ;DEL 23540 DB "N"+32,"U"-32,"R"-32 ;RUN 23550 DB $60,"N"-32,"U"-32,"R"-32 ;RUN 23560 DB "N"+32,"O"-32,"C"-32 ;CON 23570 DB "E"+32,"V"-32,"A"-32,"S"-32 ;SAVE 23580 DB "D"+32,"A"-32,"O"-32,"L"-32 ;LOAD 23590 *above are commands 23600 DB $7A,$7E,$9A,$22,$20 23610 DB $00,$60,$03,$BF,$60,$03,$BF,$1F 23620 23630 23640 PUT PART3 23650 * tkn $48 , 23660 * string prints 23670 * PRINT T,A$ 23680 23690 HEE00 ;VO 23700 JSR HE7B1 23710 23720 * tkn $45 ; 23730 * string prints 23740 * PRINT anytype ; string 23750 23760 * tkn $61 PRINT 23770 * string var or literal 23780 * PRINT A$: PRINT "HELLO" 23790 23800 PRNTSTR ;V 23810 INX 23820 INX 23830 LDA NOUNSTKL-1,X 23840 STA AUX 23850 LDA NOUNSTKH-1,X 23860 STA AUX+1 23870 LDY NOUNSTKL-2,X 23880 HEE0F ;*!LOOP 23890 TYA 23900 CMP NOUNSTKH-2,X 23910 BCS HEE1D ;=HS>exit loop 23920 LDA (AUX),Y 23930 JSR COUT 23940 INY 23950 JMP HEE0F ;*!loop always 23960 HEE1D 23970 LDA #$FF 23980 STA CRFLAG ;CRFLAG := $FF 23990 RTS 24000 ** 24010 24020 * tkn $3B LEN( 24030 24040 LEN ;VO 24050 INX 24060 LDA #0 24070 STA NOUNSTKH,X 24080 STA NOUNSTKC,X 24090 LDA NOUNSTKH-1,X 24100 SEC 24110 SBC NOUNSTKL-1,X 24120 STA NOUNSTKL,X 24130 JMP HE823 24140 *> 24150 24160 DB $FF ;Z 24170 24180 GETBYTE 24190 JSR GET16BIT 24200 LDA ACC+1 24210 BNE HI255ERR ;=>">255" error 24220 LDA ACC 24230 RTS 24240 ** 24250 24260 * tkn $68 , 24270 * PLOT 20,15 24280 24290 COMMA_PLOT ;VO 24300 JSR GETBYTE 24310 LDY TXTNDX 24320 CMP #48 24330 BCS RANGERR ;=HS> 24340 CPY #40 24350 BCS RANGERR ;=HS> 24360 JMP PLOT 24370 *> 24380 24390 * tkn $66 COLOR= 24400 24410 COLOR ;VO 24420 JSR GETBYTE 24430 JMP SETCOL 24440 *> 24450 24460 * tkn $0F MAN 24470 24480 MAN 24490 LSR AUTOFLAG ;manual 24500 RTS 24510 ** 24520 24530 * tkn $6F VTAB 24540 24550 IVTAB ;VO 24560 JSR HF3B3 24570 CMP #24 24580 BCS RANGERR ;=HS> 24590 STA CV 24600 JMP VTAB 24610 *> 24620 24630 HI255ERR 24640 LDY #ErrMsg15 ;">255" 24650 HEE65 24660 JMP ERRMESS 24670 *> 24680 24690 RANGERR 24700 LDY #ErrMsg16 ;"RANGE" 24710 BNE HEE65 ;=>always 24720 24730 * divide routine 24740 24750 HEE6C 24760 JSR HE254 24770 LDA AUX ;is AUX zero? 24780 *!IF 24790 LDA AUX+1 24800 *! IF 24810 JMP HE77E ;yes, ">32767" error 24820 *! ENDIF 24830 *!ENDIF 24840 *!LOOP 24850 ASL ACC 24860 ROL ACC+1 24870 ROL P3 24880 ROL P3+1 24890 CMPW P3;AUX 24900 *! IF 24910 STA P3+1 ;P3 := P3-AUX 24920 LDA P3 24930 SBC AUX 24940 STA P3 24950 INC ACC 24960 *! ENDIF 24970 DEY 24980 *!UNTIL 24990 RTS 25000 ** 25010 25020 DB $FF,$FF,$FF,$FF,$FF,$FF ;Z 25030 25040 * tkn $4D CALL 25050 25060 CALL ;VO 25070 JSR GET16BIT 25080 JMP (ACC) 25090 *> 25100 25110 * tkn $6A , 25120 * HLIN 10,20 AT 30 25130 25140 COMMA_HLIN ;VO 25150 JSR GETBYTE 25160 CMP TXTNDX 25170 BCC RANGERR ;=LO> 25180 STA H2 25190 RTS 25200 ** 25210 25220 * tkn $6B AT 25230 * HLIN 10,20 AT 30 25240 25250 AT_HLIN ;VO 25260 JSR GETBYTE 25270 CMP #48 25280 BCS RANGERR ;=HS> 25290 LDY TXTNDX 25300 JMP HLINE 25310 *> 25320 25330 * tkn $6D , 25340 * VLIN 10,20 AT 30 25350 25360 COMMA_VLIN ;VO 25370 JSR GETBYTE 25380 CMP TXTNDX 25390 BCC RANGERR ;=LO> 25400 STA V2 25410 RTS 25420 ** 25430 25440 * tkn $6E AT 25450 * VLIN 10,20 AT 30 25460 25470 AT_VLIN ;VO 25480 JSR GETBYTE 25490 CMP #40 25500 HEECB 25510 BCS RANGERR ;=HS> 25520 TAY 25530 LDA TXTNDX 25540 JMP VLINE 25550 *> 25560 25570 PRINTERR 25580 TYA 25590 TAX 25600 LDY #ErrMsg13 ;"*** " 25610 JSR ERRORMESS 25620 TXA 25630 TAY 25640 JSR ERRORMESS 25650 LDY #ErrMsg14 ;" ERR" 25660 JMP PRTERR 25670 *> 25680 25690 HEEE4 25700 JSR HF23F 25710 *!LOOP 25720 ASL ACC 25730 ROL ACC+1 25740 *!UNTIL 25750 BCS HEECB ;=>"RANGE" error 25760 *!IF 25770 CMP ACC 25780 BCS HEECB ;=HS>"RANGE" error 25790 *!ENDIF 25800 RTS 25810 ** 25820 25830 * tkn $2E PEEK 25840 * uses tkn $3F ( 25850 25860 PEEK ;VO 25870 JSR GET16BIT 25880 LDA (ACC),Y 25890 STY NOUNSTKC-1,X 25900 JMP HE708 25910 *> 25920 25930 * tkn $65 , 25940 * POKE 20000,5 25950 25960 * tkn $67 PLOT 25970 25980 * tkn $69 HLIN 25990 26000 * tkn $6C VLIN 26010 26020 GETVAL255 ;VO 26030 JSR GETBYTE 26040 LDA ACC 26050 STA TXTNDX 26060 RTS 26070 ** 26080 26090 * tkn $64 POKE 26100 26110 POKE ;VO 26120 JSR GET16BIT 26130 LDA TXTNDX 26140 STA (ACC),Y 26150 RTS 26160 ** 26170 26180 * tkn $15 / 26190 * num op. uses $38 ( 26200 * A = 27 / 2 26210 26220 DIVIDE ;VO 26230 JSR HEE6C 26240 MOVW ACC;P3 26250 JMP HE244 26260 *> 26270 26280 * tkn $44 , 26290 * next var in DIM is num 26300 * DIM X(5),A(5) 26310 26320 * tkn $4F DIM 26330 * num var. uses tkn $22 ( 26340 * DIM A(5) 26350 26360 DIMNUM ;VO 26370 JSR HEEE4 26380 JMP HE134 26390 *> 26400 26410 * tkn $2D ( 26420 * var array 26430 * X(12) 26440 26450 HEF24 ;VO 26460 JSR HEEE4 26470 LDY NOUNSTKH,X 26480 LDA NOUNSTKL,X 26490 ADC #$FE 26500 *!IF 26510 DEY 26520 *!ENDIF 26530 STA AUX 26540 STY AUX+1 26550 CLC 26560 ADC ACC 26570 STA NOUNSTKL,X 26580 TYA 26590 ADC ACC+1 26600 STA NOUNSTKH,X 26610 LDY #0 26620 LDA NOUNSTKL,X 26630 CMP (AUX),Y 26640 INY 26650 LDA NOUNSTKH,X 26660 SBC (AUX),Y 26670 BCS HEECB ;=HS>"RANGE" error 26680 JMP HE823 26690 *> 26700 26710 * tkn $2F RND 26720 * uses tkn $3F ( 26730 26740 RND ;VO 26750 JSR GET16BIT 26760 LDA RNDL 26770 JSR HE708 26780 LDA RNDH 26790 *!IF 26800 CMP RNDL 26810 ADC #0 26820 *!ENDIF 26830 AND #$7F 26840 STA RNDH 26850 STA NOUNSTKC,X 26860 LDY #$11 26870 *!LOOP 26880 LDA RNDH 26890 ASL 26900 CLC 26910 ADC #$40 26920 ASL 26930 ROL RNDL 26940 ROL RNDH 26950 DEY 26960 *!UNTIL 26970 LDA ACC 26980 JSR HE708 26990 LDA ACC+1 27000 STA NOUNSTKC,X 27010 JMP MOD 27020 *> 27030 27040 JSR GET16BIT ;Z 27050 LDY ACC ;is ACC LOMEM? 27060 CPY LOMEM 27070 LDA ACC+1 27080 SBC LOMEM+1 27090 BCC HEFAB ;=LO>yes 27100 STY HIMEM ;HIMEM := ACC 27110 LDA ACC+1 27120 STA HIMEM+1 27130 HEF93 ;Z 27140 JMP NEW 27150 *> 27160 27170 JSR GET16BIT ;Z 27180 LDY ACC ;is ACC LOMEM? 27190 CPY HIMEM 27200 LDA ACC+1 27210 SBC HIMEM+1 27220 BCS HEFAB ;=HS>yes 27230 STY LOMEM ;LOMEM := ACC 27240 LDA ACC+1 27250 STA LOMEM+1 27260 BCC HEF93 ;=LO>always 27270 27280 HEFAB ;Z 27290 JMP HEECB ;range error? 27300 *> 27310 27320 DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF ;Z 27330 27340 * tkn $26 , 27350 * string inputs 27360 * INPUT "WHO",W$ 27370 27380 * tkn $52 INPUT 27390 * string with no prompt 27400 * INPUT S$ 27410 27420 HEFB6 ;VO 27430 JSR INPUTSTR 27440 JMP HEFBF 27450 *> 27460 27470 * tkn $53 INPUT 27480 * string or num with prompt 27490 * INPUT "WHO",W$: INPUT "QUANTITY",Q 27500 27510 INPUT_PROMPT ;VO 27520 JSR PRNTSTR 27530 HEFBF 27540 LDA #$FF 27550 STA TXTNDX 27560 LDA #$80 27570 STA IN 27580 RTS 27590 ** 27600 27610 HEFC9 27620 JSR NOT 27630 INX 27640 HEFCD ;solo 27650 JSR NOT 27660 LDA NOUNSTKL,X 27670 RTS 27680 ** 27690 27700 * old 4K cold start 27710 27720 HEFD3 ;Z 27730 LDA #0 27740 STA LOMEM ;LOMEM := $0800 27750 STA HIMEM ;HIMEM := $1000 27760 LDA #>$0800 27770 STA LOMEM+1 27780 LDA #>$1000 27790 STA HIMEM+1 27800 JMP NEW 27810 *> 27820 27830 HEFE4 ;solo 27840 CMP NOUNSTKH,X 27850 *!IF 27860 CLC 27870 *!ENDIF 27880 JMP HE102 27890 *> 27900 27910 * tkn $08 RUN 27920 * run from first line of program 27930 27940 RUN ;VO 27950 JSR CLR 27960 JMP RUNWARM 27970 *> 27980 27990 * tkn $07 RUN 28000 * RUN 100 28010 28020 RUNNUM ;VO 28030 JSR CLR 28040 JMP GOTO 28050 *> 28060 28070 HEFF8 ;solo 28080 CPX #$80 28090 *!IF 28100 DEY 28110 *!ENDIF 28120 JMP HE00C 28130 *> 28140 28142 * Cold start 28150 * set LOMEM, find HIMEM 28152 * fall into NEW 28160 28170 COLD 28180 LDY #<$0800 28190 STY NOUNSTKC 28200 STY LOMEM ;LOMEM := $0800 28210 STY HIMEM ;HIMEM := $0800 28220 LDA #>$0800 28230 STA LOMEM+1 28240 STA HIMEM+1 28250 *!LOOP 28260 INC HIMEM+1 ;find top of RAM 28270 LDA (HIMEM),Y 28280 EOR #$FF 28290 STA (HIMEM),Y 28300 CMP (HIMEM),Y 28310 *!WHILE 28320 EOR #$FF 28330 STA (HIMEM),Y 28340 CMP (HIMEM),Y 28350 *!UNTIL 28360 JMP NEW 28370 *> 28380 28390 HF025 ;solo 28400 JMP HF179 28410 *> 28420 28430 JSR HF032 ;Z 28440 JMP HE8BE ;Z 28450 *> 28460 28470 HF02E ;solo 28480 LDX PX 28490 LDA PX+1 28500 HF032 ;Z 28510 LDY KBD ;get keypress 28520 CPY #ETX+$80 ;is it ctrl-C? 28530 BNE HF025 ;=>no 28540 BIT KBDSTRB ;yes, clear keypress 28550 STX NOUNSTKL 28560 STA NOUNSTKL+1 28570 MOVW PR;NOUNSTKH 28580 JMP STOPPED_AT 28590 *> 28600 28610 DB $FF,$FF ;Z 28620 28630 * tkn $10 HIMEM: 28640 28650 VHIMEM ;VO 28660 JSR GET16BIT 28670 STX XSAVE 28680 LDX #0-2 28690 SEC 28700 28710 * MOVW ACC;P2 28720 * SUBW HIMEM;ACC;AUX 28730 28740 *!LOOP 28750 LDA ACC+2,X 28760 STA P2+2,X 28770 LDA HIMEM+2,X 28780 SBC ACC+2,X 28790 STA AUX+2,X 28800 INX 28810 *!UNTIL 28820 BCC HF0AF ;=> 28830 DEX ;Xreg := $FF 28840 28850 * MOVW PP;P3 28860 * SUBW PP;AUX;P2 28870 28880 *!LOOP 28890 LDA PP+1,X 28900 STA P3+1,X 28910 SBC AUX+1,X 28920 STA P2+1,X 28930 INX 28940 *!UNTIL 28950 *!IF 28960 CMPW PV;P2 28970 BCC HF08F ;=>PV P2 28980 *!ENDIF 28990 HF07C 29000 JMP MEMFULL 29010 *> 29020 29030 *!LOOP 29040 LDA (P3),Y 29050 STA (P2),Y 29060 INCW P2 29070 INCW P3 29080 HF08F ;solo 29090 CMPW P3;HIMEM 29100 *!UNTIL 29110 HF099 ;solo 29120 LDX #0-2 29130 29140 * MOVW P2;HIMEM 29150 * SUBW PP;AUX;PP 29160 29170 *!LOOP 29180 LDA P2+2,X 29190 STA HIMEM+2,X 29200 LDA PP+2,X 29210 SBC AUX+2,X 29220 STA PP+2,X 29230 INX 29240 *!UNTIL 29250 LDX XSAVE 29260 RTS 29270 ** 29280 29290 *!LOOP 29300 LDA (HIMEM),Y 29310 STA (ACC),Y 29320 HF0AF ;solo 29330 DECW ACC 29340 DECW HIMEM 29350 CMP PP ;is PP HIMEM? 29360 LDA HIMEM+1 29370 SBC PP+1 29380 *!UNTIL 29390 BCS HF099 ;=HS> always 29400 29410 * tkn $11 LOMEM: 29420 29430 VLOMEM ;VO 29440 JSR GET16BIT 29450 LDY ACC ;is ACC PP? 29460 CPY #PP 29470 * BUG FIX: ABOVE LINE SHOULD BE 29480 * CPY PP 29490 * REF: NONE. FOUND BY INSPECTION. 29500 LDA ACC+1 29510 SBC PP+1 29520 HF0D4 29530 BCS HF07C ;=HS> yes, MEM FULL error 29540 STY LOMEM ;LOMEM := ACC 29550 LDA ACC+1 29560 STA LOMEM+1 29570 JMP CLR 29580 *> 29590 29600 * tkn $04 LOAD 29610 29620 LOAD ;VO 29630 STX XSAVE 29640 JSR SETHDR 29650 JSR READ 29660 LDX #$FF 29670 SEC 29680 *!LOOP 29690 LDA HIMEM+1,X ;AUX := HIMEM-ACC 29700 SBC ACC+1,X 29710 STA AUX+1,X 29720 INX 29730 *!UNTIL 29740 BCC HF07C ;=LO>MEM FULL error 29750 CMPW PV;AUX 29760 BCS HF0D4 ;=>PV AUX, MEM FULL error 29770 LDA ACC ;is ACC zero? 29780 *!IF 29790 LDA ACC+1 29800 BEQ HF118 ;=>yes 29810 *!ENDIF 29820 MOVW AUX;PP 29830 JSR SETPRG 29840 JSR READ 29850 HF115 ;solo 29860 LDX XSAVE 29870 RTS 29880 ** 29890 29900 HF118 ;solo 29910 JSR BELL 29920 JMP HF115 29930 *> 29940 29950 SETHDR 29960 LDY #$CE 29970 STY A1 ;A1 := $00CE 29980 INY 29990 STY A2 ;A2 := $00CD 30000 LDY #0 30010 STY A1+1 30020 STY A2+1 30030 RTS 30040 ** 30050 30060 SETPRG 30070 *!LOOP 30080 LDA PP,X 30090 STA A1,X 30100 LDY HIMEM,X 30110 STY A2,X 30120 DEX 30130 *!UNTIL 30140 DECW A2 30150 RTS 30160 ** 30170 30180 STX XSAVE ;Z 30190 30200 * tkn $05 SAVE 30210 30220 SAVE ;VO 30230 SEC ;ACC := HIMEM-PP 30240 LDX #0-1 30250 *!LOOP 30260 LDA HIMEM+1,X 30270 SBC PP+1,X 30280 STA ACC+1,X 30290 INX 30300 *!UNTIL 30310 JSR SETHDR 30320 JSR WRITE 30330 LDX #$01 30340 JSR SETPRG 30350 LDA #$1A 30360 JSR WRITE0 30370 LDX XSAVE 30380 RTS 30390 ** 30400 30410 PRTERR 30420 JSR ERRORMESS 30430 JMP BELL 30440 *> 30450 30460 * tkn $77 POP 30470 30480 POP ;VO 30490 LDA GOSUBNDX 30500 *!IF 30510 JMP RETURN ;force error 30520 *!ENDIF 30530 DEC GOSUBNDX 30540 RTS 30550 ** 30560 30570 * tkn $7D TRACE 30580 30590 TRACE ;VO 30600 LDA #$FF 30610 STA NOUNSTKC 30620 RTS 30630 ** 30640 30650 * tkn $7A NOTRACE 30660 30670 NOTRACE ;VO 30680 LSR NOUNSTKC ;clear bit 7 30690 RTS 30700 ** 30710 30720 HF179 ;solo 30730 BIT NOUNSTKC ;trace mode? 30740 *!IF 30750 HF17D 30760 *yes, print line number 30770 LDA #"#" 30780 JSR COUT 30790 LDY #1 30800 LDA (PR),Y 30810 TAX 30820 INY 30830 LDA (PR),Y 30840 JSR PRDEC 30850 LDA #BLANK+$80 30860 JMP COUT 30870 *> 30880 LDA PR ;Z 30890 LDY PR+1 ;Z 30900 *!ENDIF 30910 RTS 30920 ** 30930 30940 30950 30960 SYNTABLNDX ;indices into SYNTABL 30970 DB $C1,$00,$7F,$D1,$CC,$C7,$CF,$CE 30980 DB $C5,$9A,$98,$8D,$96,$95,$93,$BF 30990 DB $B2,$32,$12,$0F,$BC,$B0,$AC,$BE 31000 DB $35,$0C,$61,$30,$10,$0B,$DD,$FB 31010 31020 31030 31040 HF1B7 ;solo 31050 LDY #0 31060 JSR HE7C7 31070 LDA #BLANK+$80 31080 JMP COUT 31090 *> 31100 31110 DB $00,$00,$00,$00,$00,$00,$00,$00 ;Z 31120 31130 HF1C9 31140 LDY LOMEM 31150 LDA LOMEM+1 31160 *!LOOP 31170 PHA 31180 CPY AUX ;is LOMEM AUX? 31190 SBC AUX+1 31200 BCS HF1F0 ;=HS> yes, exit repeat 31210 PLA 31220 STY SRCH ;SRCH := LOMEM 31230 STA SRCH+1 31240 LDY #$FF 31250 *! LOOP 31260 *! LOOP 31270 INY 31280 LDA (SRCH),Y 31290 *! UNTIL 31300 CMP #$40 31310 *! UNTIL 31320 INY 31330 INY 31340 LDA (SRCH),Y 31350 PHA 31360 DEY 31370 LDA (SRCH),Y 31380 TAY 31390 PLA 31400 *!UNTIL 31410 HF1F0 31420 PLA 31430 LDY #0 31440 *!LOOP 31450 LDA (SRCH),Y 31460 BMI HF1FC ;=> 31470 LSR 31480 BEQ HF202 ;=> 31490 LDA #"$" 31500 HF1FC 31510 JSR COUT 31520 INY 31530 *!UNTIL 31540 HF202 31550 LDA #"=" 31560 JMP COUT 31570 *> 31580 31590 HF207 ;solo 31600 STA (AUX),Y 31610 INX 31620 LDA NOUNSTKC-1,X 31630 BEQ HF23E ;=>RTS 31640 JMP HF3D5 31650 *> 31660 31670 DB $A0 ;Z 31680 31690 HF212 ;solo 31700 *!IF 31710 LDA PR 31720 LDY PR+1 31730 JSR HF17D 31740 *!ENDIF 31750 JSR HF1C9 31760 LDX XSAVE 31770 JMP HF1B7 31780 *> 31790 31800 HF223 ;solo 31810 INX 31820 INX 31830 LDA NOUNSTKC-1,X 31840 BEQ HF248 ;=>RTS 31850 JMP HF3E0 31860 *> 31870 31880 HF22C ;solo 31890 *!IF 31900 LDA PR 31910 LDY PR+1 31920 JSR HF17D 31930 *!ENDIF 31940 JSR HF1C9 31950 LDX XSAVE 31960 JMP HF409 31970 *> 31980 31990 INX ;Z 32000 HF23E 32010 RTS 32020 ** 32030 32040 HF23F ;solo 32050 JSR GET16BIT 32060 INCW ACC 32070 HF248 32080 RTS 32090 ** 32100 32110 * tkn $1C < 32120 * IF X < 13 THEN END 32130 32140 HF249 ;V 32150 JSR HF25B 32160 BNE HF263 ;=>NOT 32170 32180 * tkn $19 > 32190 * IF X > 13 THEN END 32200 32210 HF24E ;VO 32220 JSR HF253 32230 BNE HF263 ;=>NOT 32240 32250 * tkn $1A <= 32260 * IF X <= 13 THEN END 32270 32280 HF253 ;V 32290 JSR SUBTRACT 32300 JSR NEGATE 32310 BVC HF25E ;=> 32320 32330 * tkn $18 >= 32340 * IF X >= 13 THEN END 32350 32360 HF25B ;V 32370 JSR SUBTRACT 32380 HF25E 32390 JSR SGN 32400 LSR NOUNSTKL,X 32410 HF263 32420 JMP NOT 32430 *> 32440 32450 * tkn $1D AND 32460 32470 VAND ;VO 32480 JSR HEFC9 32490 ORA NOUNSTKL-1,X 32500 BPL HF272 ;=>always? 32510 32520 * tkn $1E OR 32530 32540 VOR ;VO 32550 JSR HEFC9 32560 AND NOUNSTKL-1,X 32570 HF272 ;solo 32580 STA NOUNSTKL,X 32590 BPL HF263 ;=>NOT 32600 JMP HEFC9 32610 *> 32620 32630 * tkn $58 STEP 32640 32650 STEP ;VO 32660 JSR GET16BIT 32670 LDY FORNDX 32680 LDA ACC 32690 STA STK_60-1,Y 32700 LDA ACC+1 32710 JMP HE966 32720 *> 32730 32740 HF288 ;solo 32750 STA STK_50,Y 32760 *!LOOP 32770 *! LOOP 32780 DEY 32790 BMI HF2DF ;=>RTS 32800 LDA STK_40,Y 32810 CMP NOUNSTKL,X 32820 *! UNTIL 32830 LDA STK_50,Y 32840 CMP NOUNSTKH,X 32850 *!UNTIL 32860 DEC FORNDX 32870 *!LOOP 32880 LDA STK_40+1,Y 32890 STA STK_40,Y 32900 LDA STK_50+1,Y 32910 STA STK_50,Y 32920 LDA STK_C0+1,Y 32930 STA STK_C0,Y 32940 LDA STK_D0+1,Y 32950 STA STK_D0,Y 32960 LDA STK_60+1,Y 32970 STA STK_60,Y 32980 LDA STK_70+1,Y 32990 STA STK_70,Y 33000 LDA STK_80+1,Y 33010 STA STK_80,Y 33020 LDA STK_90+1,Y 33030 STA STK_90,Y 33040 LDA STK_A0+1,Y 33050 STA STK_A0,Y 33060 LDA STK_A0+1,Y 33070 STA STK_A0,Y 33080 * BUG FIX: ABOVE TWO LINES SHOULD BE 33090 * LDA STK_B0+1,Y 33100 * STA STK_B0,Y 33110 * REF: CHANGED IN DISK VERSION 33120 INY 33130 CPY FORNDX 33140 *!UNTIL 33150 HF2DF 33160 RTS 33170 ** 33180 33190 * tkn $78 NODSP 33200 * string var 33210 33220 NODSP_STR ;VO 33230 INX 33240 33250 * tkn $79 NODSP 33260 * num var 33270 33280 NODSP_NUM ;VO 33290 LDA #0 33300 HF2E3 33310 PHA 33320 LDA NOUNSTKL,X 33330 SEC 33340 SBC #$03 33350 STA ACC 33360 LDA NOUNSTKH,X 33370 SBC #0 33380 STA ACC+1 33390 PLA 33400 LDY #0 33410 STA (ACC),Y 33420 INX 33430 RTS 33440 ** 33450 33460 HF2F8 ;solo 33470 CMP #$85 33480 *!IF 33490 JMP HE4C0 33500 *!ENDIF 33510 LDY #$02 33520 JMP HE448 33530 *> 33540 33550 * tkn $7B DSP 33560 * string var 33570 33580 DSP_NUM ;VO 33590 INX 33600 33610 * tkn $7C DSP 33620 * num var 33630 33640 DSP_STR ;VO 33650 LDA #$01 33660 BNE HF2E3 ;=>always 33670 33680 INX ;Z 33690 33700 * tkn $06 CON 33710 33720 CON ;VO 33730 MOVW NOUNSTKH;PR 33740 LDA NOUNSTKL 33750 LDY NOUNSTKL+1 33760 JMP GETNEXT 33770 *> 33780 33790 LDA #$01 ;Z 33800 BNE HF2E3 ;=>always 33810 33820 * tkn $3C ASC( 33830 33840 ASC ;VO 33850 LDA NOUNSTKL,X 33860 CMP NOUNSTKH,X 33870 *!IF 33880 JMP RANGERR 33890 *!ENDIF 33900 TAY 33910 LDA NOUNSTKL+1,X 33920 STA ACC 33930 LDA NOUNSTKH+1,X 33940 STA ACC+1 33950 LDA (ACC),Y 33960 LDY #0 33970 INX 33980 INX 33990 JSR HE708 34000 JMP HF404 34010 *> 34020 34030 * tkn $32 PDL 34040 34050 PDL ;VO 34060 JSR GETBYTE 34070 STX XSAVE 34080 AND #$03 34090 TAX 34100 JSR PREAD 34110 LDX XSAVE 34120 TYA 34130 LDY #0 34140 JSR HE708 34150 STY NOUNSTKC,X 34160 RTS 34170 ** 34180 34190 RDKEY ;solo 34200 JSR NXTCHAR 34210 HF354 ;solo 34220 TXA 34230 PHA 34240 *!LOOP 34250 LDA IN,X 34260 CMP #ETX+$80 ;is it ctrl-C? 34270 *! IF 34280 JMP BASIC2 34290 *! ENDIF 34300 DEX 34310 *!UNTIL 34320 PLA 34330 TAX 34340 RTS 34350 ** 34360 34370 HF366 ;solo 34380 JSR HE280 34390 TYA 34400 TAX 34410 JSR HF354 34420 TXA 34430 TAY 34440 RTS 34450 ** 34460 34470 * tkn $20 ^ 34480 34490 EXP ;VO 34500 JSR GET16BIT 34510 LDA ACC+1 34520 *!IF 34530 TYA ;Areg := 0 34540 DEX 34550 JSR HE708 34560 STY NOUNSTKC,X 34570 HF37F 34580 RTS 34590 *!ENDIF 34600 STA SRCH+1 ;SRCH := ACC 34610 LDA ACC 34620 STA SRCH 34630 JSR GET16BIT 34640 MOVW ACC;SRCH2 34650 LDA #$01 34660 JSR HE708 34670 STY NOUNSTKC,X 34680 HF398 ;*!LOOP 34690 LDA SRCH ;SRCH := SRCH-1 34700 *!IF 34710 DEC SRCH+1 ;is SRCH negative? 34720 BMI HF37F ;=>yes, RTS 34730 *!ENDIF 34740 DEC SRCH 34750 LDA SRCH2 34760 LDY #0 34770 JSR HE708 34780 LDA SRCH2+1 34790 STA NOUNSTKC,X 34800 JSR MULT 34810 JMP HF398 ;*!loop forever 34820 *> 34830 34840 HF3B3 ;solo 34850 JSR GETBYTE 34860 CLC ;Areg := Areg-1 34870 ADC #$FF 34880 HF3B9 34890 RTS 34900 ** 34910 34920 * tkn $4A , 34930 * end of PRINT statement 34940 * PRINT A$, 34950 34960 HF3BA ;VO 34970 JSR HE7B1 34980 LSR CRFLAG ;pos 34990 RTS 35000 ** 35010 35020 STX RUNFLAG ;Z 35030 TXS 35040 JSR HF02E 35050 JMP HE883 35060 *> 35070 35080 * tkn $7E PR# 35090 35100 PRSLOT ;VO 35110 JSR GETBYTE 35120 STX XSAVE 35130 JSR OUTPORT 35140 LDX XSAVE 35150 RTS 35160 ** 35170 35180 DB $FE ;Z 35190 35200 HF3D5 ;solo 35210 BIT RUNFLAG 35220 BPL HF3B9 ;=>RTS 35230 STX XSAVE 35240 BIT NOUNSTKC 35250 JMP HF212 35260 *> 35270 35280 HF3E0 ;solo 35290 BIT RUNFLAG 35300 BPL HF3B9 ;=>RTS 35310 STX XSAVE 35320 BIT NOUNSTKC 35330 JMP HF22C 35340 *> 35350 35360 HF3EB ;solo 35370 LDY #0 35380 JMP GETVERB 35390 *> 35400 35410 *!LOOP 35420 TAY 35430 JSR CROUT 35440 HF3F4 ;solo 35450 TYA 35460 SEC 35470 SBC WNDWDTH 35480 *!UNTIL 35490 STY CH 35500 RTS 35510 ** 35520 35530 DB $00,$00,$00 ;Z 35540 DB $FF,$FF,$FF,$FF ;Z 35550 35560 HF404 ;solo 35570 STY NOUNSTKC,X 35580 JMP HE823 35590 *> 35600 35610 HF409 ;solo 35620 LDY #0 35630 BEQ HF411 ;=>always 35640 *!LOOP 35650 JSR COUT 35660 INY 35670 HF411 35680 LDA (AUX),Y 35690 *!UNTIL 35700 LDA #$FF 35710 STA CRFLAG ;CRFLAG := $FF 35720 RTS 35730 ** 35740 35750 * tkn $7F IN# 35760 35770 INSLOT ;VO 35780 JSR GETBYTE 35790 STX XSAVE 35800 JSR INPORT 35810 LDX XSAVE 35820 RTS 35830 ** 35840 LST OFF