From 745c9be6c3df568ceb1fcfc730e3efa905d52afb Mon Sep 17 00:00:00 2001 From: Daniel Serpell Date: Wed, 18 Oct 2017 12:41:13 -0300 Subject: [PATCH] New release - merge with FP version. --- Makefile | 160 ++-- README.md | 2 +- help.txt | 2 +- manual.md | 228 +++++- readme | 11 +- samples/draw.bas | 7 - samples/fp/ahlbench.bas | 20 + samples/fp/draw.bas | 16 + samples/{ => int}/carrera3d.bas | Bin samples/int/pi.bas | 245 ++++++ samples/{ => int}/pmtest.bas | 11 +- samples/{ => int}/sieve.bas | 0 src/actions.asm | 298 ++++--- src/alloc.asm | 5 +- src/basic.syn | 276 +++++-- src/csynt.cc | 35 +- src/editor.bas | 108 ++- src/errors.asm | 32 +- src/fastbasic.cfg | 6 +- src/interpreter.asm | 1311 ++++++++++++++++++++++++------- src/menu.asm | 107 ++- src/native.cc | 185 ++++- src/parse.asm | 38 +- src/runtime.asm | 198 ++--- src/standalone.asm | 21 +- src/synt-emit-cc.h | 15 +- src/synt-read.h | 184 +++++ src/synt-sm.h | 4 +- src/synt.cc | 43 +- src/vars.asm | 71 +- startup.bat | 3 +- tools/anotate-run.awk | 2 +- 32 files changed, 2662 insertions(+), 982 deletions(-) delete mode 100644 samples/draw.bas create mode 100644 samples/fp/ahlbench.bas create mode 100644 samples/fp/draw.bas rename samples/{ => int}/carrera3d.bas (100%) create mode 100644 samples/int/pi.bas rename samples/{ => int}/pmtest.bas (89%) rename samples/{ => int}/sieve.bas (100%) create mode 100644 src/synt-read.h diff --git a/Makefile b/Makefile index 838069e..fa3926f 100644 --- a/Makefile +++ b/Makefile @@ -1,19 +1,35 @@ CXX=g++ CXXFLAGS=-O2 -Wall +SYNTFLAGS= +SYNTFP=-DFASTBASIC_FP +FPASM=--asm-define FASTBASIC_FP --asm-include-dir gen/fp +INTASM=--asm-include-dir gen/int +FPCXX=-DFASTBASIC_FP -Igen/fp +INTCXX=-Igen/int # Cross -CL65OPTS=-g -tatari -Csrc/fastbasic.cfg --asm-include-dir gen +CL65OPTS=-g -tatari -Csrc/fastbasic.cfg ATR=fastbasic.atr -PROG=bin/fastbasic.xex -NATIVE=bin/fastbasic +PROGS=bin/fb.xex bin/fbi.xex +NATIVE_INT=bin/fastbasic-int +NATIVE_FP=bin/fastbasic + +NATIVES=$(NATIVE_INT) $(NATIVE_FP) # Sample programs -SAMPLE_BAS=\ - carrera3d.bas \ - draw.bas \ - pmtest.bas \ - sieve.bas \ +SAMPLE_FP_BAS=\ + fp/ahlbench.bas \ + fp/draw.bas \ + +SAMPLE_INT_BAS=\ + int/pi.bas \ + int/carrera3d.bas \ + int/pmtest.bas \ + int/sieve.bas \ + +SAMPLE_BAS=$(SAMPLE_INT_BAS) $(SAMPLE_FP_BAS) +SAMPLE_X_BAS=$(SAMPLE_FP_BAS:fp/%=%) $(SAMPLE_INT_BAS:int/%=%) # Test programs TEST_BAS=\ @@ -26,19 +42,21 @@ TEST_BAS=\ # Output files inside the ATR FILES=\ disk/fb.com \ + disk/fbi.com \ disk/readme \ disk/manual.txt \ disk/startup.bat \ disk/help.txt \ $(TEST_BAS:%=disk/%) \ - $(SAMPLE_BAS:%=disk/%) \ - $(SAMPLE_BAS:%.bas=disk/%.com) \ + $(SAMPLE_X_BAS:%=disk/%) \ + $(SAMPLE_X_BAS:%.bas=disk/%.com) \ # BW-DOS files to copy inside the ATR DOSDIR=disk/dos/ DOS=\ xbw130.dos\ copy.com\ + pause.com\ # ASM files used in the RUNTIME RT_AS_SRC=\ @@ -64,35 +82,39 @@ BAS_SRC=\ src/editor.bas\ # Object files -RT_OBJS=$(RT_AS_SRC:src/%.asm=obj/%.o) -IDE_OBJS=$(IDE_AS_SRC:src/%.asm=obj/%.o) -COMMON_OBJS=$(COMMON_AS_SRC:src/%.asm=obj/%.o) -BAS_OBJS=$(BAS_SRC:src/%.bas=obj/%.o) +RT_OBJS_FP=$(RT_AS_SRC:src/%.asm=obj/fp/%.o) +IDE_OBJS_FP=$(IDE_AS_SRC:src/%.asm=obj/fp/%.o) +COMMON_OBJS_FP=$(COMMON_AS_SRC:src/%.asm=obj/fp/%.o) +BAS_OBJS_FP=$(BAS_SRC:src/%.bas=obj/fp/%.o) + +RT_OBJS_INT=$(RT_AS_SRC:src/%.asm=obj/int/%.o) +IDE_OBJS_INT=$(IDE_AS_SRC:src/%.asm=obj/int/%.o) +COMMON_OBJS_INT=$(COMMON_AS_SRC:src/%.asm=obj/int/%.o) +BAS_OBJS_INT=$(BAS_SRC:src/%.bas=obj/int/%.o) SAMP_OBJS=$(SAMPLE_BAS:%.bas=obj/%.o) -# Listing files -RT_LSTS=$(RT_AS_SRC:src/%.asm=obj/%.lst) -IDE_LSTS=$(IDE_AS_SRC:src/%.asm=obj/%.lst) -COMMON_LSTS=$(COMMON_AS_SRC:src/%.asm=obj/%.lst) -BAS_LSTS=$(BAS_SRC:src/%.bas=obj/%.lst) -SAMP_LSTS=$(SAMPLE_BAS:%.bas=obj/%.lst) - # All Output files -OBJS=$(RT_OBJS) $(IDE_OBJS) $(COMMON_OBJS) $(BAS_OBJS) $(SAMP_OBJS) -LSTS=$(RT_LSTS) $(IDE_LSTS) $(COMMON_LSTS) $(BAS_LSTS) $(SAMP_LSTS) +OBJS=$(RT_OBJS_FP) $(IDE_OBJS_FP) $(COMMON_OBJS_FP) $(BAS_OBJS_FP) \ + $(RT_OBJS_INT) $(IDE_OBJS_INT) $(COMMON_OBJS_INT) $(BAS_OBJS_INT) \ + $(SAMP_OBJS) +LSTS=$(OBJS:%.o=%.lst) -MAPS=$(PROG:.xex=.map) $(SAMPLE_BAS:%.bas=bin/%.map) -LBLS=$(PROG:.xex=.lbl) $(SAMPLE_BAS:%.bas=bin/%.lbl) +MAPS=$(PROGS:.xex=.map) $(SAMPLE_X_BAS:%.bas=bin/%.map) +LBLS=$(PROGS:.xex=.lbl) $(SAMPLE_X_BAS:%.bas=bin/%.lbl) SYNT=gen/synt CSYNT=gen/csynt -all: $(ATR) $(NATIVE) +all: $(ATR) $(NATIVES) clean: - rm -f $(OBJS) $(LSTS) $(FILES) $(ATR) $(PROG) $(MAPS) $(LBLS) $(SYNT) $(CSYNT) $(NATIVE) + rm -f $(OBJS) $(LSTS) $(FILES) $(ATR) $(PROGS) $(MAPS) $(LBLS) $(SYNT) $(CSYNT) $(NATIVES) distclean: clean - rm -f gen/basic.asm gen/basic.cc $(BAS_SRC:src/%.bas=gen/%.asm) $(SAMPLE_BAS:%.bas=gen/%.asm) + rm -f gen/int/basic.asm gen/fp/basic.asm gen/int/basic.cc gen/fp/basic.cc \ + $(BAS_SRC:src/%.bas=gen/fp/%.asm) \ + $(BAS_SRC:src/%.bas=gen/int/%.asm) \ + $(SAMPLE_BAS:%.bas=gen/%.asm) + -rmdir gen/fp gen/int obj/fp obj/int -rmdir bin gen obj # Build an ATR disk image using "mkatr". @@ -100,7 +122,10 @@ $(ATR): $(DOS:%=$(DOSDIR)/%) $(FILES) mkatr $@ $(DOSDIR) -b $^ # BAS sources also transformed to ATASCII (replace $0A with $9B) -disk/%.bas: samples/%.bas +disk/%.bas: samples/fp/%.bas + tr '\n' '\233' < $< > $@ + +disk/%.bas: samples/int/%.bas tr '\n' '\233' < $< > $@ disk/%.bas: tests/%.bas @@ -114,9 +139,6 @@ disk/%.txt: %.md LC_ALL=C awk 'BEGIN{for(n=0;n<127;n++)chg[sprintf("%c",n)]=128+n} {l=length($$0);for(i=1;i<=l;i++){c=substr($$0,i,1);if(c=="`"){x=1-x;if(x)c="\002";else c="\026";}else if(x)c=chg[c];printf "%c",c;}printf "\233";}' < $< > $@ # Copy ".XEX" as ".COM" -disk/fb.com: $(PROG) - cp $< $@ - disk/%.com: bin/%.xex cp $< $@ @@ -129,43 +151,73 @@ $(CSYNT): src/csynt.cc | gen $(CXX) $(CXXFLAGS) -o $@ $< # Native compiler -$(NATIVE): src/native.cc gen/basic.cc | bin - $(CXX) $(CXXFLAGS) -Igen -o $@ $< +$(NATIVE_INT): src/native.cc gen/int/basic.cc | bin + $(CXX) $(CXXFLAGS) $(INTCXX) -o $@ $< + +$(NATIVE_FP): src/native.cc gen/fp/basic.cc | bin + $(CXX) $(CXXFLAGS) $(FPCXX) -o $@ $< + +# Generator for syntax file - 6502 version - FLOAT +gen/fp/%.asm: src/%.syn $(SYNT) | gen/fp + $(SYNT) $(SYNTFLAGS) $(SYNTFP) $< -o $@ -# Generator for syntax file - 6502 version -gen/%.asm: src/%.syn $(SYNT) | gen - $(SYNT) < $< > $@ +# Generator for syntax file - 6502 version - INTEGER +gen/int/%.asm: src/%.syn $(SYNT) | gen/int + $(SYNT) $(SYNTFLAGS) $< -o $@ -# Generator for syntax file - C++ version -gen/%.cc: src/%.syn $(CSYNT) | gen - $(CSYNT) < $< > $@ +# Generator for syntax file - C++ version - FLOAT +gen/fp/%.cc: src/%.syn $(CSYNT) | gen/fp + $(CSYNT) $(SYNTFLAGS) $(SYNTFP) $< -o $@ + +# Generator for syntax file - C++ version - INTEGER +gen/int/%.cc: src/%.syn $(CSYNT) | gen/int + $(CSYNT) $(SYNTFLAGS) $< -o $@ # Main program file -$(PROG): $(IDE_OBJS) $(COMMON_OBJS) $(BAS_OBJS) | bin +bin/fb.xex: $(IDE_OBJS_FP) $(COMMON_OBJS_FP) $(BAS_OBJS_FP) | bin + cl65 $(CL65OPTS) -Ln $(@:.xex=.lbl) -vm -m $(@:.xex=.map) -o $@ $^ + +bin/fbi.xex: $(IDE_OBJS_INT) $(COMMON_OBJS_INT) $(BAS_OBJS_INT) | bin cl65 $(CL65OPTS) -Ln $(@:.xex=.lbl) -vm -m $(@:.xex=.map) -o $@ $^ # Compiled program files -bin/%.xex: obj/%.o $(RT_OBJS) $(COMMON_OBJS) | bin +bin/%.xex: obj/fp/%.o $(RT_OBJS_FP) $(COMMON_OBJS_FP) | bin + cl65 $(CL65OPTS) -Ln $(@:.xex=.lbl) -vm -m $(@:.xex=.map) -o $@ $^ + +bin/%.xex: obj/int/%.o $(RT_OBJS_INT) $(COMMON_OBJS_INT) | bin cl65 $(CL65OPTS) -Ln $(@:.xex=.lbl) -vm -m $(@:.xex=.map) -o $@ $^ # Generates basic bytecode from source file -gen/%.asm: src/%.bas $(NATIVE) | gen - $(NATIVE) $< $@ +gen/fp/%.asm: src/%.bas $(NATIVE_FP) | gen/fp + $(NATIVE_FP) $< $@ -gen/%.asm: samples/%.bas $(NATIVE) | gen - $(NATIVE) $< $@ +gen/int/%.asm: src/%.bas $(NATIVE_INT) | gen/int + $(NATIVE_INT) $< $@ + +gen/fp/%.asm: samples/fp/%.bas $(NATIVE_FP) | gen/fp + $(NATIVE_FP) $< $@ + +gen/int/%.asm: samples/int/%.bas $(NATIVE_INT) | gen/int + $(NATIVE_INT) $< $@ # Object file rules -obj/%.o: src/%.asm | obj - cl65 $(CL65OPTS) -c -l $(@:.o=.lst) -o $@ $< +obj/fp/%.o: src/%.asm | obj/fp + cl65 $(CL65OPTS) $(FPASM) -c -l $(@:.o=.lst) -o $@ $< + +obj/fp/%.o: gen/fp/%.asm | obj/fp + cl65 $(CL65OPTS) $(FPASM) -c -l $(@:.o=.lst) -o $@ $< + +obj/int/%.o: src/%.asm | obj/int + cl65 $(CL65OPTS) $(INTASM) -c -l $(@:.o=.lst) -o $@ $< -obj/%.o: gen/%.asm | obj - cl65 $(CL65OPTS) -c -l $(@:.o=.lst) -o $@ $< +obj/int/%.o: gen/int/%.asm | obj/int + cl65 $(CL65OPTS) $(INTASM) -c -l $(@:.o=.lst) -o $@ $< -gen obj bin: +gen obj obj/fp obj/int gen/fp gen/int bin: mkdir -p $@ # Dependencies -obj/parse.o: src/parse.asm gen/basic.asm -$(CSYNT): src/csynt.cc src/synt-parse.h src/synt-wlist.h src/synt-sm.h src/synt-emit-cc.h -$(SYNT): src/synt.cc src/synt-parse.h src/synt-wlist.h src/synt-sm.h src/synt-emit-asm.h +obj/fp/parse.o: src/parse.asm gen/fp/basic.asm +obj/int/parse.o: src/parse.asm gen/int/basic.asm +$(CSYNT): src/csynt.cc src/synt-parse.h src/synt-wlist.h src/synt-sm.h src/synt-emit-cc.h src/synt-read.h +$(SYNT): src/synt.cc src/synt-parse.h src/synt-wlist.h src/synt-sm.h src/synt-emit-asm.h src/synt-read.h diff --git a/README.md b/README.md index f332817..0eb8153 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ This is a fast interpreter for the BASIC language on the Atari 8-bit computers. The current features are: - Support for 16bit integer variables; -- Small size (currently the IDE is less than 9k, and the runtime is less than 2k); +- Small size (currently the IDE is less than 10k, and the runtime is less than 3k); - Fast execution (currently, about 15% faster than compiled TurboBasicXL in the "sieve.bas" benchmark, 3.5 times faster than OSS Integer Basic); - Modern syntax (no line numbers, many control structures); - Feels "alike" TurboBasicXL, with many of the extended statements. diff --git a/help.txt b/help.txt index aa84575..610f298 100644 --- a/help.txt +++ b/help.txt @@ -1,5 +1,5 @@ ' -' FastBasic - (c) 2017 dmsc +' FastBasic - (c) 2017 dmsc ' ' Editor Help ' ----------- diff --git a/manual.md b/manual.md index 0ba108e..c10f85f 100644 --- a/manual.md +++ b/manual.md @@ -15,14 +15,31 @@ similar to newer programming environments, giving the programmer a lot of flexibility. -Another big difference is that all -operations are performed on integer -numbers, this is one of the reasons -that the programs run so fast. The -other reason is that the program is +Another big difference is that default +variables and operations are done using +integer numbers, this is one of the +reasons that the programs run so fast. +The other reason is that the program is parsed on run, generating optimized code for very fast execution. +Currently, FastBasic support: +- Integer and floating point variables, + including all standard arithmetic + operators. +- All graphic, sound and color commands + from Atari Basic, plus some + extensions from Turbo Basic. +- All control flow structures from + Atari Basic and Turbo Basic. +- Minimal string support. +- Arrays with "word" and "byte" types. +- User defined procedures. +- Compilation to binary loadable files. +- Available as a full version `FB.COM` + and also as a smaller integer-only + `FBI.COM`. + First Steps =========== @@ -33,7 +50,7 @@ prompt. This will load the IDE and present you with a little help text: --D:HELP.TXT-------------------0-- - ' FastBasic - (c) 2017 dmsc + ' FastBasic FP - (c) 2017 dmsc ' ' Editor Help ' ----------- @@ -118,8 +135,8 @@ to cancel the save operation. Compiling the program to disk ============================= -One of the After you are satisfied with -your program, you can compile to a disk +Once you are satisfied with your +program, you can compile to a disk file, producing a program that can be run directly from DOS. @@ -154,14 +171,18 @@ the following main rules: - an empty line. 2. All statements and variable names -can be lower or uppercase, as the -language is case insensitive. + can be lower or uppercase, as the + language is case insensitive. 3. Statements can be abbreviated to -reduce typing, each statement have a -different abbreviation. + reduce typing, each statement have a + different abbreviation. + +4. Multiple statements can be put on + the same line by placing a semicolon + `:` between statements. -4. No line numbers are allowed. +5. No line numbers are allowed. In the following chapters, whenever a value can take any numeric expression, @@ -179,10 +200,16 @@ calculations in the language. There are numeric expressions, boolean expressions and string expressions. -In FastBasic, all numeric expressions -are evaluated as integers from -32768 -to 32767, this is called 16 bit signed -integer values. +In FastBasic, standard numeric +expressions are evaluated as integers +from -32768 to 32767, this is called 16 +bit signed integer values. + +Floating point expressions are used +*only* if numbers have a decimal point. +Floating point numbers are stored with +standard Atari BCD representation, with +a range from 1E-98 to 1E+98. Boolean expressions are "true" or "false", represented as the numbers 1 @@ -202,15 +229,23 @@ hexadecimal numbers with a $ sign before (like $1C0, $A00, etc.) or by using the name of a variable. +Floating point values are written with +a decimal dot and an optional exponent +(like 1.0E+10, or -3.2) + Numeric Variables ----------------- Variable names must begin with a letter or the symbol _, and can contain any -letter, number or the symbol _. Valid -variable names are "COUNTER", "My_Var", -"num1". +letter, number or the symbol _. +Examples of valid variable names are +"COUNTER", "My_Var", "num1". + +Floating point variables have an "%" as +last character in the name. Examples of +valid names are "MyNum%", "x1%". Numeric Operators @@ -219,8 +254,8 @@ Numeric Operators There are various "operators" the perform calculation in expressions, the operators with higher precedence always -execute first. These are the operators -in order of precedence: +execute first. These are the *integer* +operators in order of precedence: - `+` `-` : addition, subtraction, from left to right. @@ -252,6 +287,43 @@ If there is need to alter the precedence, you can put the expression between parenthesis. +When using floating point expressions, +the operators are: + +- `+` `-` : addition, subtraction, from + left to right. +- `*` `/` : multiplication, division, + from left to right. +- `^` : exponentiation, from left + to right. +- `+` `-` : positive / negative. + +Note that integer expressions are +automatically converted to floating +point if needed, this allows mixing +integers and floating point in some +calculations, but you must have care +to force floating point calculations to +avoid integer overflows. + +Example: the expression + + a% = 1000 * 1000 + 1.2 + +gives correct result as "1000" is +converted to floating point before +calculation, but: + + x=1000: a% = x * x + 1.2 + +gives incorrect results as the +multiplication result is bigger tan +32767. + +Note that after any floating point +errors (division by 0 and overflow), +ERR() returns 3. + Boolean Operators ----------------- @@ -276,9 +348,16 @@ order of precedence, are: - NOT : Logical NOT, true only if operand is false. - <= >= <> < > = - Integer comparison, compare the two - integers and return true or false. - Note that "<>" is "not equal". + Integer or floating point comparison, + compare the two numbers and return + true or false. Note that "<>" is + "not equal". + You can only compare two values of + the same type, so an expression like + "x = 1.2" is invalid, but "1.2 = x" + is valid as the second operand is + converted to floating point before + comparison. Arrays @@ -352,12 +431,23 @@ functions supported by FastBasic. in PAL systems. - ABS(_num_) : Returns the absolute - value of _num_. + value of _num_. Can be + used with integers and + floating point. - SGN(_num_) ; Returns the sign of _num_, this is 1 if positive, -1 if negative - or 0 if _num_ is 0. + or 0 if _num_ is 0. Can + be used with integers + and floating point. + +- INT(_num_) : Converts the floating + point number _num_ to + the nearest integer from + -32768 to 32767. In case + of error, ERR() returns + 3. - PADDLE(_n_): Returns the value of the PADDLE controller _n_. @@ -380,6 +470,16 @@ functions supported by FastBasic. negative number, less than _num_. +- KEY() : Returns 0 if no key was + pressed, or a keycode. The + returned value only goes to 0 + after reading the key in the + OS (via a `GET` or `POKE + 764,0` statement). _Hint: + The value returned is + actually the same as_ + `(PEEK(764) EXOR 255)`. + - FRE() : Returns the free memory available in bytes. @@ -394,7 +494,9 @@ functions supported by FastBasic. number. If no conversion is possible, ERR() is - set to 18. + set to 18. Can be + used with integers + and floatign point. - ASC(*string*) : Returns the ATASCI code of the first @@ -402,6 +504,36 @@ functions supported by FastBasic. *string*. +Floating Point functions +------------------------ + +This functions return a floating point +value. + +- COS(_n_): Cosine of _n_. + +- EXP(_n_) : Natural exponentiation. + +- EXP10(_n_) : Returns ten raised to _n_. + +- LOG(_n_) : Natural logarithm of _n_. + +- LOG10(_n_): Decimal logarithm of _n_. + +- RND(): Returns a random positive + number strictly less than 1. + +- SQR(_n_): Square root of _n_. + +- SIN(_n_): Sine of _n_. + +- ATN(_n_): Arc-Tangent of _n_. + +Note that, as any floating point +calculation, in case of error ERR() +returns 3. + + Low level Functions ------------------- @@ -832,8 +964,8 @@ Device Input and Output Statements value of ERR() after close to ensure that written data is really on disk. -**Reads a byte from file** -**GET #_iochn_, _var_** +**Reads bytes from file** +**GET #_iochn_, _var_, ...** Reads one byte from channel _iochn_ and writes the value to _var_. @@ -960,7 +1092,16 @@ General Statements Note that the array can be modified afterwards like a normal array. -**Allicate an array** + +**Decrements variable by 1** +**DEC _var_** + + Decrements the variable by 1, this is + equivalent to "_var_ = _var_ - 1", + but faster. + + +**Allocate an array** **DIM _arr_(_size_) [type], .../ DI.** The DIM statement allows defining @@ -1012,6 +1153,31 @@ General Statements animations. +Floating point statements +------------------------- + +Those statements are only available in +the floating point version. + + +**Sets "degrees" mode** +**DEG** + + Makes all trigonometric functions + operate in degrees, so that 360 is + the full circle. + + +**Sets "radians" mode** +**RAD** + + Makes all trigonometric functions + operate in radians, so that 2pi is + the full circle. + + This mode is the default on startup. + + Low level statements -------------------- diff --git a/readme b/readme index 2818f10..1eec012 100644 --- a/readme +++ b/readme @@ -1,7 +1,10 @@ --- FastBasic - by dmsc -- +} +­­­  ÆáóôÂáóéã  ­  âù äíóã ­­­ +•••••••••••••••••••••••••••••• -Type FB to load the editor. +Type FB to load the standard IDE, +or FBI to load the integer IDE. -See MANUAL.TXT for a little help. +See MANUAL.TXT for the full manual. -Available programs: +Ìéóô ïæ óáíðìå ðòïçòáíóº  \ No newline at end of file diff --git a/samples/draw.bas b/samples/draw.bas deleted file mode 100644 index b6714de..0000000 --- a/samples/draw.bas +++ /dev/null @@ -1,7 +0,0 @@ -gr.8 -c.1 -for i=0 to 100 step 3 - plot 100-i,0 - dr. 0,i -n.i - diff --git a/samples/fp/ahlbench.bas b/samples/fp/ahlbench.bas new file mode 100644 index 0000000..ae03905 --- /dev/null +++ b/samples/fp/ahlbench.bas @@ -0,0 +1,20 @@ + +start_time = TIME +' AHL'S SIMPLE BENCHMARK +FOR N=1 TO 100 + A%=N + FOR I=1 TO 10 + A%=SQR(A%):R%=R%+RND() + NEXT I + FOR I=1 TO 10 + A%=A%^2:R%=R%+RND() + NEXT I + S%=S%+A% +NEXT N + +PRINT "ACCURACY ";ABS(1010-S%/5) +PRINT "RANDOM ";ABS(1000-R%) +end_time = TIME +SC = end_time - start_time +? SC/60;" SECONDS" + diff --git a/samples/fp/draw.bas b/samples/fp/draw.bas new file mode 100644 index 0000000..455228e --- /dev/null +++ b/samples/fp/draw.bas @@ -0,0 +1,16 @@ +' Graphics sample +gr. 8+16 +color 1 + +' Sample line drawing +for i=0 to 100 step 3 + plot 100-i,0 + dr. 0,i +next i + +' Plotting a function (in FP) +for i=120 to 300 + y% = i * 0.05 - 11 + y% = y% * y% * (y% + 5) + plot i, 160 - int(y%) +next i diff --git a/samples/carrera3d.bas b/samples/int/carrera3d.bas similarity index 100% rename from samples/carrera3d.bas rename to samples/int/carrera3d.bas diff --git a/samples/int/pi.bas b/samples/int/pi.bas new file mode 100644 index 0000000..a36caf4 --- /dev/null +++ b/samples/int/pi.bas @@ -0,0 +1,245 @@ +' Calculate PI to 254 digits +' ========================== + +' Uses Machin formula: +' Pi/4 = 4 * ATAN(1/5) - ATAN(1/239) +' +' The calculation is done in base 100, +' to simplify the code and printing. + +' The arrays store two digits on each +' location (from 00 to 99). +DIM P(130), T(130), SV(130) + +' Arguments to procedures bellow +MULT=0 +DIVI=0 +ZERO=0 + +' Precision in digit pairs +Q=127 + +' Start measuring time +STIME=TIME + +' Cleanup numbers +FOR I=0 TO Q + P(I) = 0 + T(I) = 0 +NEXT + +' Calculate ATAN(1/5), positive: +PRINT "A(1/5):"; +AS=1 : AT=5 : EXEC ARCTAN_SMALL +PRINT + +' Multiply by 4 +EXEC MUL4 + +' Calculate ATAN(1/239), negative: +PRINT "A(1/239):"; +AS=0 : AT=239 : EXEC ARCTAN +PRINT + +' Multiply all by 4 +EXEC MUL4 + +' Get calculation end time +ETIME=TIME + +' Show our value of PI +EXEC SHOW + +ETIME=ETIME-STIME +PRINT "Elapsed time: ";ETIME/60;" s" + +END + +'------------------------------------- +' Prints number on P() +' +PROC SHOW + PRINT "PI=";P(0);"."; + FOR I=1 TO Q-1 + S=P(I) + IF S<10 + PRINT "0";S; + ELSE + PRINT S; + ENDIF + NEXT + PRINT +ENDPROC + +'------------------------------------- +' Calculate ATAN(1/AT), adding the +' result to P() +' +PROC ARCTAN + T(0)=1 + DIVI=AT + EXEC DIV + EXEC SAVE_T + N=1 + REPEAT + EXEC ADDSUB + EXEC RESTORE_T + DIVI=AT + EXEC DIV + EXEC DIV + EXEC SAVE_T + N=N+2 + DIVI=N + EXEC DIV + EXEC CHKZERO + PRINT "."; + UNTIL ZERO +ENDPROC + +'------------------------------------- +' Calculate ATAN(1/AT), with AT a small +' number (so that AT*AT*100 < 32768), +' adding the result to P(). +' +PROC ARCTAN_SMALL + T(0)=1 + DIVI=AT + EXEC DIV + EXEC SAVE_T + N=1 + AT=AT*AT + REPEAT + EXEC ADDSUB + EXEC RESTORE_T + N=N+2 + DIVI=AT + EXEC DIV + EXEC SAVE_T + DIVI=N + EXEC DIV + EXEC CHKZERO + PRINT "."; + UNTIL ZERO +ENDPROC + +'------------------------------------- +' ADDs or SUBs T() to P(), depending +' on AS. +' +PROC ADDSUB + IF AS + AS=0 + EXEC ADD + ELSE + AS=1 + EXEC SUB + ENDIF +ENDPROC + +'------------------------------------- +' Checks if T() is zero, to stop +' the series. +' +PROC CHKZERO + ZERO=1 + FOR I=0 TO Q + IF T(I) + ZERO=0 + EXIT + ENDIF + NEXT +ENDPROC + +'------------------------------------- +' Adds T() to P(), so P()=P()+T() +' +PROC ADD + FOR J=Q TO 0 STEP -1 + S=P(J)+T(J) + IF S>99 + INC P(J-1) + S=S-100 + ENDIF + P(J)=S + NEXT +ENDPROC + +'------------------------------------- +' Subtract T() from P(), so P()=P()-T() +' +PROC SUB + FOR J=Q TO 0 STEP -1 + S=P(J)-T(J) + IF S<0 + DEC P(J-1) + S=S+100 + ENDIF + P(J)=S + NEXT +ENDPROC + +'------------------------------------- +' Multiplies T() by the small number +' MULTI, only works if MULTI*100<32768 +' +PROC MUL + C=0 + FOR I=Q TO 0 STEP -1 + B = T(I) * MULT + C + T(I) = B MOD 100 + C = B / 100 + NEXT +ENDPROC + +'------------------------------------- +' Divides T() by the small number DIVI, +' only works if DIVI*100<32768 +' +PROC DIV + C=0 + FOR I=0 TO Q + B = 100 * C + T(I) + T(I) = B / DIVI + C = B MOD DIVI + NEXT +ENDPROC + +'------------------------------------- +' Divides P() by 4. UNUSED! +' +PROC DIV4 + C=0 + FOR I=0 TO Q + B = 100 * C + P(I) + D = B MOD 4 + P(I) = B / 4 + NEXT +ENDPROC + +'------------------------------------- +' Multiplies P() by 4. +' +PROC MUL4 + C=0 + FOR I=Q TO 0 STEP -1 + B = P(I) * 4 + C + C = B / 100 + P(I) = B MOD 100 + NEXT +ENDPROC + +'------------------------------------- +' Saves the value of T +' +PROC SAVE_T + MOVE ADR(T), ADR(SV), Q*2 +ENDPROC + +'------------------------------------- +' Restores the value of T +' +PROC RESTORE_T + MOVE ADR(SV), ADR(T), Q*2 +ENDPROC + + diff --git a/samples/pmtest.bas b/samples/int/pmtest.bas similarity index 89% rename from samples/pmtest.bas rename to samples/int/pmtest.bas index fa86b13..47ff076 100644 --- a/samples/pmtest.bas +++ b/samples/int/pmtest.bas @@ -23,7 +23,7 @@ DATA PMclear() byte = $00,$00,$00,$00,$00 xPos = 6400 : yPos = 2560 xSpd = 64 : ySpd = 0 -do +repeat xPos = xPos + xSpd : yPos = yPos + ySpd ySpd = ySpd + 2 if (ySpd > 0) and (yPos > 12800) @@ -36,7 +36,14 @@ do if xPos < 6400 Then xSpd = -xSpd endif exec MovePm : ' Move P/M Graphics -loop +until Key() + +' Restore RAMTOP and SDMCTL +poke GRACTL, 0 +poke SDMCTL, Peek(SDMCTL) & 247 +poke RAMTOP, MemTop + 4 + +END proc MovePm x = xPos / 128 : y = P0Mem + yPos / 128 diff --git a/samples/sieve.bas b/samples/int/sieve.bas similarity index 100% rename from samples/sieve.bas rename to samples/int/sieve.bas diff --git a/src/actions.asm b/src/actions.asm index 146e035..ea3ed14 100644 --- a/src/actions.asm +++ b/src/actions.asm @@ -28,26 +28,36 @@ .export E_VAR_SET_TYPE, E_VAR_STRING .export E_LABEL, E_LABEL_DEF .export check_labels - .exportzp VT_WORD, VT_ARRAY_WORD, VT_ARRAY_BYTE, VT_STRING + .exportzp VT_WORD, VT_ARRAY_WORD, VT_ARRAY_BYTE, VT_STRING, VT_FLOAT .exportzp LT_PROC_1, LT_PROC_2, LT_DATA, LT_DO_LOOP, LT_REPEAT, LT_WHILE_1, LT_WHILE_2, LT_FOR_1, LT_FOR_2, LT_EXIT, LT_IF, LT_ELSE, LT_ELIF .importzp loop_sp, bpos, bptr, tmp1, tmp2, tmp3, opos ; From runtime.asm - .import umul16, sdiv16, read_word + .import read_word ; From vars.asm - .import var_search, var_new, var_getlen, var_set_type - .import label_search, label_new - .importzp var_namelen + .import var_search, name_new, var_getlen + .import label_search + .importzp var_namelen, label_count, var_count ; From alloc.asm .import alloc_laddr - .importzp prog_ptr, laddr_ptr, laddr_buf + .importzp prog_ptr, laddr_ptr, laddr_buf, var_ptr, label_ptr ; From parser.asm .import parser_error, parser_skipws .importzp TOK_CSTRING ; From error.asm - .importzp ERR_LOOP, ERR_VAR + .importzp ERR_LOOP ; From menu.asm .importzp reloc_addr +.ifdef FASTBASIC_FP + ; Exported only in Floating Point version + .export E_VAR_FP, E_NUMBER_FP + ; From runtime.asm + .import read_fp + ; From alloc.asm + .import alloc_area_8 +.endif ; FASTBASIC_FP + + .include "atari.inc" ;---------------------------------------------------------- ; Types of variables .enum @@ -56,6 +66,7 @@ VT_ARRAY_WORD VT_ARRAY_BYTE VT_STRING + VT_FLOAT = 128 ; Value is negative to signal 6bytes per variable! .endenum ; Types of labels .enum @@ -64,29 +75,35 @@ .endenum ; Types of loops .enum - ; First entries can't use "EXIT" - LT_PROC_1 - LT_DATA - LT_EXIT - ; From here, loops don't push jump destinations + ; Loop-Types: used to keep the type of loop in the loop + ; parsing stack. + ; + ; The numeric value is used to signal if we need to push + ; a destination address (reserving 2 bytes of program data), + ; and if the loop should be ignored by the EXIT statement. + ; + ; ; EXIT? PUSH? + LT_PROC_1 ; error yes + LT_DATA ; error yes + LT_EXIT ; error yes + LT_FOR_2 ; yes yes LT_LAST_JUMP = 32 - LT_PROC_2 - LT_DO_LOOP - LT_REPEAT - LT_WHILE_1 - LT_FOR_1 - ; And from here, loops push destinations and are ignored by EXIT - LT_WHILE_2= 128 ; Pushes - LT_FOR_2 ; Pushes - LT_IF ; Pushes - LT_ELSE ; Pushes - LT_ELIF ; Pushes + LT_PROC_2 ; yes no + LT_DO_LOOP ; yes no + LT_REPEAT ; yes no + LT_WHILE_1 ; yes no + + LT_WHILE_2= 128 ; ignore yes + LT_IF ; ignore yes + LT_ELSE ; ignore yes + LT_ELIF ; ignore yes + LT_FOR_1 = 128 + 33 ; ignore no .endenum ;---------------------------------------------------------- - ; TODO: this space should be reclaimed by the interpreter! - .bss -loop_stk: .res 128 +; Use cassette buffer for loop stack, max 128 bytes +; Note that at $480 we store the interpreter stack. +loop_stk = $400 ;---------------------------------------------------------- .code @@ -103,6 +120,10 @@ loop_stk: .res 128 ok: rts .endproc +; Pops code pointer from loop stack and emit +.proc pop_emit_addr + jsr pop_codep +.endproc ; Fall through ; Emits address into codep, relocating if necessary. .proc emit_addr clc @@ -147,6 +168,8 @@ ok: clc beq E_REM::ok cmp #$0A ; ASCII EOL beq E_REM::ok + cmp #':' ; ':' separates commands + beq E_REM::ok xit: sec rts .endproc @@ -163,6 +186,16 @@ xit: sec jsr read_word bcs E_EOL::xit + +.ifdef FASTBASIC_FP + ; In FP version, fails if number is followed by decimal dot + sta tmp1 + lda (bptr), y + cmp #'.' + beq E_EOL::xit + lda tmp1 +.endif ; FASTBASIC_FP + sty bpos jmp emit_AX @@ -276,11 +309,32 @@ eos_ok: ldy tmp1 sta (prog_ptr),y inc opos clc - rts +xrts: rts .endproc +; Following two routines are only used in FP version +.ifdef FASTBASIC_FP +.proc E_NUMBER_FP + jsr read_fp + bcs E_CONST_STRING::xrts + lda FR0 + ldx FR0+1 + jsr emit_AX + lda FR0+2 + ldx FR0+3 + jsr emit_AX + lda FR0+4 + ldx FR0+5 + jmp emit_AX +.endproc -; Variable marching. +.proc E_VAR_FP + lda #VT_FLOAT + .byte $2C ; Skip 2 bytes over next "LDA" +.endproc ; Fall through +.endif ; FASTBASIC_FP + +; Variable matching. ; The parser calls the routine to check if there is a variable ; with the correct type .proc E_VAR_STRING @@ -298,15 +352,13 @@ eos_ok: ldy tmp1 .proc E_VAR_WORD lda #VT_WORD sta tmp3 ; Store variable type - jsr parser_skipws ; Check if we have a valid name - this exits on error! jsr var_getlen ; Search existing var jsr var_search bcs exit cmp tmp3 - bne not_found - jmp emit_varn + beq emit_varn not_found: sec exit: @@ -315,14 +367,16 @@ exit: ; Creates a new variable, with no type (the type will be set by parser next) .proc E_VAR_CREATE - jsr parser_skipws ; Check if we have a valid name - this exits on error! jsr var_getlen ; Search existing var jsr var_search bcc E_VAR_WORD::not_found ; Exit with error if already exists ; Create new variable - exits on error - jsr var_new + ldx #var_ptr - prog_ptr + jsr name_new + ldx var_count + inc var_count ; Fall through .endproc ; Emits the variable, advancing pointers. @@ -350,7 +404,39 @@ exit: dec opos ; Remove variable TYPE from stack ldy opos lda (prog_ptr),y ; The variable TYPE - jmp var_set_type + ldy #$FF + dec var_ptr+1 + sta (var_ptr), y ; Store to (var_ptr - 1) + inc var_ptr+1 + +.ifdef FASTBASIC_FP + ; In FP version, we need to special case FP variables + ; that use 3 slots (6 bytes) each. + + tax ; Test if variable is FP + bpl ok + + ; FP variable, allocate two more "invisible" variables + ; to adjust to 6 bytes size. + ldx #var_ptr - prog_ptr + lda #4 + jsr alloc_area_8 + bcs err + + ; Set both sizes to 0 + dec var_ptr+1 + ldy #$FC + lda #0 + sta (var_ptr), y + ldy #$FE + sta (var_ptr), y + inc var_ptr+1 + inc var_count + inc var_count +.endif ; FASTBASIC_FP + +ok: clc +err: rts .endproc ; Loop iteration for label-address, @@ -417,13 +503,15 @@ xit: rts .endproc .proc label_create - jsr parser_skipws ; Check if we have a valid name - this exits on error! jsr var_getlen jsr label_search bcc xit ; Create a new label - jsr label_new + ldx #label_ptr - prog_ptr + jsr name_new + ldx label_count + inc label_count xit: lda laddr_buf ldy laddr_buf+1 @@ -510,6 +598,9 @@ start: .endproc ; Actions for LOOPS +.proc pop_patch_codep + jsr pop_codep +.endproc ; Fall through .proc patch_codep ; Patches saved position with current position sta tmp2 @@ -563,7 +654,7 @@ xit: clc .endproc .proc pop_codep - ; Saves current code position in loop stack + ; Reads code position from loop stack ldy loop_sp dey dey @@ -581,8 +672,7 @@ retry: cmp loop_stk, y ok: ; Get saved position iny iny - lda loop_stk, y - tax + ldx loop_stk, y dey lda loop_stk, y rtsclc: clc @@ -608,8 +698,7 @@ rtsclc: clc sty loop_sp iny iny - lda loop_stk, y - tax + ldx loop_stk, y dey lda loop_stk, y jsr patch_codep @@ -625,25 +714,66 @@ rtsclc: clc .proc E_POP_PROC_1 ; Pop saved "jump to end" position lda #LT_PROC_1 - jsr pop_codep - jmp patch_codep + jmp pop_patch_codep +.endproc + +.proc E_EXIT_LOOP + ; Search the loop stack for a loop (not "I"f nor "E"lse) and inserts a + ; patching code before + ldy loop_sp +retry: dey + dey + dey + bmi loop_error + lda loop_stk, y + bmi retry ; FOR(2)/WHILE(2)/IF/ELSE/ELIF are > 127 + cmp #LT_DATA+1 ; PROC(1)/DATA + bcc loop_error +ok: + ; Store slot + sty comp_y+1 + ; Check if enough stack + ldx loop_sp + inx + inx + inx + bmi loop_error + + ; Move all stack 3 positions up + stx loop_sp +move: + dex + lda loop_stk-3, x + sta loop_stk, x +comp_y: cpx #$FC + bne move + + ; Store our new stack entry + lda loop_sp + pha + ldy comp_y+1 + sty loop_sp + lda #LT_EXIT + jsr push_codep + pla + sta loop_sp + clc + rts .endproc .proc E_POP_WHILE ; Pop saved "jump to end" position lda #LT_WHILE_2 - jsr pop_codep ; Save current position + 2 (skip over jump) inc opos inc opos - jsr patch_codep + jsr pop_patch_codep ; Pop saved "loop reentry" position lda #LT_WHILE_1 - jsr pop_codep ; And store dec opos dec opos - jsr emit_addr + jsr pop_emit_addr ; Checks for an "EXIT" jmp check_loop_exit .endproc @@ -656,26 +786,22 @@ rtsclc: clc .proc E_POP_REPEAT ; Pop saved position, store lda #LT_REPEAT - jsr pop_codep - jsr emit_addr + jsr pop_emit_addr ; Checks for an "EXIT" jmp check_loop_exit .endproc .proc E_POP_FOR - ; Pop saved "jump to end" position - lda #LT_FOR_2 - jsr pop_codep - ; Save current position + 1 (skip over jump) - inc opos - jsr patch_codep + ; Remove unused "variable number" from code + dec opos ; Pop saved "loop reentry" position lda #LT_FOR_1 - jsr pop_codep ; And store - dec opos - dec opos - jsr emit_addr + jsr pop_emit_addr + ; Pop saved "jump to end" position + lda #LT_FOR_2 + ; Save current position + jsr pop_patch_codep ; Checks for an "EXIT" jmp check_loop_exit .endproc @@ -683,8 +809,7 @@ rtsclc: clc .proc E_POP_IF ; Patch IF/ELSE with current position lda #LT_ELSE - jsr pop_codep - jsr patch_codep + jsr pop_patch_codep .endproc ; Fall through .proc check_elif ldy loop_sp @@ -696,8 +821,7 @@ rtsclc: clc cmp loop_stk, y bne no_elif ; ELIF, remove from stack and patch - jsr pop_codep - jmp patch_codep + jmp pop_patch_codep no_elif: clc rts @@ -728,52 +852,4 @@ type: lda #LT_ELSE jmp patch_codep .endproc -.proc E_EXIT_LOOP - ; Search the loop stack for a loop (not "I"f nor "E"lse) and inserts a - ; patching code before - ldy loop_sp -retry: dey - dey - dey - bmi loop_error - lda loop_stk, y - bmi retry ; FOR(2)/WHILE(2)/IF/ELSE/ELIF are > 127 - cmp #LT_DATA+1 ; PROC/DATA - bcc loop_error -ok: - ; Store slot - sty comp_y+1 - ; Check if enough stack - ldx loop_sp - inx - inx - inx - bmi loop_error - - ; Move all stack 3 positions up - ldy loop_sp - stx loop_sp -move: - dey - lda loop_stk, y - dex - sta loop_stk, x -comp_y: cpy #$FF - bne move - - ; Store our new stack entry - lda loop_sp - pha - ldy comp_y+1 - sty loop_sp - lda #LT_EXIT - jsr push_codep - pla - sta loop_sp - clc - rts -loop_error: - jmp ::loop_error -.endproc - ; vi:syntax=asm_ca65 diff --git a/src/alloc.asm b/src/alloc.asm index ebe5afc..0de5d64 100644 --- a/src/alloc.asm +++ b/src/alloc.asm @@ -44,10 +44,9 @@ ; From runtime.asm .import move_dwn_src, move_dwn_dst, move_dwn - ; From vars.asm - .importzp var_count - ; Common vars .importzp tmp1, tmp2 + ; From interpreter.asm + .importzp var_count .zeropage diff --git a/src/basic.syn b/src/basic.syn index 9414b04..926eace 100644 --- a/src/basic.syn +++ b/src/basic.syn @@ -33,11 +33,11 @@ TOKENS { # Boolean operators TOK_L_NOT, TOK_L_OR, TOK_L_AND # Comparisons - TOK_GEQ, TOK_LEQ, TOK_NEQ, TOK_EQ + TOK_LT, TOK_GT, TOK_NEQ, TOK_EQ # Convert from int to bool TOK_COMP_0 # Low level statements - TOK_POKE, TOK_DPOKE, TOK_MOVE, TOK_NMOVE, TOK_INC + TOK_POKE, TOK_DPOKE, TOK_MOVE, TOK_NMOVE, TOK_INC, TOK_DEC # Graphic support statements TOK_GRAPHICS, TOK_PLOT, TOK_DRAWTO, TOK_FILLTO # Print statements @@ -45,6 +45,8 @@ TOKENS { # I/O TOK_GETKEY, TOK_INPUT_STR, TOK_XIO, TOK_CLOSE, TOK_GET, TOK_PUT TOK_BPUT, TOK_BGET + # Optimization - set's IO channel to 0 + TOK_IOCHN0 # Jumps TOK_JUMP, TOK_CJUMP, TOK_CALL, TOK_RET # FOR loop support @@ -58,6 +60,16 @@ TOKENS { TOK_PAUSE # USR, calls ML routinr TOK_USR_ADDR, TOK_USR_PARAM, TOK_USR_CALL + +#@if FASTBASIC_FP + # Floating point computations + TOK_PRINT_FP + TOK_INT_FP, TOK_FP_VAL, TOK_FP_SGN, TOK_FP_ABS, TOK_FP_NEG, TOK_FLOAT + TOK_FP_DIV, TOK_FP_MUL, TOK_FP_SUB, TOK_FP_ADD, TOK_FP_STORE, TOK_FP_LOAD + TOK_FP_EXP, TOK_FP_EXP10, TOK_FP_LOG, TOK_FP_LOG10, TOK_FP_INT + TOK_FP_GEQ, TOK_FP_GT, TOK_FP_EQ + TOK_FP_IPOW, TOK_FP_RND, TOK_FP_SQRT, TOK_FP_SIN, TOK_FP_COS, TOK_FP_ATN +#@endif FASTBASIC_FP } EXTERN { @@ -68,8 +80,57 @@ EXTERN { E_CONST_STRING E_VAR_CREATE, E_VAR_WORD, E_VAR_ARRAY_BYTE, E_VAR_ARRAY_WORD, E_VAR_STRING, E_VAR_SET_TYPE E_LABEL, E_LABEL_DEF + +#@if FASTBASIC_FP + E_VAR_FP, E_NUMBER_FP +#@endif FASTBASIC_FP } +# Floating point expressions +#@if FASTBASIC_FP +FP_EXPR: + FP_T_EXPR FP_E_EXPR_MORE FP_M_EXPR_MORE FP_EXPR_MORE + +FP_EXPR_MORE: + "+" FP_T_EXPR FP_E_EXPR_MORE FP_M_EXPR_MORE emit TOK_FP_ADD FP_EXPR_MORE + "-" FP_T_EXPR FP_E_EXPR_MORE FP_M_EXPR_MORE emit TOK_FP_SUB FP_EXPR_MORE + pass + +FP_M_EXPR_MORE: + "*" FP_T_EXPR FP_E_EXPR_MORE emit TOK_FP_MUL FP_M_EXPR_MORE + "/" FP_T_EXPR FP_E_EXPR_MORE emit TOK_FP_DIV FP_M_EXPR_MORE + pass + +FP_E_EXPR_MORE: + "^" T_EXPR emit TOK_FP_IPOW FP_E_EXPR_MORE + "^" emit TOK_FP_LOG10 FP_T_EXPR emit TOK_FP_MUL emit TOK_FP_EXP10 FP_E_EXPR_MORE + pass + +FP_T_EXPR: + emit TOK_FLOAT E_NUMBER_FP + "-" FP_T_EXPR emit TOK_FP_NEG + "+" FP_T_EXPR + # FP Functions + "ABS" FP_PAR_EXPR emit TOK_FP_ABS + "ATN" FP_PAR_EXPR emit TOK_FP_ATN + "SGN" FP_PAR_EXPR emit TOK_FP_SGN + "EXP10" FP_PAR_EXPR emit TOK_FP_EXP10 + "EXP" FP_PAR_EXPR emit TOK_FP_EXP + "LOG10" FP_PAR_EXPR emit TOK_FP_LOG10 + "LOG" FP_PAR_EXPR emit TOK_FP_LOG + "SQR" FP_PAR_EXPR emit TOK_FP_SQRT + "SIN" FP_PAR_EXPR emit TOK_FP_SIN + "COS" FP_PAR_EXPR emit TOK_FP_COS + "VAL" STR_PAR_EXPR emit TOK_FP_VAL + "RND()" emit TOK_FP_RND + FP_PAR_EXPR + emit TOK_VAR_ADDR E_VAR_FP "%" emit TOK_FP_LOAD + INT_EXPR emit TOK_INT_FP + +FP_PAR_EXPR: + "(" FP_EXPR ")" +#@endif FASTBASIC_FP + # Normal expressions INT_EXPR: T_EXPR BIT_EXPR_MORE M_EXPR_MORE INT_EXPR_MORE @@ -103,10 +164,6 @@ ADR_EXPR: emit TOK_VAR_LOAD E_VAR_ARRAY_WORD emit TOK_VAR_LOAD E_VAR_ARRAY_BYTE -USR_PARAMS: - # First parameter is the ML address - EXPR emit TOK_USR_ADDR USR_EXPR_MORE - USR_EXPR_MORE: "," EXPR emit TOK_USR_PARAM USR_EXPR_MORE pass @@ -116,12 +173,12 @@ T_EXPR: emit TOK_NUM E_NUMBER_WORD "-" NEG_EXPR "+" T_EXPR - NOT_TOK + "NOT" NOT_EXPR emit TOK_L_NOT # Special (predefined) variables "TIME" emit TOK_TIME # Variables as R-Values, push value into stack ARRAY_WORD_ADDR emit TOK_DPEEK - ARRAY_BYTE_ADDR emit TOK_PEEK + VAR_BYTE_LVALUE emit TOK_PEEK emit TOK_VAR_LOAD E_VAR_WORD # Functions "ABS" PAR_EXPR emit TOK_ABS @@ -131,15 +188,19 @@ T_EXPR: "PTRIG" emit TOK_NUM word PTRIG0 emit TOK_BYTE emit 7 RD_PORT "STICK" emit TOK_NUM word STICK0 emit TOK_BYTE emit 3 RD_PORT "STRIG" emit TOK_NUM word STRIG0 emit TOK_BYTE emit 3 RD_PORT +#@if FASTBASIC_FP + "INT" FP_PAR_EXPR emit TOK_FP_INT +#@endif FASTBASIC_FP "RAND" PAR_EXPR emit TOK_RAND "DPEEK" PAR_EXPR emit TOK_DPEEK "FRE()" emit TOK_FRE "ERR()" emit TOK_BYTE emit IOERROR emit TOK_PEEK - "USR(" USR_PARAMS ")" emit TOK_USR_CALL + "USR(" EXPR emit TOK_USR_ADDR USR_EXPR_MORE ")" emit TOK_USR_CALL "ADR(" ADR_EXPR ")" - "LEN(" STR_EXPR ")" emit TOK_PEEK # First byte of string is the length - "VAL(" STR_EXPR ")" emit TOK_VAL - "ASC(" STR_EXPR ")" emit TOK_1 emit TOK_ADD emit TOK_PEEK # TODO: does not check for empty strings. + "LEN" STR_PAR_EXPR emit TOK_PEEK # First byte of string is the length + "VAL" STR_PAR_EXPR emit TOK_VAL + "ASC" STR_PAR_EXPR emit TOK_1 emit TOK_ADD emit TOK_PEEK # TODO: does not check for empty strings. + "KEY()" emit TOK_NUM word CH emit TOK_PEEK emit TOK_BYTE emit 255 emit TOK_BIT_EXOR PAR_EXPR # Used to handle PADDLE/STICK/PTRIG/STRIG @@ -149,6 +210,9 @@ RD_PORT: PAR_EXPR: "(" EXPR ")" +STR_PAR_EXPR: + "(" STR_EXPR ")" + # Parses a continuation of an INT to BOOLean expression OR_AND_BOOL: OR_EXPR_RIGHT @@ -174,6 +238,9 @@ SET_BOOL_EXPR: # General Expression - Can be INT or BOOL EXPR: INT_EXPR TEST_BOOL_EXPR +#@if FASTBASIC_FP + FP_EXPR COMP_FP_RIGHT +#@endif FASTBASIC_FP # Forced BOOL expressions, convert to BOOL always FORCE_BOOL_EXPR: @@ -200,25 +267,36 @@ AND_EXPR_MORE: pass NOT_EXPR: - NOT_TOK - "(" EXPR ")" - INT_EXPR COMP_OR_BOOL - -NOT_TOK: "NOT" NOT_EXPR emit TOK_L_NOT + PAR_EXPR + INT_EXPR COMP_OR_BOOL +#@if FASTBASIC_FP + FP_EXPR COMP_FP_RIGHT +#@endif FASTBASIC_FP COMP_OR_BOOL: COMP_EXPR_RIGHT COMP_EXPR_MORE emit TOK_COMP_0 COMP_EXPR_RIGHT: - "<=" INT_EXPR emit TOK_LEQ - ">=" INT_EXPR emit TOK_GEQ + "<=" INT_EXPR emit TOK_GT emit TOK_L_NOT + ">=" INT_EXPR emit TOK_LT emit TOK_L_NOT "<>" INT_EXPR emit TOK_NEQ - "<" INT_EXPR emit TOK_GEQ emit TOK_L_NOT - ">" INT_EXPR emit TOK_LEQ emit TOK_L_NOT + "<" INT_EXPR emit TOK_LT + ">" INT_EXPR emit TOK_GT "=" INT_EXPR emit TOK_EQ +#@if FASTBASIC_FP +# FP Comparisons: +COMP_FP_RIGHT: + "=" FP_EXPR emit TOK_FP_SUB emit TOK_FP_EQ + ">" FP_EXPR emit TOK_FP_SUB emit TOK_FP_GT + ">=" FP_EXPR emit TOK_FP_SUB emit TOK_FP_GEQ + "<>" FP_EXPR emit TOK_FP_SUB emit TOK_FP_EQ emit TOK_L_NOT + "<=" FP_EXPR emit TOK_FP_SUB emit TOK_FP_GT emit TOK_L_NOT + "<" FP_EXPR emit TOK_FP_SUB emit TOK_FP_GEQ emit TOK_L_NOT +#@endif FASTBASIC_FP + COMP_EXPR_MORE: COMP_EXPR_RIGHT COMP_EXPR_MORE pass @@ -239,6 +317,7 @@ PRINT_SEP_MORE: PRINT_SEP PRINT_SEP_MORE pass +#@if !FASTBASIC_FP PRINT_ONE: EXPR emit TOK_PRINT_NUM STR_EXPR emit TOK_PRINT_STR @@ -249,44 +328,58 @@ PRINT_EXPR: PRINT_NEXT: PRINT_SEP PRINT_SEP_MORE PRINT_ONE PRINT_NEXT - PRINT_SEP PRINT_SEP_MORE IO_CHAN_0 + PRINT_SEP PRINT_SEP_MORE emit TOK_IOCHN0 emit TOK_PRINT_EOL +#@endif !FASTBASIC_FP -EOS: - E_EOL - ":" +#@if FASTBASIC_FP +PRINT_ONE: + EXPR emit TOK_PRINT_NUM PRINT_NEXT + FP_EXPR emit TOK_PRINT_FP PRINT_NEXT + STR_EXPR emit TOK_PRINT_STR PRINT_NEXT + +PRINT_EXPR: + PRINT_SEP_MORE PRINT_ONE + emit TOK_PRINT_EOL + +PRINT_NEXT: + PRINT_SEP PRINT_SEP_MORE PRINT_ONE + PRINT_SEP PRINT_SEP_MORE emit TOK_IOCHN0 + E_EOL emit TOK_PRINT_EOL +#@endif FASTBASIC_FP # Parse multi-line IF THEN_OR_MULTILINE: - "THEN" PARSE_LINE E_POP_IF + "THEN" PARSE_START E_POP_IF pass VAR_CREATE_TYPE: "$" emit VT_STRING +#@if FASTBASIC_FP + "%" emit VT_FLOAT +#@endif FASTBASIC_FP emit VT_WORD # Parse variable as L-VALUE, stores the *address* in the stack, this creates the # variable if not exist. -# NOTE: the creation rules is meant to fail, so next rule actually uses the created +# NOTE: the creation rule is meant to fail, so next rule actually uses the created # variable. VAR_WORD_LVALUE: E_VAR_CREATE VAR_CREATE_TYPE E_VAR_SET_TYPE E_EOL "." emit TOK_VAR_ADDR E_VAR_WORD ARRAY_WORD_ADDR -VAR_BYTE_LVALUE: - ARRAY_BYTE_ADDR - VAR_STR_LVALUE: emit TOK_VAR_ADDR E_VAR_STRING "$" -# Parse variable assignment, used in FOR and LET -ASSIGN_EXPR: - "=" EXPR +#@if FASTBASIC_FP +VAR_FP_LVALUE: + emit TOK_VAR_ADDR E_VAR_FP "%" +#@endif FASTBASIC_FP -# Parse string assignment -ASSIGN_STR: - "=" STR_EXPR +# Parse an "=" sign, it's own rule to skip spaces before! +EQUAL: + "=" # Parse optional "STEP" in for STEP_OPTIONAL: @@ -307,20 +400,18 @@ POSITION: ARRAY_WORD_ADDR: emit TOK_VAR_LOAD E_VAR_ARRAY_WORD PAR_EXPR emit TOK_USHL emit TOK_ADD -ARRAY_BYTE_ADDR: +# This is the same as "ARRAY_BYTE_ADDR" +VAR_BYTE_LVALUE: emit TOK_VAR_LOAD E_VAR_ARRAY_BYTE PAR_EXPR emit TOK_ADD # DIM -DIM_LIST: - DIM_VAR DIM_MORE - DIM_MORE: "," DIM_VAR DIM_MORE pass # INPUT INPUT_STR: - IO_CHAN "," # I/O channel, don't print prompt + IO_CHAN_COMMA # I/O channel, don't print prompt "\"" E_CONST_STRING emit TOK_PRINT_STR PRINT_SEP # Prints a given string PRINT_SEP # If starts with ',' or ';', don't print anyting emit TOK_BYTE emit 63 emit TOK_PUT # Prints a '?' by default @@ -333,9 +424,12 @@ INPUT_VAR_MORE: pass INPUT_VAR: - emit TOK_VAL VAR_WORD_LVALUE emit TOK_INPUT_STR emit TOK_VAL emit TOK_DPOKE - emit TOK_VAL VAR_BYTE_LVALUE emit TOK_INPUT_STR emit TOK_VAL emit TOK_POKE + VAR_WORD_LVALUE emit TOK_INPUT_STR emit TOK_VAL emit TOK_DPOKE + VAR_BYTE_LVALUE emit TOK_INPUT_STR emit TOK_VAL emit TOK_POKE VAR_STR_LVALUE emit TOK_INPUT_STR emit TOK_COPY_STR +#@if FASTBASIC_FP + VAR_FP_LVALUE emit TOK_INPUT_STR emit TOK_FP_VAL emit TOK_FP_STORE +#@endif FASTBASIC_FP # Dim variable types @@ -351,12 +445,13 @@ DIM_VAR: IO_CHAN: "#" emit TOK_BYTE emit IOCHN EXPR emit TOK_USHL emit TOK_USHL emit TOK_USHL emit TOK_USHL emit TOK_POKE -IO_CHAN_OPT: +# Note: we need the version without comma for "CLOSE #*" +IO_CHAN_COMMA: IO_CHAN "," - pass -IO_CHAN_0: - emit TOK_BYTE emit IOCHN emit TOK_0 emit TOK_POKE +IO_CHAN_OPT: + IO_CHAN_COMMA + pass # Get from keyboard expression GETK_EXPR: @@ -370,23 +465,19 @@ GET_EXPR: GET_EXPR_MORE: "," GET_EXPR - pass - -# Put expression -PUT_EXPR: - EXPR emit TOK_PUT PUT_EXPR_MORE - -PUT_EXPR_MORE: - "," PUT_EXPR - pass + emit TOK_IOCHN0 # Get two comma separated expressions "A,B" and returns "A*16+B" EXPR_AB: EXPR emit TOK_USHL emit TOK_USHL emit TOK_USHL emit TOK_USHL "," EXPR emit TOK_ADD +# 2 expressions separated by comma +EXPR_2: + EXPR "," EXPR + # Parses a XIO AUX1/AUX2/STRING expression XIO_EXPR: - EXPR "," EXPR emit TOK_SHL8 emit TOK_ADD "," STR_EXPR emit TOK_XIO + EXPR_2 emit TOK_SHL8 emit TOK_ADD "," STR_EXPR emit TOK_XIO # Parses a "DATA" expression, get's binary data in memory DATA_WORDS: @@ -398,31 +489,32 @@ DATA_BYTES: "," E_NUMBER_BYTE DATA_BYTES pass -DATA_FIRST: - E_VAR_SET_TYPE "=" - DATA_TYPE: - "Byte" emit VT_ARRAY_BYTE DATA_FIRST E_NUMBER_BYTE DATA_BYTES - "Word" emit VT_ARRAY_WORD DATA_FIRST E_NUMBER_WORD DATA_WORDS + "Byte" emit VT_ARRAY_BYTE E_VAR_SET_TYPE EQUAL E_NUMBER_BYTE DATA_BYTES + "Word" emit VT_ARRAY_WORD E_VAR_SET_TYPE EQUAL E_NUMBER_WORD DATA_WORDS DATA_END: "," E_POP_DATA emit TOK_DPOKE +DATA_VAR: + emit TOK_VAR_ADDR E_VAR_CREATE "()" emit TOK_CDATA emit LT_DATA E_PUSH_LT + pass + # Parse a line -PARSE_LINE: +PARSE_LINE_COMMAND: "'" E_REM "." E_REM "?" IO_CHAN_OPT PRINT_EXPR "PRint" IO_CHAN_OPT PRINT_EXPR - "Input" INPUT_STR INPUT_VAR_LIST IO_CHAN_0 + "Input" INPUT_STR INPUT_VAR_LIST emit TOK_IOCHN0 "GEt" GETK_EXPR - "GEt" IO_CHAN "," GET_EXPR - "PUt" IO_CHAN_OPT PUT_EXPR - "Poke" EXPR "," EXPR emit TOK_POKE - "Dpoke" EXPR "," EXPR emit TOK_DPOKE - "Move" EXPR "," EXPR "," EXPR emit TOK_MOVE - "-move" EXPR "," EXPR "," EXPR emit TOK_NMOVE + "GEt" IO_CHAN_COMMA GET_EXPR + "PUt" IO_CHAN_OPT EXPR emit TOK_PUT + "Poke" EXPR_2 emit TOK_POKE + "Dpoke" EXPR_2 emit TOK_DPOKE + "Move" EXPR_2 "," EXPR emit TOK_MOVE + "-move" EXPR_2 "," EXPR emit TOK_NMOVE "DO" emit LT_DO_LOOP E_PUSH_LT "Loop" emit TOK_JUMP E_POP_LOOP "REPeat" emit LT_REPEAT E_PUSH_LT @@ -430,8 +522,8 @@ PARSE_LINE: "While" emit LT_WHILE_1 E_PUSH_LT FORCE_BOOL_EXPR emit TOK_CJUMP emit LT_WHILE_2 E_PUSH_LT "WEnd" emit TOK_JUMP E_POP_WHILE "IF" FORCE_BOOL_EXPR emit TOK_CJUMP emit LT_IF E_PUSH_LT THEN_OR_MULTILINE - "For" VAR_WORD_LVALUE ASSIGN_EXPR emit TOK_FOR_START "TO" EXPR STEP_OPTIONAL emit LT_FOR_1 E_PUSH_LT emit TOK_FOR emit TOK_CJUMP emit LT_FOR_2 E_PUSH_LT - "Next" emit TOK_FOR_NEXT emit TOK_JUMP NEXT_VARNAME E_POP_FOR emit TOK_FOR_EXIT + "For" VAR_WORD_LVALUE EQUAL EXPR emit TOK_FOR_START "TO" EXPR STEP_OPTIONAL emit TOK_FOR emit TOK_L_NOT emit TOK_CJUMP emit LT_FOR_2 E_PUSH_LT emit LT_FOR_1 E_PUSH_LT + "Next" emit TOK_FOR_NEXT emit TOK_CJUMP NEXT_VARNAME E_POP_FOR emit TOK_FOR_EXIT "ELSE" emit TOK_JUMP E_ELSE "ELIF" emit TOK_JUMP E_ELIF FORCE_BOOL_EXPR emit TOK_CJUMP emit LT_IF E_PUSH_LT "ENDif" E_POP_IF @@ -446,26 +538,40 @@ PARSE_LINE: "SEtcolor" EXPR emit TOK_NUM word COLOR0 emit TOK_ADD "," EXPR_AB emit TOK_POKE "SOund" EXPR emit TOK_USHL emit TOK_NUM word AUDF1 emit TOK_ADD "," EXPR "," EXPR_AB emit TOK_SHL8 emit TOK_ADD emit TOK_DPOKE emit TOK_NUM word AUDCTL emit TOK_0 emit TOK_POKE emit TOK_NUM word SKCTL emit TOK_BYTE emit 3 emit TOK_POKE "SOund" emit TOK_SOUND_OFF - "DIm" DIM_LIST + "DIm" DIM_VAR DIM_MORE "CLose" IO_CHAN emit TOK_CLOSE - "Open" IO_CHAN "," emit TOK_BYTE emit OPEN XIO_EXPR - "Xio" IO_CHAN "," EXPR "," XIO_EXPR - "BPut" IO_CHAN "," EXPR "," EXPR emit TOK_BPUT - "BGet" IO_CHAN "," EXPR "," EXPR emit TOK_BGET + "Open" IO_CHAN_COMMA emit TOK_BYTE emit OPEN XIO_EXPR + "Xio" IO_CHAN_COMMA EXPR "," XIO_EXPR + "BPut" IO_CHAN_COMMA EXPR_2 emit TOK_BPUT + "BGet" IO_CHAN_COMMA EXPR_2 emit TOK_BGET "PAuse" EXPR emit TOK_PAUSE "INC" VAR_WORD_LVALUE emit TOK_INC + "DEC" VAR_WORD_LVALUE emit TOK_DEC "PROc" emit TOK_JUMP emit LT_PROC_1 E_PUSH_LT E_LABEL_DEF emit LT_PROC_2 E_PUSH_LT "ENDProc" E_POP_PROC_2 emit TOK_RET E_POP_PROC_1 "EXEC" emit TOK_CALL E_LABEL - "Data" emit TOK_VAR_ADDR E_VAR_CREATE "()" emit TOK_CDATA emit LT_DATA E_PUSH_LT DATA_TYPE DATA_END - "Data" DATA_TYPE DATA_END - "END" EOS emit TOK_END - VAR_WORD_LVALUE ASSIGN_EXPR emit TOK_DPOKE - VAR_BYTE_LVALUE ASSIGN_EXPR emit TOK_POKE - VAR_STR_LVALUE ASSIGN_STR emit TOK_COPY_STR + "Data" DATA_VAR DATA_TYPE DATA_END + "END" emit TOK_END +#@if FASTBASIC_FP + "DEG" emit TOK_BYTE emit DEGFLAG emit TOK_BYTE emit DEGFLAG_DEG emit TOK_POKE + "RAD" emit TOK_BYTE emit DEGFLAG emit TOK_BYTE emit DEGFLAG_RAD emit TOK_POKE +#@endif FASTBASIC_FP + +PARSE_LINE_ASSIGN: + VAR_WORD_LVALUE EQUAL EXPR emit TOK_DPOKE + VAR_BYTE_LVALUE EQUAL EXPR emit TOK_POKE + VAR_STR_LVALUE EQUAL STR_EXPR emit TOK_COPY_STR +#@if FASTBASIC_FP + VAR_FP_LVALUE EQUAL FP_EXPR emit TOK_FP_STORE +#@endif FASTBASIC_FP + +EOS: + ":" PARSE_START + E_EOL PARSE_START: - E_EOL - PARSE_LINE EOS PARSE_START + EOS + PARSE_LINE_COMMAND EOS + PARSE_LINE_ASSIGN EOS # vi:syntax=perl diff --git a/src/csynt.cc b/src/csynt.cc index 30fadf2..c6df222 100644 --- a/src/csynt.cc +++ b/src/csynt.cc @@ -23,29 +23,30 @@ #include "synt-parse.h" #include "synt-wlist.h" #include "synt-sm.h" +#include "synt-read.h" #include #include #include #include -bool p_file(parseState &p) +bool p_file(parseState &p, std::ostream &out) { // Output header - std::cout << "// Syntax state machine\n\n"; + out << "// Syntax state machine\n\n"; while(1) { wordlist tok(p, "TOKENS", 1); if( !tok.parse() ) break; - std::cout << "static const char * TOKENS[" << 1 + tok.next() << "] {\n"; + out << "static const char * TOKENS[" << 1 + tok.next() << "] {\n"; std::vector sorted_toks(tok.next()); for(auto i: tok.map()) sorted_toks[i.second] = i.first; for(auto i: sorted_toks) - std::cout << " \"" << i << "\",\n"; - std::cout << "\t\"LAST_TOKEN\"\n};\n"; + out << " \"" << i << "\",\n"; + out << "\t\"LAST_TOKEN\"\n};\n"; std::cerr << "syntax: " << tok.next() << " possible tokens.\n"; } @@ -54,7 +55,7 @@ bool p_file(parseState &p) { int n = 128; for(auto i: ext.map()) - std::cout << "extern bool SMB_" << i.first << "(parse &s);\n"; + out << "extern bool SMB_" << i.first << "(parse &s);\n"; for(auto i: ext.map()) { i.second = n++; @@ -80,31 +81,23 @@ bool p_file(parseState &p) // Emit labels table int ns = ext.next(); for(auto &sm: sm_list) - std::cout << "static bool SMB_" << sm.second->name() << "(parse &s);\t// " << ns++ << "\n"; + out << "static bool SMB_" << sm.second->name() << "(parse &s);\t// " << ns++ << "\n"; // Emit state machine tables - std::cout << "\n"; + out << "\n"; for(auto &sm: sm_list) - sm.second->print(); + sm.second->print(out); std::cerr << "syntax: " << (ns-128) << " tables in the parser-table.\n"; return true; } -static std::string readInput() +int main(int argc, const char **argv) { - std::string r; - int c; - while( -1 != (c = std::cin.get()) ) - r += char(c); - return r; -} - -int main() -{ - std::string inp = readInput(); + options opt(argc, argv); + std::string inp = readInput(opt.defs, opt.input()); parseState ps(inp.c_str()); - p_file(ps); + p_file(ps, opt.output()); return 0; } diff --git a/src/editor.bas b/src/editor.bas index ea74442..5f82718 100644 --- a/src/editor.bas +++ b/src/editor.bas @@ -3,12 +3,6 @@ ' ---------------------------------------- ' -'------------------------------------- -' M/L routine to search the end of line -data CountLines() byte = $68,$85,$FD,$68,$85,$FC,$68,$85,$FF,$68,$85,$FE,$E6,$FC,$E6,$FD,$A0, -data byte = $00,$B1,$FE,$C6,$FC,$D0,$04,$C6,$FD,$F0,$0A,$E6,$FE,$D0,$02,$E6,$FF, -data byte = $C9,$9B,$D0,$EC,$A5,$FE,$A6,$FF,$60 - '------------------------------------- ' Array definitions dim ScrAdr(24), ScrLen(24) @@ -169,21 +163,21 @@ PROC CompileFile poke MemEnd, $9B pos. 1,0 ? "œ Parsing: "; - line = USR( @compile_buffer, key, Adr(MemStart), MemEnd+1) - 1 - column = peek( @@bmax ) - if key and line < 0 + if USR( @compile_buffer, key, Adr(MemStart), MemEnd+1) + ' Parse error, go to error line + line = peek(@@linenum) - 1 + column = peek( @@bmax ) + if line < 10 + scrLine = line + else + scrLine = 10 + endif + get key + elif key exec SaveCompiledFile else get key endif - if line < 0 - line = 0 - endif - if line < 10 - scrLine = line - else - scrLine = 10 - endif line = line - scrLine exec InitScreen exec RedrawScreen @@ -208,6 +202,14 @@ PROC DeleteChar linLen = linLen - 1 ptr = Adr(EditBuf) + column move ptr+1, ptr, linLen - column + exec ForceDrawCurrentLine +ENDPROC + +'------------------------------------- +' Draws current line from edit buffer +' and move cursor to current position +' +PROC ForceDrawCurrentLine hDraw = -1 exec DrawCurrentLine ENDPROC @@ -433,7 +435,7 @@ ENDPROC '------------------------------------- ' Calls 'CountLines PROC CountLines - nptr = USR(adr(CountLines), ptr, MemEnd - ptr) + nptr = USR(@Count_Lines, ptr, MemEnd - ptr) ENDPROC '------------------------------------- @@ -464,6 +466,28 @@ PROC ScrollUp exec DrawLineOrig ENDPROC +'------------------------------------- +' Moves the cursor down 1 line +PROC CursorDown + if scrLine = 22 + exec ScrollUp + else + inc line + inc scrLine + endif +ENDPROC + +'------------------------------------- +' Moves the cursor up 1 line +PROC CursorUp + if scrLine + scrLine = scrLine - 1 + line = line - 1 + else + exec ScrollDown + endif +ENDPROC + '------------------------------------- ' Redraws entire screen ' @@ -564,8 +588,7 @@ do put key poke @DSPFLG, 0 else - hDraw = -1 - exec DrawCurrentLine + exec ForceDrawCurrentLine endif endif else @@ -601,8 +624,8 @@ do pos. 0, scrLine+1 put 157 ' Move screen pointers - -move Adr(ScrLen) + scrLine * 2, Adr(ScrLen) + scrLine * 2 + 2, (22 - scrLine) * 2 - -move Adr(ScrAdr) + scrLine * 2, Adr(ScrAdr) + scrLine * 2 + 2, (22 - scrLine) * 2 + -move Adr(ScrLen) + scrLine * 2, Adr(ScrLen) + (scrLine+1) * 2, (22 - scrLine) * 2 + -move Adr(ScrAdr) + scrLine * 2, Adr(ScrAdr) + (scrLine+1) * 2, (22 - scrLine) * 2 ' Save new line position ScrAdr(scrLine) = newPtr ScrLen(scrLine) = newLen @@ -638,8 +661,8 @@ do y = scrLine exec DrawLineOrig edited = 0 - hDraw = -1 lDraw = 22 + hDraw = -1 exec ChgLine ' '--------- Backspace ------------ @@ -692,50 +715,26 @@ do '--------- Control-U (page up)--- elif key = $15 for i=0 to 18 - if scrLine > 0 - scrLine = scrLine - 1 - line = line - 1 - else - exec ScrollDown - endif + exec CursorUp next i exec ChgLine ' '--------- Control-V (page down)- elif key = $16 for i=0 to 18 - if scrLine < 22 - scrLine = scrLine + 1 - line = line + 1 - else - exec ScrollUp - endif + exec CursorDown next i exec ChgLine ' '--------- Down ----------------- elif key = $1D - if linLen >= 0 - if scrLine = 22 - exec ScrollUp - else - inc line - inc scrLine - endif - exec ChgLine - endif + exec CursorDown + exec ChgLine ' '--------- Up ------------------- elif key = $1C - if line > 0 - if not scrLine - exec ScrollDown - else - line = line - 1 - scrLine = scrLine - 1 - endif - exec ChgLine - endif + exec CursorUp + exec ChgLine ' '--------- Control-Q (exit) ----- elif key = $11 @@ -784,9 +783,8 @@ do elif key = $1A if edited edited = 0 - hDraw = -1 exec CopyToEdit - exec DrawCurrentLine + exec ForceDrawCurrentLine else put @@ATBEL endif diff --git a/src/errors.asm b/src/errors.asm index e6a2d7f..bd3b0a9 100644 --- a/src/errors.asm +++ b/src/errors.asm @@ -19,36 +19,11 @@ ; Parser error messages ; --------------------- - .export print_error - - ; From runtime.asm - .import putc - - -; Prints an error message -.proc print_error - tax - ldy #$FF -nxt: iny - lda error_msg, y - bpl nxt - dex - bpl nxt - ; And print -ploop: iny - lda error_msg, y - pha - and #$7F - jsr putc - pla - bpl ploop - sec - rts -.endproc + .export error_msg_list ; Keep in line with error definitions .data -error_msg: +error_msg_list: err_count .set -1 .macro def_error name, msg err_count .set err_count + 1 @@ -61,12 +36,11 @@ error_msg: .endmacro .byte $80 def_error ERR_LOOP, "bad loop error" - def_error ERR_VAR, "var not defined" def_error ERR_PARSE, "parse error" def_error ERR_NO_ELOOP, "no end loop/proc/if" def_error ERR_LABEL, "undef label" -.if (* - error_msg) > 255 +.if (* - error_msg_list) > 255 .error "Error, too many error messages" .endif .code diff --git a/src/fastbasic.cfg b/src/fastbasic.cfg index 9306bc1..ee24b94 100644 --- a/src/fastbasic.cfg +++ b/src/fastbasic.cfg @@ -28,7 +28,7 @@ SYMBOLS { __STARTADDRESS__: type = export, value = %S; } MEMORY { - ZP: file = "", define = yes, start = $0092, size = $0040; + ZP: file = "", define = yes, start = $0094, size = $0040; # file header, just $FFFF HEADER: file = %O, start = $0000, size = $0002; @@ -38,7 +38,7 @@ MEMORY { MAIN: file = %O, define = yes, start = %S, size = $BC20 - %S; # code in zero page! IHEADER: file = %O, start = $0000, size = $0004; - INTERP: file = %O, define = yes, start = $0082, size = $0010; + INTERP: file = %O, define = yes, start = $0082, size = $0012; TRAILER: file = %O, start = $0000, size = $0006; } SEGMENTS { @@ -49,7 +49,7 @@ SEGMENTS { RUNTIME: load = MAIN, type = rw, define = yes; CODE: load = MAIN, type = rw, define = yes; DATA: load = MAIN, type = rw optional = yes, define = yes; - BSS: load = MAIN, type = bss, optional = yes, define = yes, align = $80; + BSS: load = MAIN, type = bss, optional = yes, define = yes; IHEADER: load = IHEADER, type = ro; INTERP: load = INTERP, type = rw; AUTOSTRT: load = TRAILER, type = ro, optional = yes; diff --git a/src/interpreter.asm b/src/interpreter.asm index c2811b5..50e578d 100644 --- a/src/interpreter.asm +++ b/src/interpreter.asm @@ -27,39 +27,62 @@ ; The opcode interpreter ; ---------------------- - .export interpreter_run, saved_cpu_stack - .exportzp interpreter_cptr + .export interpreter_run, saved_cpu_stack, stack_l, stack_h + .exportzp interpreter_cptr, var_count, sptr ; From allloc.asm .importzp var_buf, array_ptr, mem_end .import clear_data, alloc_array - ; From parser.asm - .importzp bptr, bpos ; From runtime.asm - .import umul16, sdiv16, smod16, neg_AX, read_word - .import print_word, getkey, getc, putc + .import umul16, neg_AX, read_word + .import divmod_sign_adjust + .import print_word, getkey, putc, putc_nosave .import move_up_src, move_up_dst, move_up .import move_dwn_src, move_dwn_dst, move_dwn - .import graphics, cio_close, close_all, sound_off - .importzp tmp1, tmp2, tmp3, tabpos - .importzp IOCHN, COLOR, IOERROR - - ; From io.asm + .import cio_close, close_all, sound_off .import getline, line_buf - ; Define our segment - .import __INTERP_LOAD__, __INTERP_RUN__, __INTERP_SIZE__ + .importzp tmp1, tmp2, tmp3, tabpos, divmod_sign + .importzp IOCHN, COLOR, IOERROR +.ifdef FASTBASIC_FP + ; Imported only in Floating Point version + .import print_fp, int_to_fp, read_fp + .exportzp DEGFLAG, DEGFLAG_RAD, DEGFLAG_DEG +.endif ; FASTBASIC_FP + .include "atari.inc" .zeropage -sptr = bpos ; Use bpos as stack pointe +var_count: + .res 1 -.define STACK_SIZE 64 + ; Integer stack, 40 * 2 = 80 bytes +.define STACK_SIZE 40 ; Our execution stack 64 words max, aligned for maximum speed stack_l = $480 stack_h = $480 + STACK_SIZE +.ifdef FASTBASIC_FP + ; FP stack pointer +fptr: .res 1 + ; Temporary store for INT TOS +fp_tmp_a: .res 1 +fp_tmp_x: .res 1 + ; DEG/RAD flag +DEGFLAG: .res 1 + + ; Floating point stack, 8 * 6 = 48 bytes. + ; Total stack = 128 bytes +.define FPSTK_SIZE 8 +fpstk_0 = stack_h + STACK_SIZE +fpstk_1 = fpstk_0 + FPSTK_SIZE +fpstk_2 = fpstk_1 + FPSTK_SIZE +fpstk_3 = fpstk_2 + FPSTK_SIZE +fpstk_4 = fpstk_3 + FPSTK_SIZE +fpstk_5 = fpstk_4 + FPSTK_SIZE +.endif ; FASTBASIC_FP + ;---------------------------------------------------------------------- ; This is the main threaded interpreter, jumps to the next @@ -68,27 +91,30 @@ stack_h = $480 + STACK_SIZE ; To execute faster, the code is run from page zero, using 16 bytes ; that include the pointer (at the "cload: LDY" instruction). The A ; and X registers are preserved across calls, and store the top of -; the 16bit stack. +; the 16bit stack. The Y register is loaded with the stack pointer +; (sptr). ; ; All the execution routines jump back to the next_instruction label, -; so the minimum time for an opcode is 28 cycles, this means we could -; execute at up to 63k opcodes per second. +; so the minimum time for an opcode is 30 cycles, this means we could +; execute at up to 58k opcodes per second. ; ; Code in ZP: (16 bytes) .segment "INTERP": zeropage .proc interpreter nxt_incsp: - inc sptr + inc z:sptr nxtins: cload: ldy $1234 ;4 inc z:cload+1 ;5 bne adj ;2 inc z:cload+2 ;1 (1 * 255 + 5 * 1) / 256 = 1.016 adj: sty z:jump+1 ;3 -jump: jmp (OP_JUMP) ;5 = 25 cycles per call +ldsptr: ldy #0 ;2 +jump: jmp (OP_JUMP) ;5 = 27 cycles per call .endproc +sptr = interpreter::ldsptr+1 cptr = interpreter::cload+1 next_instruction = interpreter::nxtins next_ins_incsp = interpreter::nxt_incsp @@ -110,10 +136,10 @@ interpreter_cptr = cptr jsr close_all ; Sound off jsr sound_off - ; Clear TAB position + ; Clear TAB position, IO channel and IO error lda #0 sta tabpos - ; And IO ERROR + sta IOCHN sta IOERROR ; Store current stack position to rewind on error tsx @@ -122,6 +148,12 @@ interpreter_cptr = cptr ; Init stack-pointer lda #STACK_SIZE sta sptr +.ifdef FASTBASIC_FP + lda #FPSTK_SIZE + sta fptr + lda #DEGFLAG_RAD + sta DEGFLAG +.endif ; FASTBASIC_FP ; Interpret opcodes jmp next_instruction @@ -152,10 +184,9 @@ interpreter_cptr = cptr ; Stores AX into stack, at return Y is the stack pointer. .proc pushAX dec sptr - ldy sptr - sta stack_l, y + sta stack_l-1, y txa - sta stack_h, y + sta stack_h-1, y rts .endproc @@ -168,7 +199,8 @@ interpreter_cptr = cptr ;.proc TOK_DUP ; jsr pushAX -; lda stack_l, y +; lda stack_l-1, y +; ldx stack_h-1, y ; jmp next_instruction ;.endproc @@ -183,25 +215,39 @@ interpreter_cptr = cptr bmi neg bne pos tax - beq zro + beq xit pos: lda #1 -zro: ldx #0 + ldx #0 beq xit neg: lda #$FF tax xit: jmp next_instruction - .endproc .proc TOK_ABS cpx #0 - bpl go_next_ins + bpl TOK_SGN::xit .endproc ; Fall through .proc TOK_NEG ; AX = -AX jsr neg_AX -xit: jmp next_instruction + jmp next_instruction +.endproc + +.proc TOK_DIV ; AX = (SP+) / AX + jsr divmod_sign_adjust + bit divmod_sign + bmi TOK_NEG + jmp next_instruction +.endproc + +.proc TOK_MOD ; AX = (SP+) % AX + jsr divmod_sign_adjust + lda tmp2 + ldx tmp2+1 + bit divmod_sign + bvs TOK_NEG + jmp next_instruction .endproc -go_next_ins= TOK_NEG::xit .proc TOK_USHL ; AX = AX * 2 (UNSIGNED) asl @@ -214,7 +260,6 @@ go_next_ins= TOK_NEG::xit .endproc .proc TOK_BIT_AND ; AX = (SP+) & AX - ldy sptr and stack_l, y pha txa @@ -225,7 +270,6 @@ go_next_ins= TOK_NEG::xit .endproc .proc TOK_BIT_OR ; AX = (SP+) | AX - ldy sptr ora stack_l, y pha txa @@ -236,7 +280,6 @@ go_next_ins= TOK_NEG::xit .endproc .proc TOK_BIT_EXOR ; AX = (SP+) ^ AX - ldy sptr eor stack_l, y pha txa @@ -250,7 +293,6 @@ TOK_SUB: jsr neg_AX ; Fall through .proc TOK_ADD ; AX = (SP+) + AX - ldy sptr clc adc stack_l, y pha @@ -262,32 +304,13 @@ TOK_SUB: .endproc .proc TOK_MUL ; AX = (SP+) * AX - ldy sptr sta tmp1 stx tmp1+1 lda stack_l, y ldx stack_h, y jsr umul16 - jmp next_ins_incsp -.endproc - -.proc TOK_DIV ; AX = (SP+) / AX - ldy sptr - sta tmp1 - stx tmp1+1 - lda stack_l, y - ldx stack_h, y - jsr sdiv16 - jmp next_ins_incsp -.endproc - -.proc TOK_MOD ; AX = (SP+) % AX - ldy sptr - sta tmp1 - stx tmp1+1 - lda stack_l, y - ldx stack_h, y - jsr smod16 + lda tmp1 ; Load the result + ldx tmp1+1 jmp next_ins_incsp .endproc @@ -298,15 +321,16 @@ TOK_SUB: .proc TOK_NUM ; AX = read from op (load byte first!) jsr pushAX - ldy #1 ; 2 - lda (cptr), y ; 5 - tax ; 2 - dey ; 2 - lda (cptr), y ; 5 - inc cptr ; 5 - beq adjust_cptr_1 ; 2 - inc cptr ; 5 - beq adjust_cptr ; 2=30 + ldy #1 ; 2 2 + lda (cptr), y ; 5 2 + tax ; 2 1 + dey ; 2 1 + lda (cptr), y ; 5 2 + + inc cptr ; 5 2 + beq adjust_cptr_1 ; 2 2 + inc cptr ; 5 2 + beq adjust_cptr ; 2=30 2=16 jmp next_instruction adjust_cptr_1: inc cptr @@ -337,20 +361,8 @@ adjust_cptr: pla bcs TOK_NUM::adjust_cptr_1 inc cptr - bne :+ - inc cptr+1 -: jmp next_instruction -.endproc - -.proc TOK_CDATA ; AX = address of data - jsr pushAX - ldx cptr+1 - lda cptr - clc - adc #2 - bcc :+ - inx -: jmp TOK_JUMP + beq TOK_NUM::adjust_cptr + jmp next_instruction .endproc ; Array dimensioning - assigns an address to given array variable @@ -363,16 +375,17 @@ adjust_cptr: bcs memory_error ret_a: lda #0 ret_x: ldx #0 + ldy sptr jmp TOK_DPOKE .endproc .proc memory_error ; Show message and ends - ldx #len + ldy #len-1 -: lda msg, x +: lda msg, y jsr putc - dex + dey bpl :- jmp TOK_END msg: .byte $9b, "rorrE yromeM", $9b @@ -386,7 +399,6 @@ len= * - msg txa pha ; Get destination pointer - allocate if 0 - ldy sptr lda stack_l, y sta tmp1 lda stack_h, y @@ -435,7 +447,6 @@ cloop: lda (tmp1), y .proc TOK_DPOKE ; DPOKE (SP++), AX pha - ldy sptr lda stack_h, y .if 0 sta tmp1+1 @@ -468,21 +479,109 @@ pop_stack_2: jmp next_ins_incsp .endproc +.proc TOK_MOVE ; move memory up + pha + lda stack_l, y + sta move_up_dst + lda stack_h, y + sta move_up_dst+1 + lda stack_l+1, y + sta move_up_src + lda stack_h+1, y + sta move_up_src+1 + pla + jsr move_up pop_stack_3: inc sptr bne pop_stack_2 +.endproc + + ; Remove the FOR arguments from the stack! +TOK_FOR_EXIT = TOK_MOVE::pop_stack_3 +.proc TOK_XIO + jsr get_str_eol + ldx IOCHN + tya + clc + adc INBUFF + sta ICBAL, x + lda #0 + sta ICBLH, x + adc INBUFF+1 + sta ICBAH, x + lda #$FF + sta ICBLL, x + ldy sptr + lda stack_l, y + sta ICAX1, x + lda stack_h, y + sta ICAX2, x + lda stack_l+1, y + inc sptr +is_cio: inc sptr +.endproc ; Fall through + ; Calls CIO with given command, stores I/O error, resets IOCHN, pops stack +CIOV_CMD_POP: + sta ICCOM, x ; Calls CIOV, stores I/O error, resets IOCHN and pops stack .proc CIOV_POP jsr CIOV ioerr: sty IOERROR iochn0: - lda #0 - sta IOCHN + ldy #0 + sty IOCHN beq pop_stack .endproc +.proc TOK_IOCHN0 + ldy #0 + sty IOCHN + jmp next_instruction +.endproc + +.proc TOK_BPUT + ldy #PUTCHR + .byte $2C ; Skip 2 bytes over next "LDY" +.endproc ; Fall through +.proc TOK_BGET + ldy #GETCHR + sty setcom+1 + tay + txa + + ldx IOCHN + + sta ICBLH, x + tya + sta ICBLL, x ; Length + + ldy sptr + lda stack_l, y + sta ICBAL, x ; Address + lda stack_h, y + sta ICBAH, x + +setcom: lda #0 + bne TOK_XIO::is_cio ; Note: A is never 0 +.endproc + +.proc TOK_NMOVE ; move memory down + pha + lda stack_l, y + sta move_dwn_dst + lda stack_h, y + sta move_dwn_dst+1 + lda stack_l+1, y + sta move_dwn_src + lda stack_h+1, y + sta move_dwn_src+1 + pla + jsr move_dwn + jmp TOK_MOVE::pop_stack_3 +.endproc + .proc TOK_PEEK ; AX = *(AX) .if 0 sta tmp1 @@ -509,6 +608,18 @@ loadH: inc $FF01, x : jmp pop_stack .endproc +.proc TOK_DEC ; DPOKE(AX, DPEEK(AX) - 1) + stx loadH+2 + stx loadL1+2 + stx loadL2+2 + tax +loadL1: ldy $FF00, x + bne loadL2 +loadH: dec $FF01, x +loadL2: dec $FF00, x + jmp pop_stack +.endproc + .proc TOK_VAR_LOAD ; AX = value of variable jsr get_op_var ; Fall through: @@ -537,18 +648,19 @@ loadL: lda $FF00, y ; Stores an EOL at end of string, to allow calling SIO routines .proc get_str_eol - sta bptr - stx bptr+1 + sta INBUFF + stx INBUFF+1 ; Get length ldy #0 - lda (bptr), y + lda (INBUFF), y tay iny bne ok dey ; String too long, just overwrite last character ok: lda #$9B - sta (bptr), y + sta (INBUFF), y ldy #1 + sty CIX rts .endproc @@ -583,25 +695,21 @@ retry: ldx 19 jmp next_instruction .endproc -.proc TOK_RAND ; AX= RANDDOM from 0 to AX-1 +.proc TOK_RAND ; AX= RANDOM from 0 to AX-1 - ; First get a mask from the value-1 + ldy #$80 stx tmp1+1 - cpx #0 - bmi ok - ldy #0 -get_l: iny +get_l: dey + beq xit asl rol tmp1+1 bpl get_l -ok: sta tmp1 ; Now, get a number in the range -retry: lda RANDOM - tax - cmp tmp1 +retry: ldx RANDOM + cpx tmp1 lda RANDOM sta tmp2 sbc tmp1+1 @@ -609,14 +717,12 @@ retry: lda RANDOM ; And scale back txa - cpy #0 - beq xit scale: lsr tmp2 ror - dey - bne scale -xit: ldx tmp2 - jmp next_instruction + iny + bpl scale + ldx tmp2 +xit: jmp next_instruction .endproc .proc TOK_GETKEY @@ -633,68 +739,98 @@ xit: ldx tmp2 .endproc .proc TOK_L_OR ; A = A | (SP+) - ldy sptr ora stack_l, y jmp next_ins_incsp .endproc .proc TOK_L_AND ; A = A & (SP+) - ldy sptr and stack_l, y jmp next_ins_incsp .endproc .proc TOK_FOR + ; Store STEP into stack and HI part to temporary + stx tmp2+1 jsr pushAX - ; In stack we have: - ; y = step - ; y+1 = limit - ; y+2 = var_address - ; Read variable value, compare with limit + + ; Jumps to original FOR with a fake STEP=0, skips the + ; first addition: + ldx #0 stx tmp2 - lda stack_h+2, y + beq TOK_FOR_NEXT_INIT +.endproc + +.proc TOK_FOR_NEXT + ; Store STEP into stack (and also to temporary) + sta tmp2 + stx tmp2+1 + jsr pushAX + +::TOK_FOR_NEXT_INIT: + ; In stack we have: + ; y-1 = step + ; y = limit + ; y+1 = var_address + ; Read variable address value + lda stack_h+1, y sta tmp1+1 - lda stack_l+2, y + lda stack_l+1, y sta tmp1 - ldy #1 - lda (tmp1), y + ; Copy LIMIT to the stack + lda stack_l, y + sta stack_l-2, y + lda stack_h, y + sta stack_h-2, y + dec sptr + + ; Get STEP again into AX + lda tmp2 + + ; Adds STEP to VAR + clc + ldy #0 + adc (tmp1), y + sta (tmp1), y + pha + iny + txa + adc (tmp1), y + sta (tmp1), y tax - dey - lda (tmp1), y - ; Now, compare with limit - jsr pushAX - lda stack_l+2, y - ldx stack_h+2, y - asl tmp2 - bcs TOK_GEQ -positive: - ; Fall through -.endproc + pla -.proc TOK_LEQ ; AX = (SP+) <= AX + ; Now we have LIMIT and VAR in stack, compare ldy sptr - cmp stack_l, y - txa - sbc stack_h, y - bvc :+ - eor #$80 -: bmi set0 - bpl set1 + + ; Check sign of STEP + bit tmp2+1 + bmi TOK_GT +positive: + ; Fall through .endproc -.proc TOK_GEQ ; AX = (SP+) >= AX +.proc TOK_LT ; AX = (SP+) >= AX sta tmp1 stx tmp1+1 - ldy sptr lda stack_l, y cmp tmp1 lda stack_h, y sbc tmp1+1 bvc :+ eor #$80 -: bpl set1 - bmi set0 +: bpl set0 + bmi set1 +.endproc + +.proc TOK_GT ; AX = (SP+) <= AX + cmp stack_l, y + txa + sbc stack_h, y + bvc :+ + eor #$80 +: bmi set1 + bpl set0 .endproc TOK_0: @@ -716,7 +852,6 @@ TOK_1: .endproc .proc TOK_NEQ ; AX = AX != (SP+) - ldy sptr cmp stack_l, y bne set1 txa @@ -727,7 +862,6 @@ TOK_1: .endproc .proc TOK_EQ ; AX = AX == (SP+) - ldy sptr cmp stack_l, y bne set0 txa @@ -737,10 +871,11 @@ TOK_1: .endproc .proc TOK_COMP_0 ; AX = AX != 0 - stx tmp1 - ora tmp1 + tay + bne ret_1 + txa beq ret_0 - lda #1 +ret_1: lda #1 ldx #0 ret_0: jmp next_instruction .endproc @@ -789,10 +924,15 @@ nil: jmp pop_stack .proc TOK_GET jsr pushAX - jsr getc + ldx IOCHN + lda #GETCHR + sta ICCOM, x + lda #0 + sta ICBLL, x + sta ICBLH, x + jsr CIOV sty IOERROR ldx #0 - stx IOCHN jmp next_instruction .endproc @@ -816,7 +956,6 @@ no_eol: .proc TOK_POKE ; POKE (SP++), AX tax - ldy sptr lda stack_h, y .if 0 sta tmp1+1 @@ -835,10 +974,19 @@ save: sta $FF00, x jmp pop_stack_2 .endproc - +.proc TOK_CDATA ; AX = address of data + jsr pushAX + ldx cptr+1 + lda cptr + clc + adc #2 + bcc :+ + inx +: ; ldy sptr ; TOK_JUMP does not use Y=sptr +.endproc ; Fall through .proc TOK_JUMP - sta save_a+1 -no_a: stx save_x+1 + pha + stx save_x+1 ldy #1 lda (cptr), y tax @@ -846,13 +994,13 @@ no_a: stx save_x+1 lda (cptr), y sta cptr stx cptr+1 -save_a: lda #$ff save_x: ldx #$ff + pla jmp next_instruction .endproc .proc TOK_CALL - sta TOK_JUMP::save_a+1 + tay lda cptr clc adc #2 @@ -860,7 +1008,8 @@ save_x: ldx #$ff lda cptr+1 adc #0 pha - jmp TOK_JUMP::no_a + tya + bcc TOK_JUMP .endproc .proc TOK_RET @@ -874,7 +1023,7 @@ save_x: ldx #$ff .endproc .proc TOK_CJUMP - cmp #0 + tay bne skip ldy #1 lda (cptr), y @@ -901,7 +1050,6 @@ adjust_cptr: ; AX = start value ; y = var_address pha - ldy sptr lda stack_h, y sta save_l+2 sta save_h+2 @@ -913,97 +1061,31 @@ save_l: sta $FF00, x jmp pop_stack .endproc -.proc TOK_FOR_NEXT - sta tmp2 - ; In stack we have: - ; AX = step - ; y = limit - ; y+1 = var_address - ; Read variable value, add to step and store into variable - ldy sptr - lda stack_h+1, y - sta tmp1+1 - lda stack_l+1, y - sta tmp1 - - ldy #0 - clc - lda tmp2 - adc (tmp1), y - sta (tmp1), y - iny - txa - adc (tmp1), y - sta (tmp1), y - lda tmp2 - jmp next_instruction -.endproc - - ; Remove the FOR arguments from the stack! -TOK_FOR_EXIT = pop_stack_3 - -.proc TOK_MOVE ; move memory up - ldy sptr - pha - lda stack_l, y - sta move_up_dst - lda stack_h, y - sta move_up_dst+1 - lda stack_l+1, y - sta move_up_src - lda stack_h+1, y - sta move_up_src+1 - pla - jsr move_up - jmp pop_stack_3 -.endproc - -.proc TOK_NMOVE ; move memory down - ldy sptr - pha - lda stack_l, y - sta move_dwn_dst - lda stack_h, y - sta move_dwn_dst+1 - lda stack_l+1, y - sta move_dwn_src - lda stack_h+1, y - sta move_dwn_src+1 - pla - jsr move_dwn - jmp pop_stack_3 -.endproc - .proc TOK_GRAPHICS ; OPEN #6,12,0, - jsr graphics - sty IOERROR - jmp pop_stack + sta tmp1 + ldx #$60 + jsr cio_close + lda tmp1 + and #$F0 + eor #$1C ; Get AUX1 from BASIC mode + sta ICAX1, x + lda tmp1 ; And AUX2 + sta ICAX2, x + lda #device_s + sta ICBAH, x + lda #OPEN + jmp CIOV_CMD_POP +device_s: .byte "S:", $9B .endproc - .include "atari.inc" - .proc TOK_PLOT jsr pushAX ldy COLOR ldx #$60 ; IOCB #6 - lda ICAX1,X - sta ICAX1Z - lda ICAX2,X - sta ICAX2Z - jsr putchar_io - sty IOERROR - jmp pop_stack -.endproc - -; Calls PUTCHAR for I/O channel X -.proc putchar_io - lda ICPTH,X - pha - lda ICPTL,X - pha - tya - ldy #$5C - rts + jsr putc_nosave + jmp CIOV_POP::ioerr .endproc TOK_FILLTO: @@ -1012,6 +1094,7 @@ TOK_FILLTO: .proc TOK_DRAWTO ldy #DRAWLN sty ICCOM+$60 + ldy sptr jsr pushAX lda COLOR sta ATACHR @@ -1026,68 +1109,14 @@ TOK_FILLTO: .proc TOK_CLOSE jsr pushAX ldx IOCHN - jsr cio_close - jmp CIOV_POP::ioerr -.endproc - -.proc TOK_BPUT - ldy #PUTCHR - .byte $2C ; Skip 2 bytes over next "LDY" -.endproc ; Fall through -.proc TOK_BGET - ldy #GETCHR - sty setcom+1 - stx save_x+1 - - ldx IOCHN - - sta ICBLL, x ; Length -save_x: lda #0 - sta ICBLH, x - - ldy sptr - lda stack_l, y - sta ICBAL, x ; Address - lda stack_h, y - sta ICBAH, x - -setcom: lda #0 - sta ICCOM, x - inc sptr - jmp CIOV_POP -.endproc - -.proc TOK_XIO - jsr get_str_eol - ldy bptr+1 - inc bptr - bne :+ - iny -: ldx IOCHN - tya - sta ICBAH, x - lda bptr - sta ICBAL, x - lda #0 - sta ICBLH, x - lda #$FF - sta ICBLL, x - ldy sptr - lda stack_l, y - sta ICAX1, x - lda stack_h, y - sta ICAX2, x - lda stack_l+1, y - sta ICCOM, x - inc sptr - inc sptr - jmp CIOV_POP + lda #CLOSE + jmp CIOV_CMD_POP .endproc .proc TOK_SOUND_OFF - sta save_a+1 + pha jsr sound_off -save_a: lda #0 + pla jmp next_instruction .endproc @@ -1131,6 +1160,674 @@ wait: lda RTCLOK+2 jump: jmp $FFFF .endproc +; Following two routines are only used in FP version +; TODO: Should move to a different source file +.ifdef FASTBASIC_FP + + ; Save INT stack to temporary, push FP stack +.proc save_push_fr0 + sta fp_tmp_a + stx fp_tmp_x + ; Fall through +.endproc + ; Push FP stack, FR0 remains unchanged. +.proc push_fr0 + dec fptr + ldy fptr + lda FR0+0 + sta fpstk_0, y + lda FR0+1 + sta fpstk_1, y + lda FR0+2 + sta fpstk_2, y + lda FR0+3 + sta fpstk_3, y + lda FR0+4 + sta fpstk_4, y + lda FR0+5 + sta fpstk_5, y + rts +.endproc + + ; Save INT stack to temporary, move FR0 to FR1 + ; and pop stack to FR0 +.proc save_pop_fr1 + sta fp_tmp_a + stx fp_tmp_x + jsr FMOVE + ; Fall through +.endproc + ; Pops FP stack discarding FR0 +.proc pop_fr0 + ldy fptr + inc fptr + lda fpstk_0, y + sta FR0 + lda fpstk_1, y + sta FR0+1 + lda fpstk_2, y + sta FR0+2 + lda fpstk_3, y + sta FR0+3 + lda fpstk_4, y + sta FR0+4 + lda fpstk_5, y + sta FR0+5 + rts +.endproc + +.proc TOK_INT_FP ; Convert INT to FP + ; Save INT stack, push FP stack + jsr save_push_fr0 + ; Restore TOS + lda fp_tmp_a + ldx fp_tmp_x + ; Convert to FP + jsr int_to_fp + ; Discard top of INT stack + jmp pop_stack +.endproc + +.proc TOK_FP_INT ; Convert FP to INT, with rounding + jsr pushAX + asl FR0 + ror tmp1 ; Store sign in tmp1 + lsr FR0 + jsr FPI + bcs err3 + ldx FR0+1 + bpl ok + ; Store error #3 +err3: lda #3 + sta IOERROR + ; Negate result if original number was negative +ok: lda FR0 + ldy tmp1 + bpl pos + jsr neg_AX + ; Store and pop FP stack +pos: jsr save_pop_fr1 + jmp fp_return_interpreter +.endproc + +.proc TOK_PRINT_FP ; PRINT (SP+) + ; Store integer stack. + sta fp_tmp_a + stx fp_tmp_x + jsr print_fp + jsr pop_fr0 + jmp fp_return_interpreter +.endproc + +.proc fp_ldfr0 + jsr pushAX + lda FR0 + rts +.endproc + +.proc TOK_FP_EQ + jsr fp_ldfr0 + bne fp_set0 + ; Fall through +.endproc +.proc fp_set1 + jsr pop_fr0 + lda #1 + ldx #0 + jmp next_instruction +.endproc + +.proc TOK_FP_GEQ + jsr fp_ldfr0 + bpl fp_set1 + bmi fp_set0 +.endproc + +.proc TOK_FP_GT + jsr fp_ldfr0 + beq fp_set0 + bpl fp_set1 + ; Fall through +.endproc +.proc fp_set0 + jsr pop_fr0 + lda #0 + txa + jmp next_instruction +.endproc + +.proc TOK_FP_ADD + jsr save_pop_fr1 + jsr FADD + jmp check_fp_err +.endproc + +.proc TOK_FP_SUB + jsr save_pop_fr1 + jsr FSUB + jmp check_fp_err +.endproc + +.proc TOK_FP_MUL + jsr save_pop_fr1 + jsr FMUL + jmp check_fp_err +.endproc + +.proc TOK_FP_DIV + jsr save_pop_fr1 + jsr FDIV + jmp check_fp_err +.endproc + +.proc TOK_FP_ABS + asl FR0 +lft: lsr FR0 + jmp next_instruction +.endproc + +.proc TOK_FP_NEG + asl FR0 + beq ok + bcs TOK_FP_ABS::lft + sec + ror FR0 +ok: jmp next_instruction +.endproc + +.proc TOK_FP_SGN + asl FR0 + beq zero + ldy #$80 + sty FR0 + ror FR0 + ldy #$10 + sty FR0+1 + ldy #0 + sty FR0+2 + sty FR0+3 + sty FR0+4 + sty FR0+5 +zero: jmp next_instruction +.endproc + +.proc TOK_FLOAT + jsr save_push_fr0 + + ldy #5 +ldloop: lda (cptr), y + sta FR0,y + dey + bpl ldloop + + lda cptr + clc + adc #6 + sta cptr + bcc fp_return_interpreter + inc cptr+1 + bcs fp_return_interpreter +.endproc + +.proc TOK_FP_VAL + jsr get_str_eol + jsr push_fr0 + jsr read_fp + bcc :+ + lda #18 + sta IOERROR +: jmp pop_stack +.endproc + +.proc TOK_FP_LOAD + stx FLPTR+1 + sta FLPTR + jsr push_fr0 + jsr FLD0P + jmp pop_stack +.endproc + +.proc TOK_FP_STORE + stx FLPTR+1 + sta FLPTR + jsr FST0P + ; Pop FP stack + jsr pop_fr0 + jmp pop_stack +.endproc + +.proc TOK_FP_EXP + sta fp_tmp_a + stx fp_tmp_x + jsr EXP + ; Fall through +.endproc + + ; Checks FP error, restores INT stack + ; and returns to interpreter +.proc check_fp_err + ; Check error from last FP op + bcc ok +::fp_ret_err3: + lda #3 + sta IOERROR +ok: ; Fall through +.endproc +.proc fp_return_interpreter +; Restore INT stack + lda fp_tmp_a + ldx fp_tmp_x + jmp next_instruction +.endproc + +.proc TOK_FP_EXP10 + sta fp_tmp_a + stx fp_tmp_x + jsr EXP10 + jmp check_fp_err +.endproc + + ; Square Root: Copied from Altirra BASIC + ; Copyright (C) 2015 Avery Lee, All Rights Reserved. +.proc TOK_FP_SQRT +FPHALF= $DF6C + sta fp_tmp_a + stx fp_tmp_x + + ; Store original X + ldx #FPSCR + jsr FST0R + + lda FR0 + beq fp_return_interpreter ; X=0, we are done + bmi fp_ret_err3 ; X<0, error 3 + + ; Calculate new exponent: E' = (E-$40)/2+$40 = (E+$40)/2 + clc + adc #$40 ;!! - also clears carry for loop below + sta FR0 + + ; Compute initial guess, using a table + ldx #9 + stx tmp2 ;!! Also set 4 iterations (by asl) + lda #$00 +guess_loop: + adc #$11 + dex + ldy approx_compare_tab,x + cpy FR0+1 + bcc guess_loop +guess_ok: + ; Divide exponent by two, use lower guess digit if even + lsr FR0 + bcs no_tens + and #$0f +no_tens: + sta FR0+1 + +iter_loop: + ; Y = (Y + X/Y) * (1/2) + ldy #>PLYARG + ldx #FPSCR + jsr FLD0R ; FR0 = X + jsr FDIV ; FR0 = FR0/FR1 = X/Y + ldy #>PLYARG + ldx #FPHALF + jsr FLD1R ; FR1 = 0.5 + jsr FMUL ; FR0 = FR0 * FR1 = (X/Y + Y)/2 + + ;loop back until iterations completed + asl tmp2 + bpl iter_loop + bmi fp_return_interpreter + +approx_compare_tab: + .byte $ff,$87,$66,$55,$36,$24,$14,$07,$02 +.endproc + +.proc TOK_FP_LOG + sta fp_tmp_a + stx fp_tmp_x + jsr LOG + jmp check_fp_err +.endproc + +.proc TOK_FP_LOG10 + sta fp_tmp_a + stx fp_tmp_x + jsr LOG10 + jmp check_fp_err +.endproc + + ; Computes FR0 ^ (AX) +.proc TOK_FP_IPOW + + ; Store exponent + sta tmp1 + stx tmp1+1 + + ; If negative, get absolute value + cpx #$80 + bcc ax_pos + jsr neg_AX + ; Change mantisa to 1/X + sta tmp1 + stx tmp1+1 + + jsr FMOVE + jsr FP_SET_1 + jsr FDIV + +ax_pos: + ; Skip all hi bits == 0 + ldy #17 +skip: + dey + beq xit_1 + asl tmp1 + rol tmp1+1 + bcc skip + + sty tmp2 + ; Start with FR0 = X, store to PLYEVL + ldx #PLYARG + jsr FST0R +loop: + ; Check exit + dec tmp2 + beq xit + + ; Square, FR0 = x^2 + jsr FMOVE + jsr FMUL + bcs error + + ; Check next bit + asl tmp1 + rol tmp1+1 + bcc loop + + ; Multiply, FR0 = FR0 * x + ldx #PLYARG + jsr FLD1R + jsr FMUL + + ; Continue loop + bcc loop +error: lda #3 + sta IOERROR + +xit_1: jsr FP_SET_1 +xit: jmp pop_stack +.endproc + + ; Load 1.0 to FR0 +.proc FP_SET_1 + jsr ZFR0 + lda #$40 + sta FR0 + lda #$01 + sta FR0+1 + rts +.endproc + + ; Returns a random FP number in the interval 0 <= X < 1 + ; Based on code from Altirra BASIC, (C) 2015 Avery Lee. +.proc TOK_FP_RND +FPNORM=$DC00 + jsr save_push_fr0 + + lda #$3F + sta FR0 + + ; Get 5 digits + ldx #5 +loop: + ; Retries until we get a valid BCD number +get_bcd_digit: + lda RANDOM + cmp #$A0 + bcs get_bcd_digit + sta FR0, x + and #$0F + cmp #$0A + bcs get_bcd_digit + dex + bne loop + + ; Re-normalize random value (for X < 0.01) and exit + jsr FPNORM + jmp check_fp_err +.endproc + + ; SIN function, using a minimax 5 degree polynomial: + ; SIN(Ï€/2 x) = ((((s[4] * x² + s[3]) * x² + s[2]) * x² + s[1]) * x² + s[0]) * x + ; + ; We use the polynomial: + ; S() = 1.57079633 -0.6459638821 0.0796901254 -0.00467416 0.00015158 + ; + ; Maximum relative error 1.23e-08, this is better than the 6 degree + ; poly in Atari BASIC, and 2 times worst than the 6 degree poly in + ; Altirra BASIC. + ; + ; The polynomial was found with a minimax approximation in [-1:1], and + ; then optimized by brute-force search to keep the total error bellow + ; 1.23E-8 and ensuring that the approximation is always <= 1.0, so no + ; adjustments are needed after calculation. + ; + ; As we expand the polynomial about SIN(Ï€/2 x), we also don't need to + ; take the modulus, we only divide the argument by Ï€/2 (or 90 if we are + ; in DEG mode), and this is exactly the first coefficient. + ; +sin_coef: + .byte $3E,$01,$51,$58,$00,$00 + .byte $BE,$46,$74,$16,$00,$00 + .byte $3F,$07,$96,$90,$12,$54 + .byte $BF,$64,$59,$63,$88,$21 +pi1_2: + .byte $40,$01,$57,$07,$96,$33 +fp_90: + .byte $40,$90,$00,$00,$00,$00 +fp_180pi: + .byte $40,$57,$29,$57,$79,$51 + +DEGFLAG_RAD = ATNCOEF +.endproc ; Fall through + ; Evaluates a polynomial in *odd* powers of X, as: + ; z = x^2 + ; y = x * P(z) + ; + ; On input, X:Y points to the coefficient table, + ; A is the number of coefficients. +.proc eval_poly_x2 + ; Store arguments + pha + txa + pha + tya + pha + + ; Store X (=FR0) into FPSCR + ldx #FPSCR + jsr FST0R + + ; Compute X^2 + jsr FMOVE + jsr FMUL + + ; Compute P(X^2) with our coefficients + pla + tay + pla + tax + pla + jsr PLYEVL + + ; Compute X * P(X^2) + ldx #FPSCR + jsr FLD1R + jmp FMUL +.endproc + +.proc TOK_FP_SIN + ldy #2 ; Negative SIN: quadrant #2 + bit FR0 + bmi SINCOS + ldy #0 ; Positive SIN: quadrant #0 + .byte $2C ; Skip 2 bytes over next "LDY" +.endproc ; Fall through + +.proc TOK_FP_COS + ldy #1 ; Positve/Negative COS: quadrant #1 +.endproc ; Fall trough + +.proc SINCOS +FPNORM=$DC00 + + sty tmp2 ; Store quadrant into tmp2 + + ; Save integer stack + sta fp_tmp_a + stx fp_tmp_x + + ; Divide by 90° or PI/2 + .assert (>pi1_2) = (>fp_90) , error, "PI/2 and 90 fp constants in different pages!" + ldx DEGFLAG + ldy #>pi1_2 + jsr FLD1R + jsr FDIV + bcs exit + + ; Get ABS of FR0 + lda FR0 + and #$7F + sta FR0 + cmp #$40 + bcc less_than_1 ; Small enough + cmp #$45 + bcs exit ; Too big + tax + + lda FR0-$40+1, x ; Get "tens" digit + and #$10 ; if even/odd + lsr + lsr + lsr ; get 0/2 + adc tmp2 ; add to quadrant (C is clear here) + adc FR0-$40+1, x ; and add the "ones" digit + sta tmp2 + + ; Now, get fractional part by setting digits to 0 + lda #0 +: sta FR0-$40+1, x + dex + cpx #$3F + bne :- + + jsr FPNORM + +less_than_1: + + ; Check if odd quadrant, compute FR0 = 1 - FR0 + lsr tmp2 + bcc no_mirror + jsr FMOVE + jsr FP_SET_1 + jsr FSUB +no_mirror: + + ; Compute FR0 * P(FR0^2) + ldx #sin_coef + lda #5 + jsr eval_poly_x2 + + ; Get sign into result, and clear carry + asl FR0 + beq exit + lsr tmp2 + ror FR0 +exit: + jmp check_fp_err + +.endproc + + + ; Compute arc-tangent of FR0 + ; Uses table of coefficients on ROM, shorter code, + ; reduced as: ATN(x) = PI/2 - ATN(1/x) if |x|>1.0 + ; +.proc TOK_FP_ATN + ; Save integer stack + sta fp_tmp_a + stx fp_tmp_x + + lda FR0 + asl + ror tmp2 + lsr + sta FR0 + asl + bpl small_arg + + ; Get 1/X + jsr FMOVE + jsr FP_SET_1 + jsr FDIV + jsr eval_atn_poly + ldx #pi1_2 + jsr FLD1R + jsr FSUB + bcc test_deg + +small_arg: + + jsr eval_atn_poly +test_deg: + ; Convert to degrees if needed: + lda DEGFLAG + cmp #DEGFLAG_DEG + bne not_deg + + ldx #fp_180pi + jsr FLD1R + jsr FMUL +not_deg: + ; Adds SIGN + asl FR0 + asl tmp2 + ror FR0 +exit: + jmp check_fp_err + +.endproc + +.endif ; FASTBASIC_FP + + ; From parse.asm - MUST KEEP IN SAME ORDER! .segment "JUMPTAB" @@ -1151,11 +1848,11 @@ OP_JUMP: ; Boolean operators .word TOK_L_NOT, TOK_L_OR, TOK_L_AND ; Comparisons - .word TOK_GEQ, TOK_LEQ, TOK_NEQ, TOK_EQ + .word TOK_LT, TOK_GT, TOK_NEQ, TOK_EQ ; Convert from int to bool .word TOK_COMP_0 ; Low level statements - .word TOK_POKE, TOK_DPOKE, TOK_MOVE, TOK_NMOVE, TOK_INC + .word TOK_POKE, TOK_DPOKE, TOK_MOVE, TOK_NMOVE, TOK_INC, TOK_DEC ; Graphic support statements .word TOK_GRAPHICS, TOK_PLOT, TOK_DRAWTO, TOK_FILLTO ; Print statements @@ -1163,6 +1860,8 @@ OP_JUMP: ; I/O .word TOK_GETKEY, TOK_INPUT_STR, TOK_XIO, TOK_CLOSE, TOK_GET, TOK_PUT .word TOK_BPUT, TOK_BGET + ; Optimization - set's IO channel to 0 + .word TOK_IOCHN0 ; Jumps .word TOK_JUMP, TOK_CJUMP, TOK_CALL, TOK_RET ; FOR loop support @@ -1177,4 +1876,14 @@ OP_JUMP: ; USR, calls ML routinr .word TOK_USR_ADDR, TOK_USR_PARAM, TOK_USR_CALL +.ifdef FASTBASIC_FP + ; Floating point computations + .word TOK_PRINT_FP + .word TOK_INT_FP, TOK_FP_VAL, TOK_FP_SGN, TOK_FP_ABS, TOK_FP_NEG, TOK_FLOAT + .word TOK_FP_DIV, TOK_FP_MUL, TOK_FP_SUB, TOK_FP_ADD, TOK_FP_STORE, TOK_FP_LOAD + .word TOK_FP_EXP, TOK_FP_EXP10, TOK_FP_LOG, TOK_FP_LOG10, TOK_FP_INT + .word TOK_FP_GEQ, TOK_FP_GT, TOK_FP_EQ + .word TOK_FP_IPOW, TOK_FP_RND, TOK_FP_SQRT, TOK_FP_SIN, TOK_FP_COS, TOK_FP_ATN +.endif ; FASTBASIC_FP + ; vi:syntax=asm_ca65 diff --git a/src/menu.asm b/src/menu.asm index b97e8e7..047aeb5 100644 --- a/src/menu.asm +++ b/src/menu.asm @@ -19,24 +19,24 @@ ; Main menu system ; ---------------- - .export start, COMPILE_BUFFER - .export BMAX + .export start + + ; Export to editor.bas + .export COMPILE_BUFFER, BMAX, LINENUM .exportzp reloc_addr ; From runtime.asm .import putc - .importzp IOCHN, IOERROR, tabpos + .importzp IOCHN, IOERROR, tabpos, tmp1, tmp2 ; From parser.asm .import parser_start - .importzp buf_ptr, linenum, end_ptr, bpos, bmax + .importzp buf_ptr, linenum, end_ptr, bmax ; From intrepreter.asm - .import interpreter_run, saved_cpu_stack - .importzp interpreter_cptr + .import interpreter_run, saved_cpu_stack, stack_h, stack_l + .importzp interpreter_cptr, var_count, sptr ; From alloc.asm .importzp prog_ptr, var_buf .import parser_alloc_init - ; From vars.asm - .importzp var_count ; From bytecode .import bytecode_start .importzp NUM_VARS @@ -55,14 +55,14 @@ BYTECODE_ADDR= __RUNTIME_RUN__ + __RUNTIME_SIZE__ ; Relocation amount reloc_addr: .res 2 + + ; Exported to EDITOR.BAS BMAX=bmax +LINENUM=linenum + .code start: - lda #0 - sta IOCHN - sta tabpos - jsr load_editor lda #heap_start - sta prog_ptr+1 - sta var_buf+1 + ldy #NUM_VARS + sty var_count + ldy #heap_start + sty prog_ptr+1 + sty var_buf+1 rts + ; Called from EDITOR.BAS + .export COUNT_LINES +.proc COUNT_LINES +sizeH = tmp1 +ptr = tmp2 + pla + sta sizeH + pla + tax + pla + sta ptr+1 + pla + tay + inx + inc sizeH + + lda #0 + sta ptr + +loop: lda (ptr), y + dex + bne :+ + dec sizeH + beq end +: iny + bne :+ + inc ptr+1 +: cmp #$9B + bne loop +end: tya + ldx ptr+1 + rts +.endproc + ; This is the header for the compiled binaries, included ; here to allow saving the resulting file. .export COMP_HEAD_1 @@ -211,9 +241,6 @@ COMP_RT_SIZE = __RUNTIME_RUN__ + __RUNTIME_SIZE__ - __JUMPTAB_RUN__ ; Note that this code is patched before writing to a file. .segment "RUNTIME" compiled_start: - lda #0 - sta IOCHN - sta tabpos compiled_var_count: lda #00 diff --git a/src/native.cc b/src/native.cc index 3f18e21..e9d95b7 100644 --- a/src/native.cc +++ b/src/native.cc @@ -22,7 +22,7 @@ #include #include #include -#include +#include #include enum VarType { @@ -30,7 +30,8 @@ enum VarType { VT_WORD, VT_ARRAY_WORD, VT_ARRAY_BYTE, - VT_STRING + VT_STRING, + VT_FLOAT }; enum LoopType { @@ -53,13 +54,84 @@ enum LoopType { LT_ELIF }; +// Atari FP number format +class atari_fp { + private: + double num; + uint8_t exp; + uint8_t mant[5]; + + static const double expTab[99]; + std::string hex(uint8_t x) const { + std::string ret(3,'$'); + static const char hd[17] = "0123456789ABCDEF"; + ret[1] = hd[x>>4]; + ret[2] = hd[x & 0xF]; + return ret; + } + uint8_t tobcd(int n) const { + return (n/10)*16 + (n%10); + } + void update() + { + exp = num < 0 ? 0x80 : 0x00; + double x = exp ? -num : num; + mant[0] = mant[1] = mant[2] = mant[3] = mant[4] = 0; + if( x < 1e-99 ) + return; + if( x >= 1e+98 ) + { + exp |= 0x71; + mant[0] = mant[1] = mant[2] = mant[3] = mant[4] = 0x99; + return; + } + exp |= 0x0E; + for(int i=0; i<99; i++, exp++) + { + if( x < expTab[i] ) + { + uint64_t n = (uint64_t)std::llrint(x * 10000000000.0 / expTab[i]); + mant[4] = tobcd(n % 100); n /= 100; + mant[3] = tobcd(n % 100); n /= 100; + mant[2] = tobcd(n % 100); n /= 100; + mant[1] = tobcd(n % 100); n /= 100; + mant[0] = tobcd(n); + return; + } + } + } + public: + atari_fp(double x): num(x) {} + bool valid() const { + return num >= -1E98 && num <= 1E98; + } + std::string to_asm() { + update(); + return hex(exp) + ", " + hex(mant[0]) + ", " + hex(mant[1]) + ", " + + hex(mant[2]) + ", " + hex(mant[3]) + ", " + hex(mant[4]); + } +}; + +const double atari_fp::expTab[99] = { + 1e-98, 1e-96, 1e-94, 1e-92, 1e-90, 1e-88, 1e-86, 1e-84, 1e-82, 1e-80, + 1e-78, 1e-76, 1e-74, 1e-72, 1e-70, 1e-68, 1e-66, 1e-64, 1e-62, 1e-60, + 1e-58, 1e-56, 1e-54, 1e-52, 1e-50, 1e-48, 1e-46, 1e-44, 1e-42, 1e-40, + 1e-38, 1e-36, 1e-34, 1e-32, 1e-30, 1e-28, 1e-26, 1e-24, 1e-22, 1e-20, + 1e-18, 1e-16, 1e-14, 1e-12, 1e-10, 1e-08, 1e-06, 1e-04, 1e-02, 1e+00, + 1e+02, 1e+04, 1e+06, 1e+08, 1e+10, 1e+12, 1e+14, 1e+16, 1e+18, 1e+20, + 1e+22, 1e+24, 1e+26, 1e+28, 1e+30, 1e+32, 1e+34, 1e+36, 1e+38, 1e+40, + 1e+42, 1e+44, 1e+46, 1e+48, 1e+50, 1e+52, 1e+54, 1e+56, 1e+58, 1e+60, + 1e+62, 1e+64, 1e+66, 1e+68, 1e+70, 1e+72, 1e+74, 1e+76, 1e+78, 1e+80, + 1e+82, 1e+84, 1e+86, 1e+88, 1e+90, 1e+92, 1e+94, 1e+96, 1e+98 +}; + static bool do_debug = false; class parse { public: class codew { public: - enum { tok, byte, word, label, comment } type; + enum { tok, byte, word, label, fp, comment } type; std::string value; bool operator<(const codew &c) const { return (type == c.type) ? (value < c.value) : (type < c.type); @@ -260,6 +332,12 @@ class parse { code->push_back(c); return true; } + bool emit_fp(atari_fp x) + { + codew c{ codew::fp, x.to_asm() }; + code->push_back(c); + return true; + } bool emit_label(std::string s) { codew c{ codew::label, s}; @@ -318,6 +396,8 @@ static VarType get_vartype(parse::codew cw) return VT_ARRAY_BYTE; if( t == "VT_STRING" ) return VT_STRING; + if( t == "VT_FLOAT" ) + return VT_FLOAT; return VT_UNDEF; } @@ -374,12 +454,53 @@ static unsigned long get_number(parse &s) return 65536; while( s.range('0', '9') ); + if( s.expect('.') ) // If ends in a DOT, it's a fp number + { + s.pos = start; + return 65536; + } auto sn = s.str.substr(start, s.pos - start); s.debug("(got '" + sn + "')"); return std::stoul(sn); } } +static atari_fp get_fp_number(parse &s) +{ + auto start = s.pos; + + // Optional sign + s.expect('-'); + + // Integer part + while( s.range('0', '9') ); + + // Optional dot + if( s.expect('.') ) + { + // Fractional part + while( s.range('0', '9') ); + } + + // Optional exponent, only if any number before + if( s.pos != start && s.expect('E') ) + { + // Optional exponent sign + if( !s.expect('-') ) + s.expect('+'); + // And up to two numbers + s.range('0', '9'); + s.range('0', '9'); + } + + if( s.pos == start ) + return atari_fp(HUGE_VAL); // return invalid number + + auto sn = s.str.substr(start, s.pos - start); + s.debug("(got '" + sn + "')"); + return atari_fp( std::stod(sn) ); +} + static bool get_asm_word_constant(parse &s) { auto start = s.pos; @@ -444,6 +565,18 @@ static bool SMB_E_NUMBER_BYTE(parse &s) return true; } +static bool SMB_E_NUMBER_FP(parse &s) +{ + s.debug("E_NUMBER_FP"); + s.skipws(); + auto num = get_fp_number(s); + if( !num.valid() ) + return false; + s.emit_fp( num ); + s.skipws(); + return true; +} + static bool SMB_E_EOL(parse &s) { s.debug("E_EOL"); @@ -650,8 +783,8 @@ static bool SMB_E_POP_FOR(parse &s) { // nothing to do! s.debug("E_POP_FOR"); - auto l1 = s.pop_loop(LT_FOR_2); auto l2 = s.pop_loop(LT_FOR_1); + auto l1 = s.pop_loop(LT_FOR_2); if( l1.empty() || l2.empty() ) return false; s.remove_last(); @@ -696,9 +829,16 @@ static bool SMB_E_VAR_SET_TYPE(parse &s) // Get type char type = get_vartype(s.remove_last()); + auto &v = s.vars; if( do_debug ) std::cout << "\tset var '" << last_var_name << "' to " << int(type) << "\n"; - s.vars[last_var_name] = (s.vars[last_var_name] & ~0xFF) + type; + v[last_var_name] = (v[last_var_name] & ~0xFF) + type; + // If type is FLOAT, allocate two more invisible variables + if( type == VT_FLOAT ) + { + v[ "-fake-" + std::to_string(v.size()) ] = 0; + v[ "-fake-" + std::to_string(v.size()) ] = 0; + } return true; } @@ -740,6 +880,12 @@ static bool SMB_E_VAR_STRING(parse &s) return var_check(s, VT_STRING); } +static bool SMB_E_VAR_FP(parse &s) +{ + s.debug("E_VAR_FP"); + return var_check(s, VT_FLOAT); +} + static bool SMB_E_LABEL_DEF(parse &s) { s.debug("E_LABEL_DEF"); @@ -831,6 +977,13 @@ class peephole code[idx].type == parse::codew::tok && code[idx].value == name ); } + bool mcbyte(size_t idx, std::string name) + { + idx += current; + return ( idx < code.size() && + code[idx].type == parse::codew::byte && + code[idx].value == name ); + } bool mword(size_t idx) { idx += current; @@ -1040,6 +1193,25 @@ class peephole set_tok(2, "TOK_INC"); del(7); del(6); del(5); del(4); del(3); i--; changed = true; continue; } + // VAR = VAR - 1 ==> DEC VAR + // TOK_VAR_A / x / TOK_VAR / x / TOK_NUM / 1 / TOK_SUB / TOK_DPOKE + // -> TOK_VAR_A / x / TOK_DEC + if( mtok(0,"TOK_VAR_ADDR") && mbyte(1) && + mtok(2,"TOK_VAR_LOAD") && mbyte(3) && + mtok(4,"TOK_NUM") && mword(5) && val(5) == 1 && + mtok(6,"TOK_SUB") && mtok(7,"TOK_DPOKE") && + val(1) == val(3) ) + { + set_tok(2, "TOK_DEC"); del(7); del(6); del(5); del(4); del(3); i--; changed = true; + continue; + } + // TOK_BYTE / IOCHN / TOK_NUM / 0 / TOK_POKE -> TOK_IOCHN0 + if( mtok(0,"TOK_BYTE") && mcbyte(1, "IOCHN") && + mtok(2,"TOK_NUM") && mword(3) && val(3) == 0 && mtok(4,"TOK_POKE") ) + { + set_tok(0, "TOK_IOCHN0"); del(4); del(3); del(2); del(1); i--; changed = true; + continue; + } } } while(changed); shorten_numbers(); @@ -1193,6 +1365,9 @@ int main(int argc, char **argv) case parse::codew::word: ofile << "\t.word\t" << c.value << "\n"; break; + case parse::codew::fp: + ofile << "\t.byte\t" << c.value << "\n"; + break; case parse::codew::label: ofile << c.value << ":\n"; break; diff --git a/src/parse.asm b/src/parse.asm index bdad394..6301a42 100644 --- a/src/parse.asm +++ b/src/parse.asm @@ -20,15 +20,13 @@ ; -------------------------------- .export parser_start, parser_error, parser_skipws - ; Common vars - .exportzp tmp1, tmp2, tmp3 ; Parser state .exportzp bptr, bpos, bmax, linenum, buf_ptr, end_ptr .exportzp loop_sp ; Output state .exportzp opos ; From actions.asm - .importzp VT_WORD, VT_ARRAY_WORD, VT_ARRAY_BYTE, VT_STRING + .importzp VT_WORD, VT_ARRAY_WORD, VT_ARRAY_BYTE, VT_STRING, VT_FLOAT .importzp LT_PROC_1, LT_PROC_2, LT_DATA, LT_DO_LOOP, LT_REPEAT, LT_WHILE_1 .importzp LT_WHILE_2, LT_FOR_1,LT_FOR_2, LT_EXIT, LT_IF, LT_ELSE, LT_ELIF .import check_labels @@ -38,12 +36,12 @@ ; From vars.asm .importzp var_count, label_count ; From runtime.asm - .import putc - .importzp IOCHN, COLOR, IOERROR - ; From io.asm - .import line_buf + .importzp IOCHN, COLOR, IOERROR, tmp1, tmp2, tmp3 + .import line_buf, putc + ; From interpreter.asm + .importzp DEGFLAG, DEGFLAG_DEG, DEGFLAG_RAD ; From errors.asm - .import print_error + .import error_msg_list .importzp ERR_PARSE, ERR_NO_ELOOP, ERR_LABEL ; Export used tokens values to the interpreter .exportzp TOK_CSTRING @@ -56,9 +54,6 @@ end_ptr:.res 2 bmax: .res 1 opos: .res 1 pptr: .res 2 -tmp1: .res 2 -tmp2: .res 2 -tmp3: .res 2 linenum:.res 2 loop_sp:.res 1 @@ -105,9 +100,24 @@ SM_EMIT= SM_EMIT_1 ; Restore stack ldstk: ldx #$ff txs - ; Check if error == parse error - cmp #ERR_PARSE+1 - jmp print_error + ; Prints error message + tax + ldy #$FF +nxt: iny + lda error_msg_list, y + bpl nxt + dex + bpl nxt + ; And print +ploop: iny + lda error_msg_list, y + pha + and #$7F + jsr putc + pla + bpl ploop + sec + rts .endproc saved_stack = parser_error::ldstk + 1 diff --git a/src/runtime.asm b/src/runtime.asm index 585487d..5712297 100644 --- a/src/runtime.asm +++ b/src/runtime.asm @@ -28,24 +28,38 @@ ; --------------------------------------------- ; 16bit math - .export umul16, sdiv16, smod16, neg_AX + .export umul16, divmod_sign_adjust, neg_AX ; simple I/O - .export getkey, getc, putc, print_word, getline + .export getkey, putc, print_word, getline, putc_nosave .export line_buf, cio_close, close_all, sound_off - .exportzp IOCHN, COLOR, IOERROR, tabpos + .exportzp IOCHN, COLOR, IOERROR, tabpos, divmod_sign ; String functions .export read_word ; memory move .export move_up_src, move_up_dst, move_up .export move_dwn_src, move_dwn_dst, move_dwn - ; Graphics - .export graphics - - .importzp tmp1, tmp2, tmp3 + ; Common ZP variables (2 bytes each) + .exportzp tmp1, tmp2, tmp3 + +.ifdef FASTBASIC_FP + ; Exported only in Floating Point version + .export print_fp, int_to_fp, read_fp + ; Convert string to floating point +read_fp = AFP +.else + ; In integer version, the conversion and printing is the same +print_word = int_to_fp +.endif ; FASTBASIC_FP .include "atari.inc" + .zeropage -sign: .res 1 + +tmp1: .res 2 +tmp2: .res 2 +tmp3: .res 2 +divmod_sign: + .res 1 IOCHN: .res 1 IOERROR:.res 2 COLOR: .res 1 @@ -53,7 +67,7 @@ tabpos: .res 1 .segment "RUNTIME" -; Negate AX value +; Negate AX value : SHOULD PRESERVE Y .proc neg_AX clc eor #$FF @@ -67,25 +81,6 @@ tabpos: .res 1 rts .endproc -; Signed 16x16 division -.proc sdiv16 - jsr sign_adjust - lsr sign - bcc ret - jmp neg_AX -ret: rts -.endproc - -; Signed 16x16 modulus -.proc smod16 - jsr sign_adjust - lda tmp2 - ldx tmp2+1 - asl sign - bcc sdiv16::ret - jmp neg_AX -.endproc - ; ; 16x16 -> 16 multiplication .proc umul16 @@ -103,11 +98,11 @@ ret: rts clc adc tmp3 - pha + tax lda tmp3+1 adc tmp2+1 sta tmp2+1 - pla + txa @L1: ror tmp2+1 ror @@ -116,34 +111,42 @@ ret: rts dey bne @L0 - sta tmp2 ; Save byte 3 - lda tmp1 ; Load the result - ldx tmp1+1 +; sta tmp2 ; Save byte 3 rts ; Done .endproc -; Adjust sign for SIGNED div operations -; INPUT: OP1: A / X -; OP2: tmp1 / tmp1+1 -; P flag : from "X" -.proc sign_adjust +; Adjust sign for SIGNED div/mod operations +; INPUT: OP1: stack, y +; OP2: A / X +; +; The signs are stored in divmod_sign: +; OP1 OP2 divmod_sign DIV (bit 7) MOD (bit 8) +; + + 00 + 0 + 0 +; + - 80 - 1 + 0 +; - + FF - 1 . 1 +; - - 7F + 0 . 1 +.proc divmod_sign_adjust + ; Reads stack from the interpreter + .import stack_l, stack_h + .importzp sptr ldy #0 - cpx #0 + cpx #$80 + bcc y_pos + ldy #$80 + jsr neg_AX +y_pos: sta tmp1 + stx tmp1+1 + sty divmod_sign + + ldy sptr + inc sptr + lda stack_l, y + ldx stack_h, y bpl x_pos - dey - dey - dey jsr neg_AX + dec divmod_sign x_pos: sta tmp3 stx tmp3+1 - ldx tmp1+1 - bpl y_pos - lda tmp1 - iny - jsr neg_AX - sta tmp1 - stx tmp1+1 -y_pos: sty sign .endproc ; Fall through ; Divide TMP3 / TMP2, result in AX and remainder in TMP2 @@ -151,7 +154,7 @@ y_pos: sty sign ldy #16 lda #0 sta tmp2+1 - cpx #0 + ldx tmp1+1 beq udiv16x8 L0: asl tmp3 @@ -159,19 +162,19 @@ L0: asl tmp3 rol rol tmp2+1 - pha + tax cmp tmp1 lda tmp2+1 sbc tmp1+1 bcc L1 sta tmp2+1 - pla + txa sbc tmp1 - pha + tax inc tmp3 -L1: pla +L1: txa dey bne L0 sta tmp2 @@ -180,6 +183,8 @@ L1: pla rts udiv16x8: + ldx tmp1 + beq L0 L2: asl tmp3 rol tmp3+1 rol @@ -195,7 +200,7 @@ L4: dey sta tmp2 lda tmp3 ldx tmp3+1 - rts +xit: rts .endproc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -211,21 +216,9 @@ L4: dey lrts: rts .endproc -.proc getc - lda #GETCHR - sta ICCOM, x - lda #0 - sta ICBAH, x - sta ICBAL, x - sta ICBLL, x - sta ICBLH, x - jsr CIOV - rts -.endproc - - ; Falls from print_byte! .proc putc_nosave - tay + lda ICAX1,X + sta ICAX1Z lda ICPTH, x pha lda ICPTL, x @@ -236,11 +229,10 @@ lrts: rts .proc putc pha - stx save_x+1 sty save_y+1 ldx IOCHN + tay jsr putc_nosave -save_x: ldx #0 save_y: ldy #0 dec tabpos bpl :+ @@ -269,22 +261,13 @@ line_buf = LBUFF xit: rts .endproc -.proc print_word +.proc int_to_fp FR0 = $D4 IFP = $D9AA stx tmp1 cpx #$80 bcc positive - clc - eor #$FF - adc #1 - tay - txa - eor #$FF - adc #0 - tax - tya - + jsr neg_AX positive: sta FR0 stx FR0+1 @@ -293,6 +276,19 @@ positive: and #$80 eor FR0 sta FR0 + + ; Minor optimization: in integer version, we don't use + ; int_to_fp from outside, so fall through to print_fp +.ifdef FASTBASIC_FP + rts +.endproc + +.proc print_word +FR0 = $D4 + jsr int_to_fp + +.endif ; FASTBASIC_FP + ; Fall through .endproc .proc print_fp @@ -356,7 +352,7 @@ SKBLANK = $DBA1 dex skip: iny -nosign: stx sign +nosign: stx divmod_sign sty tmp2+1 ; Store starting Y position - used to check if read any digits loop: ; Reads one character @@ -410,11 +406,11 @@ xit_n: cpy tmp2+1 ; Restore sign - conditional! lda tmp1 ldx tmp1+1 - lsr sign - bcc :+ + bit divmod_sign + bpl :+ jsr neg_AX - clc -: rts +: clc + rts .endproc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -424,10 +420,8 @@ xit_n: cpy tmp2+1 ; amount: from "(ptr-(256-len)) + (256-len)" to "(ptr+len-256) + 256" ; inx - ldy #0 - cmp #0 - beq cpage tay + beq cpage dey clc adc src+1 @@ -530,26 +524,4 @@ xit: rts move_dwn_src = move_dwn::src+1 move_dwn_dst = move_dwn::dst+1 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Graphics code -.proc graphics - sta tmp1 - ldx #$60 - jsr cio_close - lda tmp1 - and #$F0 - eor #$1C ; Get AUX1 from BASIC mode - sta ICAX1, x - lda tmp1 ; And AUX2 - sta ICAX2, x - lda #OPEN - sta ICCOM, x - lda #device_s - sta ICBAH, x - jmp CIOV -device_s: .byte "S:", $9B -.endproc - ; vi:syntax=asm_ca65 diff --git a/src/standalone.asm b/src/standalone.asm index db051bf..8c6bd86 100644 --- a/src/standalone.asm +++ b/src/standalone.asm @@ -29,14 +29,9 @@ ; Main symbol .export start - ; Export to runtime.asm - .exportzp tmp1, tmp2, tmp3 - .exportzp bptr, bpos, var_count - - ; From runtime.asm - .importzp IOCHN, tabpos ; From intrepreter.asm .import interpreter_run + .importzp var_count ; From alloc.asm .importzp prog_ptr, prog_buf ; From bytecode @@ -50,22 +45,8 @@ ; Start of HEAP heap_start= __BSS_RUN__+__BSS_SIZE__ - .zeropage -var_count: .res 1 -tmp1: .res 2 -tmp2: .res 2 -tmp3: .res 2 - -; Use (INBUFF)+CIX as our parser pointer -bptr = INBUFF -bpos = CIX - .code start: - lda #0 - sta IOCHN - sta tabpos - lda #NUM_VARS sta var_count lda # &list) { static int lbl_num = 0; - std::string ret; + std::string ret, dbg; bool used_lbl = false; for(auto &ch: list) { if( ch.length() == 3 && ch[0] == '\'' && ch[1] >= 'a' && ch[1] <= 'z' ) { ch[1] = ch[1] - 'a' + 'A'; + dbg += ch[1]; ret += "\t\tif( !s.expect(" + ch + ") )" " { if( !s.expect('.') ) break; " "goto accept_char_" + std::to_string(lbl_num) + "; }\n"; used_lbl = true; } else + { ret += "\t\tif( !s.expect(" + ch + ") ) break;\n"; - ret += "\t\ts.debug(\"GOT " + ch + "\");\n"; + if( ch.length() == 3 && ch[0] == '\'' ) + dbg += ch[1]; + else if( ch == "0x22" ) + dbg += "\\\""; + else if( ch == "0x27" ) + dbg += "\\\'"; + else + dbg += ch; + } } if( used_lbl ) { ret += "accept_char_" + std::to_string(lbl_num) + ":\n"; lbl_num ++; } + ret += "\t\ts.debug(\"GOT '" + dbg + "'\");\n"; return ret; } static std::string emit_bytes(bool last, std::vector &ebytes) diff --git a/src/synt-read.h b/src/synt-read.h new file mode 100644 index 0000000..37184d4 --- /dev/null +++ b/src/synt-read.h @@ -0,0 +1,184 @@ +/* + * FastBasic - Fast basic interpreter for the Atari 8-bit computers + * Copyright (C) 2017 Daniel Serpell + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program. If not, see + */ + +// synt-read.h: Reads syntax file to a string, with parsing of optional +// parts. + +#include +#include + +class options +{ + private: + void usage() + { + std::cerr << "Usage: " << prog_name << " [-options] [input_file]\n" + "\n" + "Options:\n" + " -h Show this help.\n" + " -D name Define symbol 'name' to use in syntax.\n" + " -o file specify output file name 'file'.\n"; + } + void error(std::string msg) + { + std::cerr << prog_name << ": error, " << msg << ". Use '-h' for help.\n"; + std::exit(1); + } + public: + std::set defs; + std::string input_name; + std::string output_name; + std::string prog_name; + std::ifstream input_file; + std::ofstream output_file; + + std::ostream &output() + { + if( output_name.empty() || output_name == "-" ) + return std::cout; + if( !output_file.is_open() ) + { + output_file.open(output_name); + if( !output_file.is_open() ) + error("can't open output file: '" + output_name + "'"); + } + return output_file; + } + + std::istream &input() + { + if( input_name.empty() || input_name == "-" ) + return std::cin; + if( !input_file.is_open() ) + { + input_file.open(input_name); + if( !input_file.is_open() ) + error("can't open input file: '" + input_name + "'"); + } + return input_file; + } + + options(int argc, const char **argv): + prog_name(argv[0]) + { + for(int i=1; i 1 && x[0] == '-') + { + if( x[1] == 'D' ) + { + if( x.size() > 2 ) + defs.insert(x.substr(2)); + else if( i+1 < argc ) + defs.insert(argv[++i]); + else + error("option '-D' needs an argument"); + } + else if( x[1] == 'o' ) + { + if( !output_name.empty() ) + error("option '-o' multiple times"); + else if( x.size() > 2 ) + output_name = x.substr(2); + else if( i+1 < argc ) + output_name = argv[++i]; + else + error("option '-o' needs argument"); + } + else + error("invalid option '" + x + "'\n"); + } + else if ( input_name.empty() ) + input_name = x; + else + error("only one input file expected"); + } + } +}; + +static std::string readInput(const std::set &defines, std::istream &in) +{ + std::string r; + int c; + // Simple state machine to detect "#@if " and "#@endif" + int st = 0, skip = 0; + std::string word; + while( -1 != (c = in.get()) ) + { + switch( st ) + { + case 0: + st = ( c == '#' ) ? 1 : 0; + break; + case 1: + st = ( c == '@' ) ? 2 : 0; + break; + case 2: + st = ( c == 'i' || c == 'I' ) ? 3 : (c == 'e' || c == 'E') ? 6 : 0; + break; + case 3: + st = ( c == 'f' || c == 'F' ) ? 4 : 0; + break; + case 4: + st = ( c == ' ' ) ? 5 : 0; + break; + case 5: + // WORD + if ( c >= 'a' && c <= 'z' ) + word += (c - ('a'-'A')); + else if ( (c >= 'A' && c <= 'Z') || c == '_' || (word.empty() && c == '!') ) + word += c; + else + { + // Search WORD in defines, start skip if not found, or if found + // and started with '!': + if( word.size() > 1 && word[0] == '!' ) + skip = skip + (defines.find(word.substr(1)) != defines.end()); + else if( !word.empty() ) + skip = skip + (defines.find(word) == defines.end()); + + st = 0; + word.clear(); + } + break; + case 6: + st = ( c == 'n' || c == 'N' ) ? 7 : 0; + break; + case 7: + st = ( c == 'd' || c == 'D' ) ? 8 : 0; + break; + case 8: + st = ( c == 'i' || c == 'I' ) ? 9 : 0; + break; + case 9: + st = ( c == 'f' || c == 'F' ) ? 10 : 0; + break; + case 10: + st = 0; + if( skip ) + skip --; + break; + } + if( !skip ) + r += char(c); + } + return r; +} + + diff --git a/src/synt-sm.h b/src/synt-sm.h index 3b38762..a5ecbb4 100644 --- a/src/synt-sm.h +++ b/src/synt-sm.h @@ -210,7 +210,7 @@ class statemachine { } return true; } - void print() const { - EM::print(std::cout, _name, _code, complete); + void print(std::ostream &out) const { + EM::print(out, _name, _code, complete); } }; diff --git a/src/synt.cc b/src/synt.cc index a16d16c..b10541b 100644 --- a/src/synt.cc +++ b/src/synt.cc @@ -23,16 +23,17 @@ #include "synt-parse.h" #include "synt-wlist.h" #include "synt-sm.h" +#include "synt-read.h" #include #include #include #include -bool p_file(parseState &p) +bool p_file(parseState &p, std::ostream &out) { // Output header - std::cout << "; Syntax state machine\n\n"; + out << "; Syntax state machine\n\n"; while(1) { @@ -40,8 +41,8 @@ bool p_file(parseState &p) if( !tok.parse() ) break; for(auto i: tok.map()) - std::cout << i.first << "\t= " << i.second << " * 2\n"; - std::cout << "\n"; + out << i.first << "\t= " << i.second << " * 2\n"; + out << "\n"; std::cerr << "syntax: " << tok.next() << " possible tokens.\n"; } @@ -50,13 +51,13 @@ bool p_file(parseState &p) { int n = 128; for(auto i: ext.map()) - std::cout << " .global " << i.first << "\n"; + out << " .global " << i.first << "\n"; for(auto i: ext.map()) { i.second = n++; - std::cout << "SMB_" << i.first << "\t= " << i.second << "\n"; + out << "SMB_" << i.first << "\t= " << i.second << "\n"; } - std::cout << "\nSMB_STATE_START\t= " << ext.next() << "\n\n"; + out << "\nSMB_STATE_START\t= " << ext.next() << "\n\n"; } std::map>> sm_list; @@ -78,37 +79,29 @@ bool p_file(parseState &p) // Emit labels table int ns = ext.next(); for(auto &sm: sm_list) - std::cout << "SMB_" << sm.second->name() << "\t= " << ns++ << "\n"; + out << "SMB_" << sm.second->name() << "\t= " << ns++ << "\n"; // Emit array with addresses - std::cout << "\nSM_TABLE_ADDR:\n"; + out << "\nSM_TABLE_ADDR:\n"; for(auto i: ext.map()) - std::cout << "\t.word " << i.first << " - 1\n"; + out << "\t.word " << i.first << " - 1\n"; for(auto &sm: sm_list) - std::cout << "\t.word " << sm.second->name() << " - 1\n"; + out << "\t.word " << sm.second->name() << " - 1\n"; // Emit state machine tables - std::cout << "\n"; + out << "\n"; for(auto &sm: sm_list) - sm.second->print(); + sm.second->print(out); std::cerr << "syntax: " << (ns-128) << " tables in the parser-table.\n"; return true; } -static std::string readInput() +int main(int argc, const char **argv) { - std::string r; - int c; - while( -1 != (c = std::cin.get()) ) - r += char(c); - return r; -} - -int main() -{ - std::string inp = readInput(); + options opt(argc, argv); + std::string inp = readInput(opt.defs, opt.input()); parseState ps(inp.c_str()); - p_file(ps); + p_file(ps, opt.output()); return 0; } diff --git a/src/vars.asm b/src/vars.asm index 9b06883..8fa1178 100644 --- a/src/vars.asm +++ b/src/vars.asm @@ -19,15 +19,16 @@ ; Handles a list of names (variables or labels) ; -------------------------------------------- - .export var_getlen, var_search, var_new, var_set_type - .export label_search, label_new - .exportzp var_namelen, var_count, label_count + .export var_getlen, var_search, label_search, name_new + .exportzp var_namelen, label_count - ; From parser.asm - .importzp bptr, bpos + ; From interpreter.asm + .importzp var_count ; From alloc.asm .importzp var_buf, var_ptr, label_buf, label_ptr, prog_ptr .import alloc_area_8 + ; From parser.asm + .import parser_skipws ; Each variable is stored in the list as: @@ -37,12 +38,16 @@ ; To find a variable, we simply walk the list by adding the length ; to each name. + +; Parsing pointers: +CIX = $F2 +INBUFF = $F3 + ; Our internal pointers: .zeropage name: .res 2 var: .res 2 len: .res 1 -var_count: .res 1 label_count: .res 1 ; Use a longer name for external references @@ -75,26 +80,25 @@ char_ok: ; Search the list of labels by name, ; Inputs: - ; (bptr + bpos) : Variable name, from parsing code, terminated in any invalid char + ; (INBUFF + CIX) : Variable name, from parsing code, terminated in any invalid char .proc label_search ldx #label_buf - prog_ptr ldy #label_count - sty search_count bne list_search .endproc ; Search the list of variables by name, ; Inputs: - ; (bptr + bpos) : Variable name, from parsing code, terminated in any invalid char + ; (INBUFF + CIX) : Variable name, from parsing code, terminated in any invalid char .proc var_search ; Pointer to var list to "var" ldx #var_buf - prog_ptr ldy #var_count - sty search_count .endproc ; Fall through ; Search a list of names - used for variables or labels .proc list_search + sty search_count ; Pointer to start of var/label list to "var" lda prog_ptr, x sta var @@ -154,12 +158,14 @@ var_found: ; Returns variable type in A ; If no character is valid, pops the stack and returns with carry set. ; Also, init the "name" pointer with the current position .proc var_getlen + ; Skips spaces + jsr parser_skipws ; Pointer with var name to "name" - lda bptr + lda INBUFF clc - adc bpos + adc CIX sta name - lda bptr+1 + lda INBUFF+1 adc #0 sta name+1 @@ -197,7 +203,7 @@ exit_2: clc adc #2 jsr alloc_area_8 - bcs exit + bcs var_getlen::exit_2 ; Copy length and name of var/label ldy #0 lda len @@ -213,43 +219,6 @@ loop: lda #0 iny sta (var), y -exit: rts -.endproc - - ; Adds a new variable to the variable table, returns the var index -.proc var_new - ldx #var_ptr - prog_ptr - jsr name_new - ldx var_count - inc var_count - clc - rts -.endproc - - ; Adds a new label -.proc label_new - ldx #label_ptr - prog_ptr - jsr name_new - ldx label_count - inc label_count - clc - rts -.endproc - - ; Sets the type of the lase defined variable - ; A = type -.proc var_set_type - ; Pointer to var list to "var" - ldx var_ptr - stx var - ldx var_ptr+1 - dex - stx var+1 - - ldy #$FF - sta (var), y - - clc rts .endproc diff --git a/startup.bat b/startup.bat index f478386..e71f5ce 100644 --- a/startup.bat +++ b/startup.bat @@ -1,2 +1,3 @@ TYPE README -DIR *.BAS +PAUSE ;œ +DIR *.BAS ;œœ diff --git a/tools/anotate-run.awk b/tools/anotate-run.awk index 1e0d647..4678f92 100755 --- a/tools/anotate-run.awk +++ b/tools/anotate-run.awk @@ -1,6 +1,6 @@ #!/usr/bin/awk -f BEGIN { - while( getline < "bin/fastbasic.lbl" ) { + while( getline < "bin/fb.lbl" ) { gsub(/^\./,"",$3) lbl[$2]=$3 }