Below is pretty much all the Integer BASIC information I have. Paul R. Santa-Maria Ann Arbor, Michigan USA paulrsm@ameritech.net The first section is from BYTE magazine where Woz described the Apple II. The second is from www.woz.org, where Woz has a section where he responds to e-mail; some of the questions asked about Integer BASIC. The third section is my disassembly of Integer BASIC. Apple BASIC (BYTE 1977:5 p34) Apple-II BASIC is implemented as a translator-interpreter combination. When a line is read from the input device, the translator analyzes it and generates a more efficient internal language facsimile. Syntax errors are detected at this time. The "nouns" of this internal language are variable names, integer constants (preconverted to binary for execution speed enhancement), and string constants. The "verbs" are 1 byte tokens substituted for keywords, operators and delimiters. Because the translator distinguishes syntax, different verbs are assigned to different usages of the same symbol. For example, three distinct verbs represent the word PRINT, depending on whether it is immediately followed by a string stource, an arithmetic expression or nothing. Thus this distinction need not be made at execution time. For each verb there exists a subroutine to perform that specific action. Listing a program actually involves decompiling the internal language back to BASIC source code. Those statements with line numbers are stored as part of the user program, while those without line numbers are executed immediately. If desired, the Apple BASIC interpreter's editing functions can be set to generate line numbers automatically. Although some commands are valid only for immediate execution and others only for programmed execution, most can be employed in both ways. In the BASIC source programs, multiple statements may reside on the same line, separated by colons (':'). BASIC language statements are stored in user memory as they are accepted and variables are allocated space the first time they are encountered during immediate or programmed execution. When a program terminates, whether by completion, interruption or error conditions, all variables are preserved. Programs may be interrupted in execution by typing an ASCII control C; it is then possible to examine and modify a few variables in immediate mode, then continue execution at the point of interruption by typing the CONtinue command. BASIC provides the line number of the statement as the point of interruption when this sequence is used. The entire variable space is cleared to zero when BASIC is initialized by the CLR command, and prior to executing the RUN command. (It is possible to carry variables from one program to another, but to initiate the second program a GOTO command must be used instead of RUN in order to override the automatic clear at the beginning of execution of a new program.) The interpreter consists of a standard expression evaluator and a symbol table routine for allocating variable storage similar to those described by Prof Maurer in his 2 part series in the February and March 1976 issues of BYTE. As statements are scanned, nouns and verbs are encountered. Variable names result in calls to the symbol table routine which pushes address and length information on the noun stack (operand stack). Constants are pushed directly onto this stack. Verbs are pushed onto the verb stack (operator stack) after popping and executing any verbs of greater priority. A verb is executed by calling its associated subroutine. Tables define priorities and routine entry addresses for all verbs. Keywords such as THEN or STEP, and delimiters such as commas and parentheses, are dealt with just as though they were arithmetic operators. Verb routines obtain their arguments from the noun stack. Because verbs such as parentheses tend sometimes to be of low, and other times of high prioritiy, each verb is actually assigned two priorities (left hand-right hand). One represents its tendency to force execution of other verbs, the second its tendency to be executed. www.woz.org: Woz: My own BASIC was the hardest task of developing the Apple I and ][ computers. I'd never studied compiler/interpreter writing and had only practiced my ideas on paper before. I'd read some good books on the subject. I'd never programmed in BASIC before the Apple I. I just sniffed the air and decided that the games that would drive personal computers were written in BASIC. I picked up a manual at Hewlett Packard and used their variant of BASIC as my model. Either they had good substring syntax or I evolved my own based on theirs, but I much preferred it to the DEC style that Microsoft went with, using LEFT$ and MID$ and RIGHT$ functions. I laid out my syntax charts and made a decision to take floating point out so that I could finish slightly sooner and have the first BASIC for the 6502 processor ever. I mainly wanted it to be able to play games. Then I knew it was good enough for whatever else. I also wanted to program solutions to my Hewlett Packard engineering problems. That's where I worked as an engineer designing calculators. I could go on. The BASIC turned out extremely modular, so I could easily add something by adding some syntax descriptions in near-text form, and write routines for the new functions or ops that were needed. The language didn't have to be rewritten. Woz: I wrote the original Apple Integer BASIC. I had wanted it to be the very first BASIC for the 6502 microprocessor. I might then have something to be recognized for. I decided that it had to play games and let me solve engineering problems. I first wrote out a syntax with floating point but then figured that it might be done a few weeks sooner with just integers. I had to write it in the evenings as I worked at Hewlett Packard then. So I cut back to an integer BASIC that I called "Game BASIC". I'd never programmed in BASIC. My college had encountered Fortran, several machine languages, Algol, and a couple of special languages. But you could buy a book called "101 BASIC Games". Plus, the Gates/Allen BASIC was becoming the standard thing to get for your Altair computer, although very few people had these computers yet. I'd never writting a computer language or taken a course in it, although I'd studied books on my own touching on the topic. I have no idea to this day if I wrote it as anyone else would. I broke the entire language down into a syntax table that was stored in memory, in modified text form. A word like "PRINT" was stored as the 5 letters. If you were allowed an unsigned expression after some word, I stored a pointer to the syntax of that type of expression, which specified what it could be made of. Each line was compared, letter by letter, through this syntax table to see if there was any valid BASIC statement. I gave each symbol in the syntax table a particular code as on operator. The word "PRINT" might be operator number 5 and "FOR" might be operator number 13, etc. A plus sign had it's code too. A symbol like a minus sign might have two different codes depending on whether it was prefix (like -5) or infix (like 9-6). A variable or a number was an operand. I pushed the operand references onto one stack and operator codes onto another. But the operator codes each had 2 different priorities telling my BASIC whether to push them on top of the topmost operator already on the stack, or to pop that one off and generate the output program from it. Each operator had a value for it's tendency to push others off, and a value for it's resistance to being pushed off. For example, plus tends to push divide off, causing the division to happen first. Strangely all this works. Then I had to write one short routine for each of perhaps 100 operators. These included keywords like "PRINT", mathematical operators like 'plus', parenthesis, and other grammar symbols of BASIC. It took a couple of months to get the BASIC to this shape, with an engine that ran the whole thing. Then I would define a Syntax sentence in the syntax table, along with any routines for any new operator symbols. I would test it, get it working, and move on to the next syntax sentence for the next BASIC statement. From this point on, things were very modular and I was only writing very short programs. Well, the BASIC was a very big success. Especially when I was able to easily add statements and corresponding routines for color graphics and game commands in the Apple ][. Woz: I wrote it all in machine language without an assembler. It was the only way that I could afford. I looked at the sort of software that I wanted - games and puzzle solvers and logic simulators. Floating point wasn't the way to go here. My first syntax table was for floating point but I saw that I could make the language faster and tighter, and I could complete it perhaps a couple of weeks sooner, if I went integer only, so I backed off. Just because of this I did include some floating point routines in the Apple ][ ROM. Anyway, I used a condensed syntax chart to scan lines that were typed in, to allocate tokens corresponding the syntax elements of a good statement. The interpreted collection of tokens would be executed from left to right, with a couple of tables holding 'push' and 'pull' priorities for each token (operators, parens, etc.). Numbers and variable names weren't tokenized. This way I could just add commands or other items to a near-ASCII syntax table and then write small routines for each new token added. It was a very efficient approach that broke up a large task in a very orderly way. I'd never studied compiler writing. I'd just worked out ideas on my own back in college days. I had read some papers and books on it, but never wrote one before or did any homework or other exercises in this regard. I feel very lucky that I was able to do it. For me it was a larger task by far than both the Apple I and Apple ][ combined. The original version of this BASIC is in a binder in my own handwriting. 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