Integer BASIC
Paul R. Santa-Maria
Has anyone here disassembled Woz's Integer BASIC? I have, but there is
still a lot I do not understand and I would like to discuss it.
--
Paul R. Santa-Maria
Ann Arbor, Michigan USA
pau...@ameritech.net
Phoenyx
a while back looking at it through the monitor. I once thought of
trying to interface it with Prodos since it's so quick.
Quite a few useful games could run in an integer system.
--
Cheers and best wishes,
Phoenyx
Have you fed your Apple today?
Phoenyx's Pages are back online...
It seems the ZIP.TO link was down for a while.
It is now working again. This is the preferred
link to my site. You may also use the direct link.
http://zip.to/Phoenyx_A2
http://www.tinyangeldesigns.com/Apple2
Chippy
<qua...@dcnet2000.com> wrote:
> Well, I never disassembled all of it, but I did spend some time
> a while back looking at it through the monitor. I once thought of
> trying to interface it with Prodos since it's so quick.
>
> Quite a few useful games could run in an integer system.
Is this, by any chance the same Integer Basic that the Byte Works is selling
a demonstration compiler for?
--
---
Eric <chi...@earthlink.net>
Phoenyx
No, this is the original BASIC interpreter coded by Woz for the
original Apple II. Actually it's an interesting program language.
Considering the (small) size and the fact it was hand coded in the
era before floppy drives it really turned out quite well.
There may be some general similarities but DOS 3.x integer basic
is strictly an interpreter whereas the Byteworks program is a GS
integer basic compiler developed completely by Byteworks.
There were compilers for it many years ago, but most were pretty
expensive. I used to have this cool book of Apple II software. It
must have listed practically every program known at the time. The
thing was 3 inches thick and divided into categories.
I also remember playing a hires 'Gin Rummy' game that was
programmed in Integer Basic. My wife and I played this game quite
a lot until I (accidentally) figured how to cheat and it took the
fun out of it.
Mike Westerfield
----------
In article <tA7H4.1293$p4.3...@newsread2.prod.itd.earthlink.net>, "Chippy"
<chi...@earthlink.net> wrote:
>> Well, I never disassembled all of it, but I did spend some time
>> a while back looking at it through the monitor. I once thought of
>> trying to interface it with Prodos since it's so quick.
>>
>> Quite a few useful games could run in an integer system.
>
>
> Is this, by any chance the same Integer Basic that the Byte Works is selling
> a demonstration compiler for?
Well, sort of. :)
The languages, barring bugs or misinterpretations on my part, are the same.
The fact that one is interpreted and one compiled just means one runs faster
than the other. :)
The major problem with porting Integer BASIC programs from the original 8
bit version to the compiled version is that very few Integer BASIC programs
are really Integer BASIC--most use PEEKs and POKEs or CALLs to deal with
machine language or 8-bit only RAM or memory mapped I/O locations. Those
need to be ported by hand. If the program is 100% pure Integer BASIC,
though, it ought to work under either system.
Mike Westerfield
Phoenyx
> Has anyone here disassembled Woz's Integer BASIC? I have, but
> there is still a lot I do not understand and I would like to
> discuss it.
I wanted to re-open this thread to learn more about your discoveries
or perhaps questions you have.
My first question, have you disassembled it to text files?
This would be the first logical step. From here, you can search and
replace the known ROM addresses if any that are used.
Paul R. Santa-Maria
Below is pretty much all the Integer BASIC information I have.
Paul R. Santa-Maria
Ann Arbor, Michigan USA
pau...@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.
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 <EQ>
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 <HS> 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 <EQ>
2600 JSR HE011
2610 *! ENDIF
2620 TXA
2630 *! LOOP
2640 JSR COUT
2650 HE099
2660 LDA #$25
2670 JSR HE01A
2680 TAX
2690 *! UNTIL <PL>
2700 STA P2
2710 HE0A3
2720 CMP #$01
2730 *! IF <EQ>
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 <HS>
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 <MI>
2950 CPX #$C0
2960 *! WHILE <LO>
2970 CPX #0
2980 *! UNTIL <PL>
2990 TAX
3000 PLA
3010 SBC #1 ;carry is set
3020 *! UNTIL <EQ>
3030 BIT P2
3040 *! IF <PL>
3050 JSR HEFF8
3060 *! ENDIF
3070 *! LOOP
3080 LDA (ACC),Y
3090 *! WHILE <MI>
3100 TAX
3110 AND #$3F
3120 STA P2
3130 CLC
3140 ADC #BLANK+$80
3150 JSR COUT
3160 DEY
3170 CPX #$C0
3180 *! UNTIL <HS>
3190 JSR HE00C
3200 PLA
3210 CMP #$5D ;93 ]
3220 BEQ HE099 ;=>
3230 CMP #$28 ;40 (
3240 *!UNTIL <EQ>
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 <NE>
4190 *!LOOP
4200 PLA
4210 STA (AUX),Y
4220 STA PV,Y
4230 DEY
4240 *!UNTIL <MI>
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 <LO>
4660 INC NOUNSTKL-2,X
4670 TAY
4680 LDA (ACC),Y
4690 LDY NOUNSTKL,X
4700 CPY P2
4710 *! IF <HS>
4720 LDY #ErrMsg18 ;"STR OVFL"
4730 BNE HE16F ;=>always
4740 *! ENDIF
4750 STA (AUX),Y
4760 INC NOUNSTKL,X
4770 *!UNTIL <CS>
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 <HS>
5310 PLA
5320 PLP
5330 *! IF <CC>
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 <LO>
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 <CS>
5740 ADDW P3;AUX;P3
5750 *! ENDIF
5760 DEY
5770 BEQ HE244 ;=>EXIT LOOP
5780 ASL P3
5790 ROL P3+1
5800 *!UNTIL <MI>
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 <MI>
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 <CS>
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 <MI>
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 <NE>
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 <EQ>
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 <LT> 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 <LO>
7370 *!LOOP
7380 LDA P2,X
7390 STA PP,X
7400 DEX
7410 *!UNTIL <MI>
7420 LDA (PX),Y
7430 TAY
7440 *!LOOP
7450 DEY
7460 LDA (PX),Y
7470 STA (P3),Y
7480 TYA
7490 *!UNTIL <EQ>
7500 BIT AUTOFLAG ;auto line?
7510 *!IF <MI>
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 <NE>
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: P3<PP.P2 backwards
7880 *!LOOP
7890 CMPW PP;P2
7900 BCS HE3B7 ;=>PP <HS> P2
7910 DECW P2
7920 DECW P3
7930 LDA (P2),Y
7940 STA (P3),Y
7950 *!UNTIL <HS>
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 <PL>
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 <PL>
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 <PL>
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 <HS>
8660 INX
8670 *! ENDIF
8680 INY
8690 *!UNTIL <EQ>
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 <LO>
8930 LDA (SYNPAG),Y
8940 AND #$3F
8950 LSR
8960 BNE HE3ED ;=>
8970 LDA IN,X
8980 *!IF <CC>
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 <MI>
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 <MI>
9320 HE470
9330 BEQ HE425 ;=>RTS
9340 CMP #$7E
9350 BCS HE498 ;=HS>
9360 DEX
9370 *!IF <MI>
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 <EQ>
9620 INY
9630 *!ENDIF
9640 INY
9650 HE49C
9660 STX SYNSTKDX
9670 LDA (SYNPAG),Y
9680 BMI HE426 ;=>
9690 *!IF <EQ>
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 <EQ>
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 <EQ>
10330 STA PCON
10340 STX PCON+1
10350 CPY TOKNDX
10360 *! UNTIL <EQ>
10370 LDY LEADBL
10380 INY
10390 STY TOKNDX
10400 JSR HE41C
10410 PLA
10420 TAY
10430 LDA PCON+1
10440 *!UNTIL <CC>
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 <HS>
10730 STA PCON+1
10740 LDA PCON
10750 SBC NUMLOW,X
10760 STA PCON
10770 INC CHAR
10780 *! UNTIL <EQ>
10790 *GETDIG
10800 LDA CHAR
10810 INX
10820 DEX
10830 BEQ PRDEC5 ;=>
10840 CMP #"0"
10850 *! IF <NE>
10860 STA LEADBL
10870 *! ENDIF
10880 * if LEADBL is <MI> or LEADZR <NE> #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 <MI>
10980 STA IN,Y
10990 INY
11000 *! ENDIF
11010 PRDEC6 ;NXTX
11020 DEX
11030 *!UNTIL <MI>
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 <HS> HIMEM?
11340 LDA P2+1
11350 SBC HIMEM+1
11360 *!WHILE <LO>
11370 LDY #1
11380 LDA (P2),Y
11390 SBC ACC
11400 INY
11410 LDA (P2),Y
11420 SBC ACC+1
11430 *!WHILE <LO>
11440 LDY #0
11450 LDA P3 ;P3 := P3.W + (P2).B
11460 ADC (P2),Y
11470 STA P3
11480 *! IF <CS>
11490 INC P3+1
11500 CLC
11510 *! ENDIF
11520 INY
11530 LDA ACC :is ACC+1 <HS> (P2),Y ?
11540 SBC (P2),Y
11550 INY
11560 LDA ACC+1
11570 SBC (P2),Y
11580 *!UNTIL <LO>
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 <PL>
11970 CMP #$40
11980 BNE HE646 ;=>EXIT LOOP
11990 STA XSAVE
12000 *! ENDIF
12010 CMP (SRCH),Y
12020 *! UNTIL <NE>
12030 *! LOOP
12040 LDA (SRCH),Y
12050 HE5E6
12060 INY
12070 LSR
12080 *! UNTIL <EQ>
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 <EQ>
12200 CPY PV+1
12210 *!UNTIL <EQ>
12220 LDY #0
12230 *!LOOP
12240 *! LOOP
12250 INY
12260 LDA (PX),Y
12270 *! UNTIL <PL>
12280 EOR #$40
12290 *!UNTIL <NE>
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 <EQ>
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 <EQ>
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 <EQ>
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 <MI>
13260 DEX
13270 *! ENDIF
13280 HE69B
13290 JSR GETVERB
13300 *!UNTIL <CC>
13310 HE6A0
13320 CMP #$28
13330 *!IF <EQ>
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 <PL>
13490 BCS HE696 ;=>
13500 *!ENDIF
13510 BIT IFFLAG
13520 *!IF <MI>
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 <LO>
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 <PL>
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 <NE>
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 <EQ>
14540 CMP ACC+1
14550 *! IF <EQ>
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 <EQ>
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 <EQ>
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 <MI>
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 <NE>
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 <CS>
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 <CS>
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 <CS>
18150 INY
18160 *! ENDIF
18170 HE896
18180 CMP HIMEM
18190 *! UNTIL <EQ>
18200 CPY HIMEM+1
18210 *!UNTIL <EQ>
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 <EQ>
18820 LDA NOUNSTKH,X
18830 CMP STK_50-1,Y
18840 *!UNTIL <EQ>
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 <NE>
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
19980 DB <LOAD,<SAVE,<CON,<RUNNUM
19990 DB <RUN,<DEL,<COMMA_DEL,<NEW
20000 DB <CLR,<AUTO,<COMMA_AUTO,<MAN
20010 DB <VHIMEM,<VLOMEM,<ADDITION,<SUBTRACT
20020 DB <MULT,<DIVIDE,<HE733,<HE74A
20030 DB <HF25B,<HF24E,<HF253,<HE74A
20040 DB <HF249,<VAND,<VOR,<MOD
20050 DB <EXP,<$FFFF,<HE823,<COMMA_SUBSTR
20060 DB <GOTO,<LET,<HEFB6,<HEBCB
20070 DB <$FFFF,<$FFFF,<PAREN_SUBSTR,<$FFFF
20080 DB <$FFFF,<HEF24,<PEEK,<RND
20090 DB <SGN,<ABS,<PDL,<$FFFF
20100 DB <HE823,<POSITIVE,<NEGATE,<NOT
20110 DB <HE823,<HE1D7,<HE21C,<LEN
20120 DB <ASC,<SCRN,<COMMA_SCRN,<HE823
20130 DB <$FFFF,<$FFFF,<HE121,<DIMSTR
20140 DB <DIMNUM,<PRNTSTR,<PRNTNUM,<HE820
20150 DB <HEE00,<HE7C1,<HF3BA,<SETTXT
20160 DB <SETGR,<CALL,<DIMSTR,<DIMNUM
20170 DB <TAB,<END,<HEFB6,<INPUT_PROMPT
20180 DB <HEBAA,<FOR,<HE801,<TO
20190 DB <STEP,<NEXT,<NEXT,<RETURN
20200 DB <GOSUB,<$FFFF,<LET,<GOTO
20210 DB <IF,<PRNTSTR,<PRNTNUM,<PRINT_CR
20220 DB <POKE,<GETVAL255,<COLOR,<GETVAL255
20230 DB <COMMA_PLOT,<GETVAL255,<COMMA_HLIN,<AT_HLIN
20240 DB <GETVAL255,<COMMA_VLIN,<AT_VLIN,<IVTAB
20250 DB <HE18C,<HE801,<RIGHT_PAREN,<$FFFF
20260 DB <LISTNUM,<COMMA_LIST,<LIST,<POP
20270 DB <NODSP_STR,<NODSP_NUM,<NOTRACE,<DSP_NUM
20280 DB <DSP_STR,<TRACE,<PRSLOT,<INSLOT
20290
20300 VERBADRH
20310 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 <CS>
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 <LO>
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 <EQ>
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 <EQ>
24790 LDA AUX+1
24800 *! IF <EQ>
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 <HS>
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 <EQ>
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 <PL>
25750 BCS HEECB ;=>"RANGE" error
25760 *!IF <EQ>
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 <CC>
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 <EQ>
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 <EQ>
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 <LO> 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 <HS> 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 <EQ>
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 <EQ>
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 <EQ>
28320 EOR #$FF
28330 STA (HIMEM),Y
28340 CMP (HIMEM),Y
28350 *!UNTIL <NE>
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 <EQ>
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 <NE>
28950 *!IF <HS>
28960 CMPW PV;P2
28970 BCC HF08F ;=>PV <LO> 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 <HS>
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 <EQ>
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 <LO> HIMEM?
29360 LDA HIMEM+1
29370 SBC PP+1
29380 *!UNTIL <HS>
29390 BCS HF099 ;=HS> always
29400
29410 * tkn $11 LOMEM:
29420
29430 VLOMEM ;VO
29440 JSR GET16BIT
29450 LDY ACC ;is ACC <HS> 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 <NE>
29740 BCC HF07C ;=LO>MEM FULL error
29750 CMPW PV;AUX
29760 BCS HF0D4 ;=>PV <HS> AUX, MEM FULL error
29770 LDA ACC ;is ACC zero?
29780 *!IF <EQ>
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 <MI>
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 <NE>
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 <EQ>
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 <MI>
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 <HS> 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 <PL>
31300 CMP #$40
31310 *! UNTIL <NE>
31320 INY
31330 INY
31340 LDA (SRCH),Y
31350 PHA
31360 DEY
31370 LDA (SRCH),Y
31380 TAY
31390 PLA
31400 *!UNTIL <EQ>
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 <EQ>
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 <PL>
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 <PL>
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 <EQ>
32830 LDA STK_50,Y
32840 CMP NOUNSTKH,X
32850 *!UNTIL <EQ>
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 <HS>
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 <LO>
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 <HS>
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 <EQ>
34280 JMP BASIC2
34290 *! ENDIF
34300 DEX
34310 *!UNTIL <MI>
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 <MI>
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 <EQ>
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 <LO>
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 <PL>
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
Phoenyx
Almost missed this. I've been on and off the news groups due to medical
tests and such.