Port of BAS 2.4 to NuttX by Alan Carvalho de Assis

interpreters/Kconfig

@@ -4,6 +4,7 @@
 #
 
 source "$APPSDIR/interpreters/ficl/Kconfig"
+source "$APPSDIR/interpreters/bas/Kconfig"
 
 config INTERPRETERS_PCODE
 	bool "Pascal p-code interpreter"

interpreters/Make.defs

@@ -34,6 +34,10 @@
 #
 ############################################################################
 
+ifeq ($(CONFIG_INTERPRETERS_BAS),y)
+CONFIGURED_APPS += interpreters/bas
+endif
+
 ifeq ($(CONFIG_INTERPRETERS_PCODE),y)
 CONFIGURED_APPS += interpreters/pcode
 endif

interpreters/Makefile

@@ -37,7 +37,7 @@
 
 # Sub-directories containing interpreter runtime
 
-SUBDIRS = pcode prun ficl
+SUBDIRS = pcode prun ficl bas
 
 # Create the list of installed runtime modules (INSTALLED_DIRS)
 

interpreters/bas/INSTALL

@@ -0,0 +1,183 @@
+Basic Installation
+==================
+
+   These are generic installation instructions.
+
+   The `configure' shell script attempts to guess correct values for
+various system-dependent variables used during compilation.  It uses
+those values to create a `Makefile' in each directory of the package.
+It may also create one or more `.h' files containing system-dependent
+definitions.  Finally, it creates a shell script `config.status' that
+you can run in the future to recreate the current configuration, a file
+`config.cache' that saves the results of its tests to speed up
+reconfiguring, and a file `config.log' containing compiler output
+(useful mainly for debugging `configure').
+
+   If you need to do unusual things to compile the package, please try
+to figure out how `configure' could check whether to do them, and mail
+diffs or instructions to the address given in the `README' so they can
+be considered for the next release.  If at some point `config.cache'
+contains results you don't want to keep, you may remove or edit it.
+
+   The file `configure.in' is used to create `configure' by a program
+called `autoconf'.  You only need `configure.in' if you want to change
+it or regenerate `configure' using a newer version of `autoconf'.
+
+The simplest way to compile this package is:
+
+  1. `cd' to the directory containing the package's source code and type
+     `./configure' to configure the package for your system.  If you're
+     using `csh' on an old version of System V, you might need to type
+     `sh ./configure' instead to prevent `csh' from trying to execute
+     `configure' itself.
+
+     Running `configure' takes awhile.  While running, it prints some
+     messages telling which features it is checking for.
+
+  2. Type `make' to compile the package.
+
+  3. Optionally, type `make check' to run any self-tests that come with
+     the package.
+
+  4. Type `make install' to install the programs and any data files and
+     documentation.
+
+  5. You can remove the program binaries and object files from the
+     source code directory by typing `make clean'.  To also remove the
+     files that `configure' created (so you can compile the package for
+     a different kind of computer), type `make distclean'.  There is
+     also a `make maintainer-clean' target, but that is intended mainly
+     for the package's developers.  If you use it, you may have to get
+     all sorts of other programs in order to regenerate files that came
+     with the distribution.
+
+Compilers and Options
+=====================
+
+   Some systems require unusual options for compilation or linking that
+the `configure' script does not know about.  You can give `configure'
+initial values for variables by setting them in the environment.  Using
+a Bourne-compatible shell, you can do that on the command line like
+this:
+     CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure
+
+Or on systems that have the `env' program, you can do it like this:
+     env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure
+
+Compiling For Multiple Architectures
+====================================
+
+   You can compile the package for more than one kind of computer at the
+same time, by placing the object files for each architecture in their
+own directory.  To do this, you must use a version of `make' that
+supports the `VPATH' variable, such as GNU `make'.  `cd' to the
+directory where you want the object files and executables to go and run
+the `configure' script.  `configure' automatically checks for the
+source code in the directory that `configure' is in and in `..'.
+
+   If you have to use a `make' that does not supports the `VPATH'
+variable, you have to compile the package for one architecture at a time
+in the source code directory.  After you have installed the package for
+one architecture, use `make distclean' before reconfiguring for another
+architecture.
+
+Installation Names
+==================
+
+   By default, `make install' will install the package's files in
+`/usr/local/bin', `/usr/local/man', etc.  You can specify an
+installation prefix other than `/usr/local' by giving `configure' the
+option `--prefix=PATH'.
+
+   You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files.  If you
+give `configure' the option `--exec-prefix=PATH', the package will use
+PATH as the prefix for installing programs and libraries.
+Documentation and other data files will still use the regular prefix.
+
+   In addition, if you use an unusual directory layout you can give
+options like `--bindir=PATH' to specify different values for particular
+kinds of files.  Run `configure --help' for a list of the directories
+you can set and what kinds of files go in them.
+
+   If the package supports it, you can cause programs to be installed
+with an extra prefix or suffix on their names by giving `configure' the
+option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
+
+Optional Features
+=================
+
+   Some packages pay attention to `--enable-FEATURE' options to
+`configure', where FEATURE indicates an optional part of the package.
+They may also pay attention to `--with-PACKAGE' options, where PACKAGE
+is something like `gnu-as' or `x' (for the X Window System).  The
+`README' should mention any `--enable-' and `--with-' options that the
+package recognizes.
+
+   For packages that use the X Window System, `configure' can usually
+find the X include and library files automatically, but if it doesn't,
+you can use the `configure' options `--x-includes=DIR' and
+`--x-libraries=DIR' to specify their locations.
+
+Specifying the System Type
+==========================
+
+   There may be some features `configure' can not figure out
+automatically, but needs to determine by the type of host the package
+will run on.  Usually `configure' can figure that out, but if it prints
+a message saying it can not guess the host type, give it the
+`--host=TYPE' option.  TYPE can either be a short name for the system
+type, such as `sun4', or a canonical name with three fields:
+     CPU-COMPANY-SYSTEM
+
+See the file `config.sub' for the possible values of each field.  If
+`config.sub' isn't included in this package, then this package doesn't
+need to know the host type.
+
+   If you are building compiler tools for cross-compiling, you can also
+use the `--target=TYPE' option to select the type of system they will
+produce code for and the `--build=TYPE' option to select the type of
+system on which you are compiling the package.
+
+Sharing Defaults
+================
+
+   If you want to set default values for `configure' scripts to share,
+you can create a site shell script called `config.site' that gives
+default values for variables like `CC', `cache_file', and `prefix'.
+`configure' looks for `PREFIX/share/config.site' if it exists, then
+`PREFIX/etc/config.site' if it exists.  Or, you can set the
+`CONFIG_SITE' environment variable to the location of the site script.
+A warning: not all `configure' scripts look for a site script.
+
+Operation Controls
+==================
+
+   `configure' recognizes the following options to control how it
+operates.
+
+`--cache-file=FILE'
+     Use and save the results of the tests in FILE instead of
+     `./config.cache'.  Set FILE to `/dev/null' to disable caching, for
+     debugging `configure'.
+
+`--help'
+     Print a summary of the options to `configure', and exit.
+
+`--quiet'
+`--silent'
+`-q'
+     Do not print messages saying which checks are being made.  To
+     suppress all normal output, redirect it to `/dev/null' (any error
+     messages will still be shown).
+
+`--srcdir=DIR'
+     Look for the package's source code in directory DIR.  Usually
+     `configure' can determine that directory automatically.
+
+`--version'
+     Print the version of Autoconf used to generate the `configure'
+     script, and exit.
+
+`configure' also accepts some other, not widely useful, options.
+

interpreters/bas/Kconfig

@@ -0,0 +1,13 @@
+#
+# For a description of the syntax of this configuration file,
+# see misc/tools/kconfig-language.txt.
+#
+
+config INTERPRETERS_BAS
+	bool "Basic Interpreter support"
+	default n
+	---help---
+		This is a Basic interpreter written by Michael Haardt
+
+if INTERPRETERS_BAS
+endif

interpreters/bas/LICENSE

@@ -0,0 +1,19 @@
+Copyright (c) 1999-2014 Michael Haardt
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

interpreters/bas/Makefile

@@ -0,0 +1,121 @@
+############################################################################
+# apps/bas/Makefile
+#
+#   Copyright (C) 2012 Gregory Nutt. All rights reserved.
+#   Author: Gregory Nutt <gnutt@nuttx.org>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in
+#    the documentation and/or other materials provided with the
+#    distribution.
+# 3. Neither the name NuttX nor the names of its contributors may be
+#    used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+# OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+############################################################################
+
+-include $(TOPDIR)/.config
+-include $(TOPDIR)/Make.defs
+include $(APPDIR)/Make.defs
+
+# BAS Library
+
+ASRCS =
+CSRCS =
+
+ifeq ($(CONFIG_INTERPRETERS_BAS),y)
+
+CSRCS += auto.c  bas.c  fs.c  getopt1.c  getopt.c  global.c  main.c  program.c  statement.c  str.c  value.c  var.c
+DEPPATH = --dep-path .
+VPATH = .
+
+ifeq ($(WINTOOL),y)
+INCDIROPT = -w
+endif
+
+##include ascii/Make.defs
+##include functions/Make.defs
+##include nuttx/Make.defs
+##include rtu/Make.defs
+##include tcp/Make.defs
+
+endif
+
+AOBJS		= $(ASRCS:.S=$(OBJEXT))
+COBJS		= $(CSRCS:.c=$(OBJEXT))
+
+SRCS		= $(ASRCS) $(CSRCS)
+OBJS		= $(AOBJS) $(COBJS)
+
+ifeq ($(CONFIG_WINDOWS_NATIVE),y)
+  BIN		= ..\libapps$(LIBEXT)
+else
+ifeq ($(WINTOOL),y)
+  BIN		= ..\\libapps$(LIBEXT)
+else
+  BIN		= ../libapps$(LIBEXT)
+endif
+endif
+
+# Build targets
+
+all:	.built
+.PHONY: context .depend depend clean distclean
+
+ifeq ($(CONFIG_BAS),y)
+
+$(AOBJS): %$(OBJEXT): %.S
+	$(call ASSEMBLE, $<, $@)
+
+$(COBJS): %$(OBJEXT): %.c
+	$(call COMPILE, $<, $@)
+endif
+
+.built: $(OBJS)
+ifeq ($(CONFIG_BAS),y)
+	$(call ARCHIVE, $(BIN), $(OBJS))
+	$(Q) touch .built
+endif
+
+install:
+
+context:
+
+.depend: Makefile $(SRCS)
+ifeq ($(CONFIG_BAS),y)
+	$(Q) $(MKDEP) $(DEPPATH) "$(CC)" -- $(CFLAGS) -- $(SRCS) >Make.dep
+	$(Q) touch $@
+endif
+
+depend: .depend
+
+clean:
+	$(call DELFILE, .built)
+	$(call CLEAN)
+
+distclean: clean
+	$(call DELFILE, Make.dep)
+	$(call DELFILE, .depend)
+
+
+-include Make.dep
+

interpreters/bas/Makefile.in

@@ -0,0 +1,113 @@
+srcdir=		@srcdir@
+VPATH=		@srcdir@
+prefix=		@prefix@
+exec_prefix=	@exec_prefix@
+datarootdir=	@datarootdir@
+localedir=	@localedir@
+
+CC=		@CC@
+RANLIB=		@RANLIB@
+CFLAGS=		@CFLAGS@
+CPPFLAGS=	@CPPFLAGS@ -DLOCALEDIR=\"$(localedir)\"
+LDFLAGS=	@LDFLAGS@
+LIBS=		@LIBS@
+
+CATALOGS=	de.mo
+
+all:		bas all-po-@USE_NLS@
+all-po-no:
+all-po-yes:	$(CATALOGS)
+
+bas:		main.o libbas.a getopt.o getopt1.o
+		$(CC) -o $@ $(LDFLAGS) main.o libbas.a getopt.o getopt1.o $(LIBS)
+
+token.c:	token.l token.h
+		flex -i -t token.l >token.c
+
+libbas.a:	auto.o bas.o fs.o global.o token.o program.o \
+		str.o value.o var.o
+		rm -f $@
+		ar cq $@ auto.o bas.o fs.o global.o token.o program.o \
+		str.o value.o var.o
+		@RANLIB@ libbas.a
+
+cppcheck:
+		cppcheck $(CPPFLAGS) -q --enable=all .
+
+install-po:	install-po-@USE_NLS@
+install-po-no:
+install-po-yes:	$(CATALOGS)
+		for cat in $(CATALOGS); do \
+		  dir=$(localedir)/`basename $$cat .mo`/LC_MESSAGES; \
+		  [ -d $$dir ] || @INSTALL@ -m 755 -d $$dir; \
+		  @INSTALL@ -m 644 $$cat $$dir/bas.mo; \
+		done
+
+check:		bas
+		for i in test/test*; do ./$$i || break; done
+
+install:	all
+		@INSTALL@ -m 755 -d @bindir@
+		@INSTALL@ bas @bindir@/bas
+		@INSTALL@ -m 755 -d @libdir@
+		@INSTALL@ -m 644 libbas.a @libdir@/libbas.a
+		@RANLIB@ @libdir@/libbas.a
+		@INSTALL@ -m 755 -d @mandir@/man1
+		@INSTALL@ -m 644 bas.1 @mandir@/man1/bas.1
+		make install-po
+
+.c.o:
+		$(CC) -c $(CPPFLAGS) $(CFLAGS) $<
+
+.SUFFIXES:	.po .mo
+
+.po.mo:
+		msgfmt -o $@ $<
+
+*.po:		bas.pot
+		for cat in *.po; do \
+		  if msgmerge $$cat bas.pot -o $$cat.tmp; then \
+		    mv -f $$cat.tmp $$cat; \
+		  else \
+		    echo "msgmerge for $$cat failed!"; \
+		    rm -f $$cat.tmp; \
+		  fi; \
+		done
+
+bas.pot:	[a-b]*.[ch] [e-s]*.[ch] v*.[ch]
+		xgettext --add-comments --keyword=_ [a-b]*.[ch] [e-s]*.[ch] v*.[ch] && test -f messages.po && mv messages.po $@
+
+bas.pdf:	bas.1
+		groff -Tps -t -man bas.1 | ps2pdf - $@
+
+#{{{script}}}#{{{ clean
+clean:
+		rm -f *.out core token.c *.o libbas.a *.mo
+#}}}
+#{{{ distclean
+distclean:	clean
+		rm -rf autom4te.cache bas config.cache config.h config.log config.status configure.lineno Makefile bas.1 test/runbas
+#}}}
+#{{{ tar
+tar:		bas.pdf distclean
+		(b=`pwd`; b=`basename $$b`; cd ..; tar zcvf $$b.tar.gz $$b/LICENSE $$b/INSTALL $$b/Makefile.in $$b/README $$b/NEWS $$b/configure $$b/install-sh $$b/test $$b/[a-z]*.*)
+#}}}
+#{{{ dependencies
+auto.o:	auto.c config.h auto.h programtypes.h var.h value.h str.h token.h autotypes.h program.h
+bas.o:	bas.c config.h getopt.h auto.h programtypes.h var.h value.h str.h token.h autotypes.h \
+	 program.h bas.h error.h fs.h global.h statement.c statement.h
+fs.o:	fs.c config.h fs.h str.h
+getopt.o:	getopt.c config.h getopt.h
+getopt1.o:	getopt1.c config.h getopt.h
+global.o:	global.c config.h auto.h programtypes.h var.h value.h str.h token.h autotypes.h \
+	 program.h bas.h error.h fs.h global.h
+main.o:	main.c config.h getopt.h bas.h
+program.o:	program.c config.h auto.h programtypes.h var.h value.h str.h token.h autotypes.h \
+	 program.h error.h fs.h
+statement.o:	statement.c config.h statement.h
+str.o:	str.c config.h str.h
+token.o:	token.c config.h auto.h programtypes.h var.h value.h str.h token.h autotypes.h \
+	 program.h statement.h
+value.o:	value.c config.h error.h value.h str.h
+var.o:	var.c config.h error.h var.h value.h str.h
+#}}}

interpreters/bas/NEWS

@@ -0,0 +1,15 @@
+Changes compared to version 2.3
+
+o  Matrix inversion on integer arrays with option base 1 fixed
+o  PRINT USING behaviour for ! fixed
+o  PRINT , separator should advance to the next zone, even if the current
+   position is at the start of a zone
+o  Added ip(), frac(), fp(), log10(), log2(), min() and max()
+o  Fixed NEXT checking the variable case sensitive
+o  Use terminfo capability cr to make use of its padding
+o  LET segmentation fault fixed
+o  PRINT now uses print items
+o  -r for restricted operation
+o  MAT INPUT does not drop excess arguments, but uses them for the
+   next row
+o  License changed to MIT

interpreters/bas/README

@@ -0,0 +1,35 @@
+Bas is an interpreter for the classic dialect of the programming language
+BASIC.  It is pretty compatible to typical BASIC interpreters of the 1980s,
+unlike some other UNIX BASIC interpreters, that implement a different
+syntax, breaking compatibility to existing programs.  Bas offers many ANSI
+BASIC statements for structured programming, such as procedures, local
+variables and various loop types.  Further there are matrix operations,
+automatic LIST indentation and many statements and functions found in
+specific classic dialects.  Line numbers are not required.
+
+The interpreter tokenises the source and resolves references to variables
+and jump targets before running the program.  This compilation pass
+increases efficiency and catches syntax errors, type errors and references
+to variables that are never initialised.  Bas is written in ANSI C for
+UNIX systems.
+
+Please do "make check" after compiling bas to run a couple regression
+tests.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

interpreters/bas/auto.c

@@ -0,0 +1,240 @@
+/* Local variables and the run time stack. */
+/* #includes */ /*{{{C}}}*//*{{{*/
+#undef  _POSIX_SOURCE
+#define _POSIX_SOURCE   1
+#undef  _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 2
+
+#include "config.h"
+
+#include <assert.h>
+#include <ctype.h>
+#ifdef HAVE_GETTEXT
+#include <libintl.h>
+#define _(String) gettext(String)
+#else
+#define _(String) String
+#endif
+#include <stdlib.h>
+#include <string.h>
+
+#include "auto.h"
+
+#ifdef USE_DMALLOC
+#include "dmalloc.h"
+#endif
+/*}}}*/
+/* #defines */ /*{{{*/
+#define INCREASE_STACK 16
+/*}}}*/
+
+/* interpretation methods */
+struct Auto *Auto_new(struct Auto *this) /*{{{*/
+{
+  this->stackPointer=0;
+  this->stackCapacity=0;
+  this->framePointer=0;
+  this->frameSize=0;
+  this->onerror.line=-1;
+  this->erl=0;
+  Value_new_NIL(&this->err);
+  Value_new_NIL(&this->lastdet);
+  this->begindata.line=-1;
+  this->slot=(union AutoSlot*)0;
+  this->cur=this->all=(struct Symbol*)0;
+  return this;
+}
+/*}}}*/
+void Auto_destroy(struct Auto *this) /*{{{*/
+{
+  struct Symbol *l;
+
+  Value_destroy(&this->err);
+  Value_destroy(&this->lastdet);
+  if (this->stackCapacity) free(this->slot);
+  for (l=this->all; l!=(struct Symbol*)0; )
+  {
+    struct Symbol *f;
+
+    f=l;
+    l=l->next;
+    free(f->name);
+    free(f);
+  }
+}
+/*}}}*/
+struct Var *Auto_pushArg(struct Auto *this) /*{{{*/
+{
+  if ((this->stackPointer+1)>=this->stackCapacity)
+  {
+    this->slot=realloc(this->slot,sizeof(this->slot[0])*(this->stackCapacity?(this->stackCapacity=this->stackPointer+INCREASE_STACK):(this->stackCapacity=INCREASE_STACK)));
+  }
+  return &this->slot[this->stackPointer++].var;
+}
+/*}}}*/
+void Auto_pushFuncRet(struct Auto *this, int firstarg, struct Pc *pc) /*{{{*/
+{
+  if (this->stackPointer+2>=this->stackCapacity)
+  {
+    this->slot=realloc(this->slot,sizeof(this->slot[0])*(this->stackCapacity?(this->stackCapacity=this->stackCapacity+INCREASE_STACK):(this->stackCapacity=INCREASE_STACK)));
+  }
+  this->slot[this->stackPointer].retException.onerror=this->onerror;
+  this->slot[this->stackPointer].retException.resumeable=this->resumeable;
+  ++this->stackPointer;
+  this->slot[this->stackPointer].retFrame.pc=*pc;
+  this->slot[this->stackPointer].retFrame.framePointer=this->framePointer;
+  this->slot[this->stackPointer].retFrame.frameSize=this->frameSize;
+  ++this->stackPointer;
+  this->framePointer=firstarg;
+  this->frameSize=this->stackPointer-firstarg;
+  this->onerror.line=-1;
+}
+/*}}}*/
+void Auto_pushGosubRet(struct Auto *this, struct Pc *pc) /*{{{*/
+{
+  if ((this->stackPointer+1)>=this->stackCapacity)
+  {
+    this->slot=realloc(this->slot,sizeof(this->slot[0])*(this->stackCapacity?(this->stackCapacity=this->stackPointer+INCREASE_STACK):(this->stackCapacity=INCREASE_STACK)));
+  }
+  this->slot[this->stackPointer].retFrame.pc=*pc;
+  ++this->stackPointer;
+}
+/*}}}*/
+struct Var *Auto_local(struct Auto *this, int l) /*{{{*/
+{
+  assert(this->frameSize>(l+2));
+  return &(this->slot[this->framePointer+l].var);
+}
+/*}}}*/
+int Auto_funcReturn(struct Auto *this, struct Pc *pc) /*{{{*/
+{
+  int i,retFrame,retException;
+
+  if (this->stackPointer==0) return 0;
+  assert(this->frameSize);
+  retFrame=this->framePointer+this->frameSize-1;
+  retException=this->framePointer+this->frameSize-2;
+  assert(retException>=0 && retFrame<this->stackPointer);
+  for (i=0; i<this->frameSize-2; ++i) Var_destroy(&this->slot[this->framePointer+i].var);
+  this->stackPointer=this->framePointer;
+  if (pc!=(struct Pc*)0) *pc=this->slot[retFrame].retFrame.pc;
+  this->frameSize=this->slot[retFrame].retFrame.frameSize;
+  this->framePointer=this->slot[retFrame].retFrame.framePointer;
+  this->onerror=this->slot[retException].retException.onerror;
+  return 1;
+}
+/*}}}*/
+int Auto_gosubReturn(struct Auto *this, struct Pc *pc) /*{{{*/
+{
+  if (this->stackPointer<=this->framePointer+this->frameSize) return 0;
+  --this->stackPointer;
+  if (pc) *pc=this->slot[this->stackPointer].retFrame.pc;
+  return 1;
+}
+/*}}}*/
+void Auto_frameToError(struct Auto *this, struct Program *program, struct Value *v) /*{{{*/
+{
+  int i=this->stackPointer,framePointer,frameSize,retFrame;
+  struct Pc p;
+
+  framePointer=this->framePointer;
+  frameSize=this->frameSize;
+  while (i>framePointer+frameSize)
+  {
+    p=this->slot[--i].retFrame.pc;
+    Value_errorSuffix(v,_("Called"));
+    Program_PCtoError(program,&p,v);
+  }
+  if (i)
+  {
+    retFrame=framePointer+frameSize-1;
+    i=framePointer;
+    p=this->slot[retFrame].retFrame.pc;
+    frameSize=this->slot[retFrame].retFrame.frameSize;
+    framePointer=this->slot[retFrame].retFrame.framePointer;
+    Value_errorSuffix(v,_("Proc Called"));
+    Program_PCtoError(program,&p,v);
+  }
+}
+/*}}}*/
+void Auto_setError(struct Auto *this, long int line, struct Pc *pc, struct Value *v) /*{{{*/
+{
+  this->erpc=*pc;
+  this->erl=line;
+  Value_destroy(&this->err);
+  Value_clone(&this->err,v);
+}
+/*}}}*/
+
+/* compilation methods */
+int Auto_find(struct Auto *this, struct Identifier *ident) /*{{{*/
+{
+  struct Symbol *find;
+
+  for (find=this->cur; find!=(struct Symbol*)0; find=find->next)
+  {
+    const char *s=ident->name;
+    const char *r=find->name;
+
+    while (*s && tolower(*s)==tolower(*r)) { ++s; ++r; };
+    if (tolower(*s)==tolower(*r))
+    {
+      ident->sym=find;
+      return 1;
+    }
+  }
+  return 0;
+}
+/*}}}*/
+int Auto_variable(struct Auto *this, const struct Identifier *ident) /*{{{*/
+{
+  struct Symbol **tail;
+  int offset;
+
+  for (offset=0,tail=&this->cur; *tail!=(struct Symbol*)0; tail=&(*tail)->next,++offset)
+  {
+    const char *s=ident->name;
+    const char *r=(*tail)->name;
+
+    while (*s && tolower(*s)==tolower(*r)) { ++s; ++r; };
+    if (tolower(*s)==tolower(*r)) return 0;
+  }
+  (*tail)=malloc(sizeof(struct Symbol));
+  (*tail)->next=(struct Symbol*)0;
+  (*tail)->name=strcpy(malloc(strlen(ident->name)+1),ident->name);
+  (*tail)->type=LOCALVAR;
+  (*tail)->u.local.type=ident->defaultType;
+  /* the offset -1 of the V_VOID procedure return symbol is ok, it is not used */
+  (*tail)->u.local.offset=offset-(this->cur->u.local.type==V_VOID?1:0);
+  return 1;
+}
+/*}}}*/
+enum ValueType Auto_argType(const struct Auto *this, int l) /*{{{*/
+{
+  struct Symbol *find;
+  int offset;
+
+  if (this->cur->u.local.type==V_VOID) ++l;
+  for (offset=0,find=this->cur; l!=offset; find=find->next,++offset) assert(find!=(struct Symbol*)0);
+  assert(find!=(struct Symbol*)0);
+  return find->u.local.type;
+}
+/*}}}*/
+enum ValueType Auto_varType(const struct Auto *this, struct Symbol *sym) /*{{{*/
+{
+  struct Symbol *find;
+
+  for (find=this->cur; find->u.local.offset!=sym->u.local.offset; find=find->next) assert(find!=(struct Symbol*)0);
+  assert(find!=(struct Symbol*)0);
+  return find->u.local.type;
+}
+/*}}}*/
+void Auto_funcEnd(struct Auto *this) /*{{{*/
+{
+  struct Symbol **tail;
+
+  for (tail=&this->all; *tail!=(struct Symbol*)0; tail=&(*tail)->next);
+  *tail=this->cur;
+  this->cur=(struct Symbol*)0;
+}
+/*}}}*/

interpreters/bas/auto.h

@@ -0,0 +1,63 @@
+#ifndef AUTO_H
+#define AUTO_H
+
+#include "programtypes.h"
+#include "var.h"
+
+struct Auto
+{
+  long int stackPointer;
+  long int stackCapacity;
+  long int framePointer;
+  long int frameSize;
+  struct Pc onerror;
+  union AutoSlot *slot;
+  long int erl;
+  struct Pc erpc;
+  struct Value err;
+  struct Value lastdet;
+  struct Pc begindata;
+  int resumeable;
+  struct Symbol *cur,*all; /* should be hung off the funcs/procs */
+};
+
+struct AutoFrameSlot
+{
+  long int framePointer;
+  long int frameSize;
+  struct Pc pc;
+};
+
+struct AutoExceptionSlot
+{
+  struct Pc onerror;
+  int resumeable;
+};
+
+union AutoSlot
+{
+  struct AutoFrameSlot retFrame;
+  struct AutoExceptionSlot retException;
+  struct Var var;
+};
+
+#include "token.h"
+
+extern struct Auto *Auto_new(struct Auto *this);
+extern void Auto_destroy(struct Auto *this);
+extern struct Var *Auto_pushArg(struct Auto *this);
+extern void Auto_pushFuncRet(struct Auto *this, int firstarg, struct Pc *pc);
+extern void Auto_pushGosubRet(struct Auto *this, struct Pc *pc);
+extern struct Var *Auto_local(struct Auto *this, int l);
+extern int Auto_funcReturn(struct Auto *this, struct Pc *pc);
+extern int Auto_gosubReturn(struct Auto *this, struct Pc *pc);
+extern void Auto_frameToError(struct Auto *this, struct Program *program, struct Value *v);
+extern void Auto_setError(struct Auto *this, long int line, struct Pc *pc, struct Value *v);
+
+extern int Auto_find(struct Auto *this, struct Identifier *ident);
+extern int Auto_variable(struct Auto *this, const struct Identifier *ident);
+extern enum ValueType Auto_argType(const struct Auto *this, int l);
+extern enum ValueType Auto_varType(const struct Auto *this, struct Symbol *sym);
+extern void Auto_funcEnd(struct Auto *this);
+
+#endif

interpreters/bas/autotypes.h

@@ -0,0 +1,35 @@
+#ifndef AUTO_H
+#define AUTO_H
+
+#include "program.h"
+#include "var.h"
+#include "token.h"
+
+struct Auto
+{
+  long int stackPointer;
+  long int stackCapacity;
+  long int framePointer;
+  long int frameSize;
+  struct Pc onerror;
+  union AutoSlot *slot;
+  long int erl;
+  struct Pc erpc;
+  struct Value err;
+  int resumeable;
+
+  struct Symbol *cur,*all;
+};
+
+union AutoSlot
+{
+  struct
+  {
+    long int framePointer;
+    long int frameSize;
+    struct Pc pc;
+  } ret;
+  struct Var var;
+};
+
+#endif

interpreters/bas/bas.h

@@ -0,0 +1,18 @@
+#ifndef BAS_H
+#define BAS_H
+
+#define STDCHANNEL 0
+#define LPCHANNEL 32
+
+extern int bas_argc;
+extern char *bas_argv0;
+extern char **bas_argv;
+extern int bas_end;
+
+extern void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd);
+extern void bas_runFile(const char *runFile);
+extern void bas_runLine(const char *runLine);
+extern void bas_interpreter(void);
+extern void bas_exit(void);
+
+#endif

interpreters/bas/config.h

@@ -0,0 +1,43 @@
+/* config.h.  Generated from config.h.in by configure.  */
+/* The version string */
+#define VERSION "2.4"
+
+/* The package name. */
+#define PACKAGE "bas"
+
+/* Do you have tgetent()? */
+/* #undef HAVE_TGETENT */
+
+/* Should we need to include termcap.h? */
+/* #undef HAVE_TERMCAP_H */
+
+/* Should we need to include curses.h? */
+/* #undef HAVE_CURSES_H */
+
+/* Is there a tgmath.h? */
+/* #undef HAVE_TGMATH_H */
+
+/* Define this as 1 if your system has lrint(). */
+/* #undef HAVE_LRINT */
+
+/* Define this as 1 if your system has nanosleep(). */
+#define HAVE_NANOSLEEP 1
+
+/* What does tputs return? */
+/* #undef TPUTS_RETURNS_VOID */
+
+/* Define as 1 if you use dmalloc. */
+/* #undef USE_DMALLOC */
+
+/* Define as 1 if you want LR0 parser. */
+/* #undef USE_LR0 */
+
+/* Define either for large file support, if your OS needs them. */
+/* #undef _FILE_OFFSET_BITS */
+/* #undef _LARGE_FILES */
+
+/* Define if you have the msgfmt(1) program and the gettext(3) function. */
+/* #undef HAVE_GETTEXT */
+
+/* Define if timeouts do not work in your termios (broken termios). */
+/* #undef USE_SELECT */

interpreters/bas/config.h.in

@@ -0,0 +1,42 @@
+/* The version string */
+#define VERSION @VERSION@
+
+/* The package name. */
+#define PACKAGE @PACKAGE@
+
+/* Do you have tgetent()? */
+#undef HAVE_TGETENT
+
+/* Should we need to include termcap.h? */
+#undef HAVE_TERMCAP_H
+
+/* Should we need to include curses.h? */
+#undef HAVE_CURSES_H
+
+/* Is there a tgmath.h? */
+#undef HAVE_TGMATH_H
+
+/* Define this as 1 if your system has lrint(). */
+#undef HAVE_LRINT
+
+/* Define this as 1 if your system has nanosleep(). */
+#undef HAVE_NANOSLEEP
+
+/* What does tputs return? */
+#undef TPUTS_RETURNS_VOID
+
+/* Define as 1 if you use dmalloc. */
+#undef USE_DMALLOC
+
+/* Define as 1 if you want LR0 parser. */
+#undef USE_LR0
+
+/* Define either for large file support, if your OS needs them. */
+#undef _FILE_OFFSET_BITS
+#undef _LARGE_FILES
+
+/* Define if you have the msgfmt(1) program and the gettext(3) function. */
+#undef HAVE_GETTEXT
+
+/* Define if timeouts do not work in your termios (broken termios). */
+#undef USE_SELECT

interpreters/bas/configure.in

@@ -0,0 +1,141 @@
+AC_INIT(bas.c)
+AC_CONFIG_HEADER(config.h)
+AC_CANONICAL_HOST
+VERSION=2.4
+UPDATED='October 25, 2014'
+
+ALL_LINGUAS="de"
+
+case $host in
+  *-linux-*)
+    if test "$prefix" = NONE
+    then
+      prefix=/usr
+      AC_MSG_RESULT([using prefix $prefix])
+    fi
+  ;;
+  hppa1.1-hp-hpux11.00)
+    EXTRA_CFLAGS='+O2 +Onolimit -D_XOPEN_SOURCE_EXTENDED '
+    EXTRA_LDFLAGS='-z '
+    EXTRA_GCFLAGS='-D_XOPEN_SOURCE_EXTENDED '
+    EXTRA_LDFLAGS='-Wl,-z '
+  ;;
+  *-cygwin)
+    AC_DEFINE(USE_SELECT)
+  ;;
+  *)
+    prefix=$ac_default_prefix
+  ;;
+esac
+
+AC_PROG_CC
+if test "$GCC" = yes
+then
+  CFLAGS="${CFLAGS} ${EXTRA_GCFLAGS}-pipe -Wall -Wshadow -Wbad-function-cast -Wmissing-prototypes -Wstrict-prototypes -Wcast-align -Wcast-qual -Wpointer-arith -Wwrite-strings -Wmissing-declarations -Wnested-externs -Wundef -pedantic -fno-common"
+  LDFLAGS="${LDFLAGS} ${EXTRA_GLDFLAGS}-g"
+else
+  CFLAGS="${CFLAGS} ${EXTRA_CFLAGS}"
+  LDFLAGS="${LDFLAGS} ${EXTRA_LDFLAGS}"
+fi
+
+AC_PROG_RANLIB
+
+AC_CHECK_HEADERS(termcap.h,have_termcap_h=yes)
+if test "$have_termcap_h" != yes; then
+  AC_CHECK_HEADERS(curses.h,have_curses_h=yes)
+fi
+
+AC_MSG_CHECKING(for tputs return type)
+AC_TRY_COMPILE([#ifdef HAVE_TERMCAP_H
+#include <termcap.h>
+#else
+#include <curses.h>
+#endif
+static int outc(int c){ return c; }
+],[return tputs((char*)0,0,outc);
+],AC_MSG_RESULT(int),AC_DEFINE(TPUTS_RETURNS_VOID) AC_MSG_RESULT(void))
+
+AC_CHECK_FUNC(fmod, [have_fmod=yes])
+if test "$have_fmod" != yes; then
+        AC_CHECK_LIB(m, fmod, [have_fmod=yes; LIBS="-lm $LIBS"])
+fi
+if test "$have_fmod" != yes
+then
+        AC_MSG_RESULT([no fmod() found, configure failed.])
+        exit 1
+fi
+
+AC_CHECK_HEADERS(tgmath.h,have_tgmath_h=yes)
+AC_CHECK_FUNCS(lrint)
+AC_CHECK_FUNCS(nanosleep)
+
+AC_CHECK_FUNCS(tgetent,have_tgetent=yes)
+if test "$have_tgetent" != yes; then
+  AC_CHECK_LIB(curses, tgetent,AC_DEFINE(HAVE_TGETENT) have_tgetent=yes; LIBS="-lcurses $LIBS")
+fi
+if test "$have_tgetent" != yes; then
+        AC_CHECK_LIB(termcap, tgetent, AC_DEFINE(HAVE_TGETENT) [have_tgetent=yes; LIBS="-ltermcap $LIBS"])
+fi
+# The following applies to sick Linux distributions.
+if test "$have_tgetent" != yes; then
+       AC_CHECK_LIB(ncurses, tgetent, AC_DEFINE(HAVE_TGETENT) [have_tgetent=yes; LIBS="-lncurses $LIBS"])
+fi
+
+AC_ARG_WITH(dmalloc,
+  [  --with-dmalloc=DIR      dmalloc include/library installation prefix],
+  [CPPFLAGS="$CPPFLAGS -I$with_dmalloc/include"
+  LDFLAGS="$LDFLAGS -L$with_dmalloc/lib"
+  LIBS="$LIBS -ldmalloc"
+  AC_DEFINE(USE_DMALLOC)]
+)
+
+AC_ARG_WITH(efence,
+  [  --with-efence=DIR       efence include/library installation prefix],
+  [CPPFLAGS="$CPPFLAGS -I$with_efence/include"
+  LDFLAGS="$LDFLAGS -L$with_efence/lib"
+  LIBS="$LIBS -lefence"]
+)
+
+AC_ARG_WITH(valgrind,
+  [  --with-valgrind         run regression tests with valgrind],
+  [VALGRIND="valgrind"
+  AC_SUBST(VALGRIND)]
+)
+
+AC_MSG_CHECKING(whether to use LR0 parser)
+AC_ARG_ENABLE(lr0,
+  [  --enable-lr0            use LR0 parser (default is recursive descending)],
+  [
+  case "$enableval" in
+    yes)
+      AC_DEFINE(USE_LR0)
+      AC_MSG_RESULT(yes)
+    ;;
+    no)
+      AC_MSG_RESULT(no)
+    ;;
+  esac],
+  [AC_MSG_RESULT(no)]
+)
+
+USE_NLS=no
+AC_CHECK_PROG(MSGFMT,msgfmt,yes,no)
+if test "$MSGFMT" = yes
+then
+  AC_CHECK_HEADERS(libintl.h,[LIBINTL=yes])
+  if test "$LIBINTL" = yes
+  then
+    AC_SEARCH_LIBS(gettext,intl,[AC_DEFINE(HAVE_GETTEXT) USE_NLS=yes])
+  fi
+fi
+
+AC_SYS_LARGEFILE
+
+AC_PROG_INSTALL
+
+AC_DEFINE_UNQUOTED(VERSION,"$VERSION")
+AC_SUBST(VERSION)
+AC_SUBST(UPDATED)
+AC_SUBST(USE_NLS)
+AC_OUTPUT(Makefile bas.1 test/runbas)
+chmod 755 test/runbas

interpreters/bas/error.h

@@ -0,0 +1,133 @@
+#ifndef ERROR_H
+#define ERROR_H
+
+//#include "config.h"
+
+#ifdef HAVE_GETTEXT
+#include <libintl.h>
+#define _(String) gettext(String)
+#else
+#define _(String) String
+#endif
+
+#define STATIC 100
+
+#define ALREADYDECLARED    STATIC+ 0, _("Formal parameter already declared")
+#define ALREADYLOCAL       STATIC+ 1, _("Variable already declared as `local'")
+#define BADIDENTIFIER      STATIC+ 2, _("Identifier can not be declared as %s")
+#define BADRANGE           STATIC+ 3, _("Ranges must be constructed from single letter identifiers")
+#define INVALIDLINE        STATIC+ 4, _("Missing line number at the beginning of text line %d")
+#define INVALIDUOPERAND    STATIC+ 5, _("Invalid unary operand")
+#define INVALIDOPERAND     STATIC+ 6, _("Invalid binary operand")
+#define MISSINGAS          STATIC+ 7, _("Missing `as'")
+#define MISSINGCOLON       STATIC+ 8, _("Missing colon `:'")
+#define MISSINGCOMMA       STATIC+ 9, _("Missing comma `,'")
+#define MISSINGCP          STATIC+10, _("Missing right parenthesis `)'")
+#define MISSINGDATAINPUT   STATIC+11, _("Missing `data' input")
+#define MISSINGDECINCIDENT STATIC+12, _("Missing `dec'/`inc' variable identifier")
+#define MISSINGEQ          STATIC+13, _("Missing equal sign `='")
+#define MISSINGEXPR        STATIC+14, _("Expected %s expression")
+#define MISSINGFILE        STATIC+15, _("Missing `file'")
+#define MISSINGGOTOSUB     STATIC+16, _("Missing `goto' or `gosub'")
+#define MISSINGVARIDENT    STATIC+17, _("Missing variable identifier")
+#define MISSINGPROCIDENT   STATIC+18, _("Missing procedure identifier")
+#define MISSINGFUNCIDENT   STATIC+19, _("Missing function identifier")
+#define MISSINGARRIDENT    STATIC+20, _("Missing array variable identifier")
+#define MISSINGSTRIDENT    STATIC+21, _("Missing string variable identifier")
+#define MISSINGLOOPIDENT   STATIC+22, _("Missing loop variable identifier")
+#define MISSINGFORMIDENT   STATIC+23, _("Missing formal parameter identifier")
+#define MISSINGREADIDENT   STATIC+24, _("Missing `read' variable identifier")
+#define MISSINGSWAPIDENT   STATIC+25, _("Missing `swap' variable identifier")
+#define MISSINGMATIDENT    STATIC+26, _("Missing matrix variable identifier")
+#define MISSINGINCREMENT   STATIC+27, _("Missing line increment")
+#define MISSINGLEN         STATIC+28, _("Missing `len'")
+#define MISSINGLINENUMBER  STATIC+29, _("Missing line number")
+#define MISSINGOP          STATIC+30, _("Missing left parenthesis `('")
+#define MISSINGSEMICOLON   STATIC+31, _("Missing semicolon `;'")
+#define MISSINGSEMICOMMA   STATIC+32, _("Missing semicolon `;' or comma `,'")
+#define MISSINGMULT        STATIC+33, _("Missing star `*'")
+#define MISSINGSTATEMENT   STATIC+34, _("Missing statement")
+#define MISSINGTHEN        STATIC+35, _("Missing `then'")
+#define MISSINGTO          STATIC+36, _("Missing `to'")
+#define NESTEDDEFINITION   STATIC+37, _("Nested definition")
+#define NOPROGRAM          STATIC+38, _("No program")
+#define NOSUCHDATALINE     STATIC+39, _("No such `data' line")
+#define NOSUCHLINE         STATIC+40, _("No such line")
+#define REDECLARATION      STATIC+41, _("Redeclaration as different kind of symbol")
+#define STRAYCASE          STATIC+42, _("`case' without `select case'")
+#define STRAYDO            STATIC+43, _("`do' without `loop'")
+#define STRAYDOcondition   STATIC+44, _("`do while' or `do until' without `loop'")
+#define STRAYELSE1         STATIC+45, _("`else' without `if'")
+#define STRAYELSE2         STATIC+46, _("`else' without `end if'")
+#define STRAYENDIF         STATIC+47, _("`end if' without multiline `if' or `else'")
+#define STRAYSUBEND        STATIC+49, _("`subend', `end sub' or `endproc' without `sub' or `def proc' inside %s")
+#define STRAYSUBEXIT       STATIC+50, _("`subexit' without `sub' inside %s")
+#define STRAYENDSELECT     STATIC+51, _("`end select' without `select case'")
+#define STRAYENDFN         STATIC+52, _("`end function' without `def fn' or `function'")
+#define STRAYENDEQ         STATIC+53, _("`=' returning from function without `def fn'")
+#define STRAYEXITDO        STATIC+54, _("`exit do' without `do'")
+#define STRAYEXITFOR       STATIC+55, _("`exit for' without `for'")
+#define STRAYFNEND         STATIC+56, _("`fnend' without `def fn'")
+#define STRAYFNEXIT        STATIC+57, _("`exit function' outside function declaration")
+#define STRAYFNRETURN      STATIC+58, _("`fnreturn' without `def fn'")
+#define STRAYFOR           STATIC+59, _("`for' without `next'")
+#define STRAYFUNC          STATIC+60, _("Function/procedure declaration without end")
+#define STRAYIF            STATIC+61, _("`if' without `end if'")
+#define STRAYLOCAL         STATIC+62, _("`local' without `def fn' or `def proc'")
+#define STRAYLOOP          STATIC+63, _("`loop' without `do'")
+#define STRAYLOOPUNTIL     STATIC+64, _("`loop until' without `do'")
+#define STRAYNEXT          STATIC+65, _("`next' without `for' inside %s")
+#define STRAYREPEAT        STATIC+66, _("`repeat' without `until'")
+#define STRAYSELECTCASE    STATIC+67, _("`select case' without `end select'")
+#define STRAYUNTIL         STATIC+68, _("`until' without `repeat'")
+#define STRAYWEND          STATIC+69, _("`wend' without `while' inside %s")
+#define STRAYWHILE         STATIC+70, _("`while' without `wend'")
+#define SYNTAX             STATIC+71, _("Syntax")
+#define TOOFEW             STATIC+72, _("Too few parameters")
+#define TOOMANY            STATIC+73, _("Too many parameters")
+#define TYPEMISMATCH1      STATIC+74, _("Type mismatch (has %s, need %s)")
+#define TYPEMISMATCH2      STATIC+75, _("Type mismatch of argument %d")
+#define TYPEMISMATCH3      STATIC+76, _("%s of argument %d")
+#define TYPEMISMATCH4      STATIC+77, _("Type mismatch (need string variable)")
+#define TYPEMISMATCH5      STATIC+78, _("Type mismatch (need numeric variable)")
+#define TYPEMISMATCH6      STATIC+79, _("Type mismatch (need numeric value)")
+#define UNDECLARED         STATIC+80, _("Undeclared function or variable")
+#define UNNUMBERED         STATIC+81, _("Use `renum' to number program first")
+#define OUTOFSCOPE         STATIC+82, _("Line out of scope")
+#define VOIDVALUE          STATIC+83, _("Procedures do not return values")
+#define UNREACHABLE        STATIC+84, _("Unreachable statement")
+#define WRONGMODE          STATIC+85, _("Wrong access mode")
+#define FORMISMATCH        STATIC+86, _("`next' variable does not match `for' variable")
+#define NOSUCHIMAGELINE    STATIC+87, _("No such `image' line")
+#define MISSINGFMT         STATIC+88, _("Missing `image' format")
+#define MISSINGRELOP       STATIC+89, _("Missing relational operator")
+
+#define RUNTIME 200
+
+#define MISSINGINPUTDATA   RUNTIME+0, _("Missing `input' data")
+#define MISSINGCHARACTER   RUNTIME+1, _("Missing character after underscore `_' in format string")
+#define NOTINDIRECTMODE    RUNTIME+2, _("Not allowed in interactive mode")
+#define NOTINPROGRAMMODE   RUNTIME+3, _("Not allowed in program mode")
+#define BREAK              RUNTIME+4, _("Break")
+#define UNDEFINED          RUNTIME+5, _("%s is undefined")
+#define OUTOFRANGE         RUNTIME+6, _("%s is out of range")
+#define STRAYRESUME        RUNTIME+7, _("`resume' without exception")
+#define STRAYRETURN        RUNTIME+8, _("`return' without `gosub'")
+#define BADCONVERSION      RUNTIME+9, _("Bad %s conversion")
+#define IOERROR            RUNTIME+10,_("Input/Output error (%s)")
+#define IOERRORCREATE      RUNTIME+10,_("Input/Output error (Creating `%s' failed: %s)")
+#define IOERRORCLOSE       RUNTIME+10,_("Input/Output error (Closing `%s' failed: %s)")
+#define IOERROROPEN        RUNTIME+10,_("Input/Output error (Opening `%s' failed: %s)")
+#define ENVIRONFAILED      RUNTIME+11,_("Setting environment variable failed (%s)")
+#define REDIM              RUNTIME+12,_("Trying to redimension existing array")
+#define FORKFAILED         RUNTIME+13,_("Forking child process failed (%s)")
+#define BADMODE            RUNTIME+14,_("Invalid mode")
+#define ENDOFDATA          RUNTIME+15,_("end of `data'")
+#define DIMENSION          RUNTIME+16,_("Dimension mismatch")
+#define NOMATRIX           RUNTIME+17,_("Variable dimension must be 2 (is %d), base must be 0 or 1 (is %d)")
+#define SINGULAR           RUNTIME+18,_("Singular matrix")
+#define BADFORMAT          RUNTIME+19,_("Syntax error in print format")
+#define OUTOFMEMORY        RUNTIME+20,_("Out of memory")
+#define RESTRICTED         RUNTIME+21,_("Restricted")
+
+#endif

interpreters/bas/fs.h

@@ -0,0 +1,115 @@
+#ifndef FILE_H
+#define FILE_H
+
+#include "str.h"
+
+struct FileStream
+{
+  int dev,tty;
+  int recLength;
+
+  int infd;
+  char inBuf[1024];
+  size_t inSize,inCapacity;
+
+  int outfd;
+  int outPos;
+  int outLineWidth;
+  int outColWidth;
+  char outBuf[1024];
+  size_t outSize,outCapacity;
+  int outforeground,outbackground;
+
+  int randomfd;
+  int recPos;
+  char *recBuf;
+  struct StringField field;
+
+  int binaryfd;
+};
+
+#define FS_COLOUR_BLACK         0
+#define FS_COLOUR_BLUE          1
+#define FS_COLOUR_GREEN         2
+#define FS_COLOUR_CYAN          3
+#define FS_COLOUR_RED           4
+#define FS_COLOUR_MAGENTA       5
+#define FS_COLOUR_BROWN         6
+#define FS_COLOUR_WHITE         7
+#define FS_COLOUR_GREY          8
+#define FS_COLOUR_LIGHTBLUE     9
+#define FS_COLOUR_LIGHTGREEN    10
+#define FS_COLOUR_LIGHTCYAN     11
+#define FS_COLOUR_LIGHTRED      12
+#define FS_COLOUR_LIGHTMAGENTA  13
+#define FS_COLOUR_YELLOW        14
+#define FS_COLOUR_BRIGHTWHITE   15
+
+#define FS_ACCESS_NONE          0
+#define FS_ACCESS_READ          1
+#define FS_ACCESS_WRITE         2
+#define FS_ACCESS_READWRITE     3
+
+#define FS_LOCK_NONE            0
+#define FS_LOCK_SHARED          1
+#define FS_LOCK_EXCLUSIVE       2
+
+extern const char *FS_errmsg;
+extern volatile int FS_intr;
+
+extern int FS_opendev(int dev, int infd, int outfd);
+extern int FS_openin(const char *name);
+extern int FS_openinChn(int chn, const char *name, int mode);
+extern int FS_openout(const char *name);
+extern int FS_openoutChn(int chn, const char *name, int mode, int append);
+extern int FS_openrandomChn(int chn, const char *name, int mode, int recLength);
+extern int FS_openbinaryChn(int chn, const char *name, int mode);
+extern int FS_freechn(void);
+extern int FS_flush(int dev);
+extern int FS_close(int dev);
+extern int FS_istty(int chn);
+extern int FS_lock(int chn, off_t offset, off_t length, int mode, int w);
+extern int FS_truncate(int chn);
+extern void FS_shellmode(int chn);
+extern void FS_fsmode(int chn);
+extern void FS_xonxoff(int chn, int on);
+extern int FS_put(int chn);
+extern int FS_putChar(int dev, char ch);
+extern int FS_putChars(int dev, const char *chars);
+extern int FS_putString(int dev, const struct String *s);
+extern int FS_putItem(int dev, const struct String *s);
+extern int FS_putbinaryString(int chn, const struct String *s);
+extern int FS_putbinaryInteger(int chn, long int x);
+extern int FS_putbinaryReal(int chn, double x);
+extern int FS_getbinaryString(int chn, struct String *s);
+extern int FS_getbinaryInteger(int chn, long int *x);
+extern int FS_getbinaryReal(int chn, double *x);
+extern int FS_nextcol(int dev);
+extern int FS_nextline(int dev);
+extern int FS_tab(int dev, int position);
+extern int FS_cls(int chn);
+extern int FS_locate(int chn, int line, int column);
+extern int FS_colour(int chn, int foreground, int background);
+extern int FS_get(int chn);
+extern int FS_getChar(int dev);
+extern int FS_eof(int chn);
+extern long int FS_loc(int chn);
+extern long int FS_lof(int chn);
+extern int FS_width(int dev, int width);
+extern int FS_zone(int dev, int zone);
+extern long int FS_recLength(int chn);
+extern void FS_field(int chn, struct String *s, long int position, long int length);
+extern int FS_appendToString(int dev, struct String *s, int onl);
+extern int FS_inkeyChar(int dev, int ms);
+extern void FS_sleep(double s);
+extern int FS_seek(int chn, long int record);
+extern void FS_closefiles(void);
+extern int FS_charpos(int chn);
+extern int FS_copy(const char *from, const char *to);
+extern int FS_portInput(int address);
+extern int FS_memInput(int address);
+extern int FS_portOutput(int address, int value);
+extern int FS_memOutput(int address, int value);
+extern void FS_allowIntr(int on);
+
+#endif

interpreters/bas/getopt.h

@@ -0,0 +1,133 @@
+/* Declarations for getopt.
+   Copyright (C) 1989,90,91,92,93,94,96,97,98 Free Software Foundation, Inc.
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@gnu.org.
+
+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, 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, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.  */
+
+#ifndef _GETOPT_H
+#define _GETOPT_H 1
+
+#ifdef	__cplusplus
+extern "C" {
+#endif
+
+/* For communication from `getopt' to the caller.
+   When `getopt' finds an option that takes an argument,
+   the argument value is returned here.
+   Also, when `ordering' is RETURN_IN_ORDER,
+   each non-option ARGV-element is returned here.  */
+
+extern char *optarg;
+
+/* Index in ARGV of the next element to be scanned.
+   This is used for communication to and from the caller
+   and for communication between successive calls to `getopt'.
+
+   On entry to `getopt', zero means this is the first call; initialize.
+
+   When `getopt' returns -1, this is the index of the first of the
+   non-option elements that the caller should itself scan.
+
+   Otherwise, `optind' communicates from one call to the next
+   how much of ARGV has been scanned so far.  */
+
+extern int optind;
+
+/* Callers store zero here to inhibit the error message `getopt' prints
+   for unrecognized options.  */
+
+extern int opterr;
+
+/* Set to an option character which was unrecognized.  */
+
+extern int optopt;
+
+/* Describe the long-named options requested by the application.
+   The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
+   of `struct option' terminated by an element containing a name which is
+   zero.
+
+   The field `has_arg' is:
+   no_argument		(or 0) if the option does not take an argument,
+   required_argument	(or 1) if the option requires an argument,
+   optional_argument 	(or 2) if the option takes an optional argument.
+
+   If the field `flag' is not NULL, it points to a variable that is set
+   to the value given in the field `val' when the option is found, but
+   left unchanged if the option is not found.
+
+   To have a long-named option do something other than set an `int' to
+   a compiled-in constant, such as set a value from `optarg', set the
+   option's `flag' field to zero and its `val' field to a nonzero
+   value (the equivalent single-letter option character, if there is
+   one).  For long options that have a zero `flag' field, `getopt'
+   returns the contents of the `val' field.  */
+
+struct option
+{
+#if defined (__STDC__) && __STDC__
+  const char *name;
+#else
+  char *name;
+#endif
+  /* has_arg can't be an enum because some compilers complain about
+     type mismatches in all the code that assumes it is an int.  */
+  int has_arg;
+  int *flag;
+  int val;
+};
+
+/* Names for the values of the `has_arg' field of `struct option'.  */
+
+#define	no_argument		0
+#define required_argument	1
+#define optional_argument	2
+
+#if defined (__STDC__) && __STDC__
+#ifdef __GNU_LIBRARY__
+/* Many other libraries have conflicting prototypes for getopt, with
+   differences in the consts, in stdlib.h.  To avoid compilation
+   errors, only prototype getopt for the GNU C library.  */
+extern int getopt (int argc, char *const *argv, const char *shortopts);
+#else /* not __GNU_LIBRARY__ */
+/* extern int getopt (); */
+#endif /* __GNU_LIBRARY__ */
+extern int getopt_long (int argc, char *const *argv, const char *shortopts,
+		        const struct option *longopts, int *longind);
+extern int getopt_long_only (int argc, char *const *argv,
+			     const char *shortopts,
+		             const struct option *longopts, int *longind);
+
+/* Internal only.  Users should not call this directly.  */
+extern int _getopt_internal (int argc, char *const *argv,
+			     const char *shortopts,
+		             const struct option *longopts, int *longind,
+			     int long_only);
+#else /* not __STDC__ */
+extern int getopt ();
+extern int getopt_long ();
+extern int getopt_long_only ();
+
+extern int _getopt_internal ();
+#endif /* __STDC__ */
+
+#ifdef	__cplusplus
+}
+#endif
+
+#endif /* _GETOPT_H */

interpreters/bas/getopt1.c

@@ -0,0 +1,189 @@
+/* getopt_long and getopt_long_only entry points for GNU getopt.
+   Copyright (C) 1987,88,89,90,91,92,93,94,96,97 Free Software Foundation, Inc.
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@gnu.org.
+
+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, 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, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.  */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include "getopt.h"
+
+#if !defined (__STDC__) || !__STDC__
+/* This is a separate conditional since some stdc systems
+   reject `defined (const)'.  */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+   actually compiling the library itself.  This code is part of the GNU C
+   Library, but also included in many other GNU distributions.  Compiling
+   and linking in this code is a waste when using the GNU C library
+   (especially if it is a shared library).  Rather than having every GNU
+   program understand `configure --with-gnu-libc' and omit the object files,
+   it is simpler to just do this in the source for each such file.  */
+
+#define GETOPT_INTERFACE_VERSION 2
+#if !defined (_LIBC) && defined (__GLIBC__) && __GLIBC__ >= 2
+#include <gnu-versions.h>
+#if _GNU_GETOPT_INTERFACE_VERSION == GETOPT_INTERFACE_VERSION
+#define ELIDE_CODE
+#endif
+#endif
+
+#ifndef ELIDE_CODE
+
+
+/* This needs to come after some library #include
+   to get __GNU_LIBRARY__ defined.  */
+#ifdef __GNU_LIBRARY__
+#include <stdlib.h>
+#endif
+
+#ifndef	NULL
+#define NULL 0
+#endif
+
+int
+getopt_long (argc, argv, options, long_options, opt_index)
+     int argc;
+     char *const *argv;
+     const char *options;
+     const struct option *long_options;
+     int *opt_index;
+{
+  return _getopt_internal (argc, argv, options, long_options, opt_index, 0);
+}
+
+/* Like getopt_long, but '-' as well as '--' can indicate a long option.
+   If an option that starts with '-' (not '--') doesn't match a long option,
+   but does match a short option, it is parsed as a short option
+   instead.  */
+
+int
+getopt_long_only (argc, argv, options, long_options, opt_index)
+     int argc;
+     char *const *argv;
+     const char *options;
+     const struct option *long_options;
+     int *opt_index;
+{
+  return _getopt_internal (argc, argv, options, long_options, opt_index, 1);
+}
+
+
+#endif	/* Not ELIDE_CODE.  */
+
+#ifdef TEST
+
+#include <stdio.h>
+
+int
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  int c;
+  int digit_optind = 0;
+
+  while (1)
+    {
+      int this_option_optind = optind ? optind : 1;
+      int option_index = 0;
+      static struct option long_options[] =
+      {
+	{"add", 1, 0, 0},
+	{"append", 0, 0, 0},
+	{"delete", 1, 0, 0},
+	{"verbose", 0, 0, 0},
+	{"create", 0, 0, 0},
+	{"file", 1, 0, 0},
+	{0, 0, 0, 0}
+      };
+
+      c = getopt_long (argc, argv, "abc:d:0123456789",
+		       long_options, &option_index);
+      if (c == -1)
+	break;
+
+      switch (c)
+	{
+	case 0:
+	  printf ("option %s", long_options[option_index].name);
+	  if (optarg)
+	    printf (" with arg %s", optarg);
+	  printf ("\n");
+	  break;
+
+	case '0':
+	case '1':
+	case '2':
+	case '3':
+	case '4':
+	case '5':
+	case '6':
+	case '7':
+	case '8':
+	case '9':
+	  if (digit_optind != 0 && digit_optind != this_option_optind)
+	    printf ("digits occur in two different argv-elements.\n");
+	  digit_optind = this_option_optind;
+	  printf ("option %c\n", c);
+	  break;
+
+	case 'a':
+	  printf ("option a\n");
+	  break;
+
+	case 'b':
+	  printf ("option b\n");
+	  break;
+
+	case 'c':
+	  printf ("option c with value `%s'\n", optarg);
+	  break;
+
+	case 'd':
+	  printf ("option d with value `%s'\n", optarg);
+	  break;
+
+	case '?':
+	  break;
+
+	default:
+	  printf ("?? getopt returned character code 0%o ??\n", c);
+	}
+    }
+
+  if (optind < argc)
+    {
+      printf ("non-option ARGV-elements: ");
+      while (optind < argc)
+	printf ("%s ", argv[optind++]);
+      printf ("\n");
+    }
+
+  exit (0);
+}
+
+#endif /* TEST */

interpreters/bas/global.h

@@ -0,0 +1,32 @@
+#ifndef GLOBAL_H
+#define GLOBAL_H
+
+#include "token.h"
+#include "value.h"
+#include "var.h"
+
+#define GLOBAL_HASHSIZE 31
+
+struct GlobalFunctionChain
+{
+  struct Pc begin,end;
+  struct GlobalFunctionChain *next;
+};
+
+struct Global
+{
+  struct String command;
+  struct Symbol *table[GLOBAL_HASHSIZE];
+  struct GlobalFunctionChain *chain;
+};
+
+extern struct Global *Global_new(struct Global *this);
+extern void Global_destroy(struct Global *this);
+extern void Global_clear(struct Global *this);
+extern void Global_clearFunctions(struct Global *this);
+extern int Global_find(struct Global *this, struct Identifier *ident, int oparen);
+extern int Global_function(struct Global *this, struct Identifier *ident, enum ValueType type, struct Pc *deffn, struct Pc *begin, int argTypesLength, enum ValueType *argTypes);
+extern void Global_endfunction(struct Global *this, struct Identifier *ident, struct Pc *end);
+extern int Global_variable(struct Global *this, struct Identifier *ident, enum ValueType type, enum SymbolType symbolType, int redeclare);
+
+#endif

interpreters/bas/install-sh

@@ -0,0 +1,527 @@
+#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2011-11-20.07; # UTC
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# 'make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+
+nl='
+'
+IFS=" ""	$nl"
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit=${DOITPROG-}
+if test -z "$doit"; then
+  doit_exec=exec
+else
+  doit_exec=$doit
+fi
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
+
+posix_glob='?'
+initialize_posix_glob='
+  test "$posix_glob" != "?" || {
+    if (set -f) 2>/dev/null; then
+      posix_glob=
+    else
+      posix_glob=:
+    fi
+  }
+'
+
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
+rmcmd="$rmprog -f"
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+no_target_directory=
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+   or: $0 [OPTION]... SRCFILES... DIRECTORY
+   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+   or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+     --help     display this help and exit.
+     --version  display version info and exit.
+
+  -c            (ignored)
+  -C            install only if different (preserve the last data modification time)
+  -d            create directories instead of installing files.
+  -g GROUP      $chgrpprog installed files to GROUP.
+  -m MODE       $chmodprog installed files to MODE.
+  -o USER       $chownprog installed files to USER.
+  -s            $stripprog installed files.
+  -t DIRECTORY  install into DIRECTORY.
+  -T            report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+  RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+  case $1 in
+    -c) ;;
+
+    -C) copy_on_change=true;;
+
+    -d) dir_arg=true;;
+
+    -g) chgrpcmd="$chgrpprog $2"
+	shift;;
+
+    --help) echo "$usage"; exit $?;;
+
+    -m) mode=$2
+	case $mode in
+	  *' '* | *'	'* | *'
+'*	  | *'*'* | *'?'* | *'['*)
+	    echo "$0: invalid mode: $mode" >&2
+	    exit 1;;
+	esac
+	shift;;
+
+    -o) chowncmd="$chownprog $2"
+	shift;;
+
+    -s) stripcmd=$stripprog;;
+
+    -t) dst_arg=$2
+	# Protect names problematic for 'test' and other utilities.
+	case $dst_arg in
+	  -* | [=\(\)!]) dst_arg=./$dst_arg;;
+	esac
+	shift;;
+
+    -T) no_target_directory=true;;
+
+    --version) echo "$0 $scriptversion"; exit $?;;
+
+    --)	shift
+	break;;
+
+    -*)	echo "$0: invalid option: $1" >&2
+	exit 1;;
+
+    *)  break;;
+  esac
+  shift
+done
+
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+  # When -d is used, all remaining arguments are directories to create.
+  # When -t is used, the destination is already specified.
+  # Otherwise, the last argument is the destination.  Remove it from $@.
+  for arg
+  do
+    if test -n "$dst_arg"; then
+      # $@ is not empty: it contains at least $arg.
+      set fnord "$@" "$dst_arg"
+      shift # fnord
+    fi
+    shift # arg
+    dst_arg=$arg
+    # Protect names problematic for 'test' and other utilities.
+    case $dst_arg in
+      -* | [=\(\)!]) dst_arg=./$dst_arg;;
+    esac
+  done
+fi
+
+if test $# -eq 0; then
+  if test -z "$dir_arg"; then
+    echo "$0: no input file specified." >&2
+    exit 1
+  fi
+  # It's OK to call 'install-sh -d' without argument.
+  # This can happen when creating conditional directories.
+  exit 0
+fi
+
+if test -z "$dir_arg"; then
+  do_exit='(exit $ret); exit $ret'
+  trap "ret=129; $do_exit" 1
+  trap "ret=130; $do_exit" 2
+  trap "ret=141; $do_exit" 13
+  trap "ret=143; $do_exit" 15
+
+  # Set umask so as not to create temps with too-generous modes.
+  # However, 'strip' requires both read and write access to temps.
+  case $mode in
+    # Optimize common cases.
+    *644) cp_umask=133;;
+    *755) cp_umask=22;;
+
+    *[0-7])
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw='% 200'
+      fi
+      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+    *)
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw=,u+rw
+      fi
+      cp_umask=$mode$u_plus_rw;;
+  esac
+fi
+
+for src
+do
+  # Protect names problematic for 'test' and other utilities.
+  case $src in
+    -* | [=\(\)!]) src=./$src;;
+  esac
+
+  if test -n "$dir_arg"; then
+    dst=$src
+    dstdir=$dst
+    test -d "$dstdir"
+    dstdir_status=$?
+  else
+
+    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+    # might cause directories to be created, which would be especially bad
+    # if $src (and thus $dsttmp) contains '*'.
+    if test ! -f "$src" && test ! -d "$src"; then
+      echo "$0: $src does not exist." >&2
+      exit 1
+    fi
+
+    if test -z "$dst_arg"; then
+      echo "$0: no destination specified." >&2
+      exit 1
+    fi
+    dst=$dst_arg
+
+    # If destination is a directory, append the input filename; won't work
+    # if double slashes aren't ignored.
+    if test -d "$dst"; then
+      if test -n "$no_target_directory"; then
+	echo "$0: $dst_arg: Is a directory" >&2
+	exit 1
+      fi
+      dstdir=$dst
+      dst=$dstdir/`basename "$src"`
+      dstdir_status=0
+    else
+      # Prefer dirname, but fall back on a substitute if dirname fails.
+      dstdir=`
+	(dirname "$dst") 2>/dev/null ||
+	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	     X"$dst" : 'X\(//\)[^/]' \| \
+	     X"$dst" : 'X\(//\)$' \| \
+	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
+	echo X"$dst" |
+	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)[^/].*/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\).*/{
+		   s//\1/
+		   q
+		 }
+		 s/.*/./; q'
+      `
+
+      test -d "$dstdir"
+      dstdir_status=$?
+    fi
+  fi
+
+  obsolete_mkdir_used=false
+
+  if test $dstdir_status != 0; then
+    case $posix_mkdir in
+      '')
+	# Create intermediate dirs using mode 755 as modified by the umask.
+	# This is like FreeBSD 'install' as of 1997-10-28.
+	umask=`umask`
+	case $stripcmd.$umask in
+	  # Optimize common cases.
+	  *[2367][2367]) mkdir_umask=$umask;;
+	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+	  *[0-7])
+	    mkdir_umask=`expr $umask + 22 \
+	      - $umask % 100 % 40 + $umask % 20 \
+	      - $umask % 10 % 4 + $umask % 2
+	    `;;
+	  *) mkdir_umask=$umask,go-w;;
+	esac
+
+	# With -d, create the new directory with the user-specified mode.
+	# Otherwise, rely on $mkdir_umask.
+	if test -n "$dir_arg"; then
+	  mkdir_mode=-m$mode
+	else
+	  mkdir_mode=
+	fi
+
+	posix_mkdir=false
+	case $umask in
+	  *[123567][0-7][0-7])
+	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
+	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+	    ;;
+	  *)
+	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
+
+	    if (umask $mkdir_umask &&
+		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
+	    then
+	      if test -z "$dir_arg" || {
+		   # Check for POSIX incompatibilities with -m.
+		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+		   # other-writable bit of parent directory when it shouldn't.
+		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
+		   case $ls_ld_tmpdir in
+		     d????-?r-*) different_mode=700;;
+		     d????-?--*) different_mode=755;;
+		     *) false;;
+		   esac &&
+		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
+		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
+		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+		   }
+		 }
+	      then posix_mkdir=:
+	      fi
+	      rmdir "$tmpdir/d" "$tmpdir"
+	    else
+	      # Remove any dirs left behind by ancient mkdir implementations.
+	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
+	    fi
+	    trap '' 0;;
+	esac;;
+    esac
+
+    if
+      $posix_mkdir && (
+	umask $mkdir_umask &&
+	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+      )
+    then :
+    else
+
+      # The umask is ridiculous, or mkdir does not conform to POSIX,
+      # or it failed possibly due to a race condition.  Create the
+      # directory the slow way, step by step, checking for races as we go.
+
+      case $dstdir in
+	/*) prefix='/';;
+	[-=\(\)!]*) prefix='./';;
+	*)  prefix='';;
+      esac
+
+      eval "$initialize_posix_glob"
+
+      oIFS=$IFS
+      IFS=/
+      $posix_glob set -f
+      set fnord $dstdir
+      shift
+      $posix_glob set +f
+      IFS=$oIFS
+
+      prefixes=
+
+      for d
+      do
+	test X"$d" = X && continue
+
+	prefix=$prefix$d
+	if test -d "$prefix"; then
+	  prefixes=
+	else
+	  if $posix_mkdir; then
+	    (umask=$mkdir_umask &&
+	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+	    # Don't fail if two instances are running concurrently.
+	    test -d "$prefix" || exit 1
+	  else
+	    case $prefix in
+	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+	      *) qprefix=$prefix;;
+	    esac
+	    prefixes="$prefixes '$qprefix'"
+	  fi
+	fi
+	prefix=$prefix/
+      done
+
+      if test -n "$prefixes"; then
+	# Don't fail if two instances are running concurrently.
+	(umask $mkdir_umask &&
+	 eval "\$doit_exec \$mkdirprog $prefixes") ||
+	  test -d "$dstdir" || exit 1
+	obsolete_mkdir_used=true
+      fi
+    fi
+  fi
+
+  if test -n "$dir_arg"; then
+    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+  else
+
+    # Make a couple of temp file names in the proper directory.
+    dsttmp=$dstdir/_inst.$$_
+    rmtmp=$dstdir/_rm.$$_
+
+    # Trap to clean up those temp files at exit.
+    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+    # Copy the file name to the temp name.
+    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+    # and set any options; do chmod last to preserve setuid bits.
+    #
+    # If any of these fail, we abort the whole thing.  If we want to
+    # ignore errors from any of these, just make sure not to ignore
+    # errors from the above "$doit $cpprog $src $dsttmp" command.
+    #
+    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+    # If -C, don't bother to copy if it wouldn't change the file.
+    if $copy_on_change &&
+       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
+       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&
+
+       eval "$initialize_posix_glob" &&
+       $posix_glob set -f &&
+       set X $old && old=:$2:$4:$5:$6 &&
+       set X $new && new=:$2:$4:$5:$6 &&
+       $posix_glob set +f &&
+
+       test "$old" = "$new" &&
+       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+    then
+      rm -f "$dsttmp"
+    else
+      # Rename the file to the real destination.
+      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+      # The rename failed, perhaps because mv can't rename something else
+      # to itself, or perhaps because mv is so ancient that it does not
+      # support -f.
+      {
+	# Now remove or move aside any old file at destination location.
+	# We try this two ways since rm can't unlink itself on some
+	# systems and the destination file might be busy for other
+	# reasons.  In this case, the final cleanup might fail but the new
+	# file should still install successfully.
+	{
+	  test ! -f "$dst" ||
+	  $doit $rmcmd -f "$dst" 2>/dev/null ||
+	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+	  } ||
+	  { echo "$0: cannot unlink or rename $dst" >&2
+	    (exit 1); exit 1
+	  }
+	} &&
+
+	# Now rename the file to the real destination.
+	$doit $mvcmd "$dsttmp" "$dst"
+      }
+    fi || exit 1
+
+    trap '' 0
+  fi
+done
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:

interpreters/bas/main.c

@@ -0,0 +1,122 @@
+/* #includes */ /*{{{C}}}*//*{{{*/
+#undef  _POSIX_SOURCE
+#define _POSIX_SOURCE   1
+#undef  _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 2
+
+#include "config.h"
+
+#include <errno.h>
+#include <fcntl.h>
+#ifdef HAVE_GETTEXT
+#include <libintl.h>
+#define _(String) gettext(String)
+#else
+#define _(String) String
+#endif
+#include <locale.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+#ifdef USE_DMALLOC
+#include "dmalloc.h"
+#endif
+
+#include "getopt.h"
+#include "bas.h"
+/*}}}*/
+
+#ifdef CONFIG_BUILD_KERNEL
+int main(int argc, FAR char *argv[])
+#else
+int bas_main(int argc, char *argv[])
+#endif
+{
+  /* variables */ /*{{{*/
+  char *runFile=(char*)0;
+  int usage=0,o;
+  const char *lp="/dev/null";
+  int backslash_colon=0;
+  int uppercase=0;
+  int restricted=0;
+  int lpfd;
+  static struct option lopts[]=
+  {
+    { "lp", required_argument, 0, 'l' },
+    { "help", no_argument, 0, 'h' },
+    { "restricted", no_argument, 0, 'r' },
+    { "uppercase", no_argument, 0, 'u' },
+    { "backslash-colon", no_argument, 0, 'b' },
+    { "version", no_argument, 0, 'V' },
+#if defined(__STDC__) && __STDC__
+    { (const char*)0, 0, 0, '\0' }
+#else
+    { (char*)0, 0, 0, '\0' }
+#endif
+  };
+  /*}}}*/
+
+  setlocale(LC_MESSAGES,"");
+  setlocale(LC_CTYPE,"");
+#ifdef HAVE_GETTEXT
+  bindtextdomain("bas",LOCALEDIR);
+  textdomain("bas");
+#endif
+  /* parse arguments */ /*{{{*/
+  while ((o=getopt_long(argc,argv,"+bl:ruVh?",lopts,(int*)0))!=EOF) switch (o)
+  {
+    case 'b': backslash_colon=1; break;
+    case 'l': lp=optarg; break;
+    case 'u': uppercase=1; break;
+    case 'r': restricted=1; break;
+    case 'V': printf("bas %s\n", VERSION); exit(0); break;
+    case 'h': usage=2; break;
+    default: usage=1; break;
+  }
+  if (optind<argc) runFile=argv[optind++];
+  if (usage==1)
+  {
+    fputs(_("Usage: bas [-b] [-l file] [-r] [-u] [program [argument ...]]\n"),stderr);
+    fputs(_("       bas [--backslash-colon] [--lp file] [--restricted] [--uppercase] [program [argument ...]]\n"),stderr);
+    fputs(_("       bas -h|--help\n"),stderr);
+    fputs(_("       bas --version\n"),stderr);
+    fputs(  "\n",stderr);
+    fputs(_("Try `bas -h' or `bas --help' for more information.\n"),stderr);
+    exit(1);
+  }
+  if (usage==2)
+  {
+    fputs(_("Usage: bas [-b] [-l file] [-u] [program [argument ...]]\n"),stdout);
+    fputs(_("       bas [--backslash-colon] [--lp file] [--restricted] [--uppercase] [program [argument ...]]\n"),stdout);
+    fputs(_("       bas -h|--help\n"),stdout);
+    fputs(_("       bas --version\n"),stdout);
+    fputs("\n",stdout);
+    fputs(_("BASIC interpreter.\n"),stdout);
+    fputs("\n",stdout);
+    fputs(_("-b, --backslash-colon  convert backslashs to colons\n"),stdout);
+    fputs(_("-l, --lp               write LPRINT output to file\n"),stdout);
+    fputs(_("-r, --restricted       forbid SHELL\n"),stdout);
+    fputs(_("-u, --uppercase        output all tokens in uppercase\n"),stdout);
+    fputs(_("-h, --help             display this help and exit\n"),stdout);
+    fputs(_("    --version          output version information and exit\n"),stdout);
+    fputs("\n",stdout);
+    fputs(_("Report bugs to <michael@moria.de>.\n"),stdout);
+    exit(0);
+  }
+  if ((lpfd=open(lp,O_WRONLY|O_CREAT|O_TRUNC,0666))==-1)
+  {
+    fprintf(stderr,_("bas: Opening `%s' for line printer output failed (%s).\n"),lp,strerror(errno));
+    exit(2);
+  }
+  bas_argc=argc-optind;
+  bas_argv=&argv[optind];
+  bas_argv0=runFile;
+  /*}}}*/
+  bas_init(backslash_colon,restricted,uppercase,lpfd);
+  if (runFile) bas_runFile(runFile);
+  else bas_interpreter();
+  bas_exit();
+  return(0);
+}
+/*}}}*/

interpreters/bas/program.c

@@ -0,0 +1,777 @@
+/* Program storage. */
+/* #includes */ /*{{{C}}}*//*{{{*/
+#undef  _POSIX_SOURCE
+#define _POSIX_SOURCE   1
+#undef  _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 2
+
+#include "config.h"
+
+#include <assert.h>
+#include <errno.h>
+#ifdef HAVE_GETTEXT
+#include <libintl.h>
+#define _(String) gettext(String)
+#else
+#define _(String) String
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "auto.h"
+#include "error.h"
+#include "fs.h"
+#include "program.h"
+/*}}}*/
+
+struct Program *Program_new(struct Program *this) /*{{{*/
+{
+  this->trace=0;
+  this->size=0;
+  this->numbered=1;
+  this->capacity=0;
+  this->runnable=0;
+  this->unsaved=0;
+  this->code=(struct Token**)0;
+  this->scope=(struct Scope*)0;
+  String_new(&this->name);
+  return this;
+}
+/*}}}*/
+void Program_destroy(struct Program *this) /*{{{*/
+{
+  while (this->size) Token_destroy(this->code[--this->size]);
+  if (this->capacity) free(this->code);
+  this->code=(struct Token**)0;
+  this->scope=(struct Scope*)0;
+  String_destroy(&this->name);
+}
+/*}}}*/
+void Program_norun(struct Program *this) /*{{{*/
+{
+  this->runnable=0;
+  this->scope=(struct Scope*)0;
+}
+/*}}}*/
+void Program_store(struct Program *this, struct Token *line, long int where) /*{{{*/
+{
+  int i;
+
+  assert(line->type==T_INTEGER || line->type==T_UNNUMBERED);
+  this->runnable=0;
+  this->unsaved=1;
+  if (line->type==T_UNNUMBERED) this->numbered=0;
+  if (where)
+  {
+    int last=-1;
+
+    for (i=0; i<this->size; ++i)
+    {
+      assert(this->code[i]->type==T_INTEGER || this->code[i]->type==T_UNNUMBERED);
+      if (where>last && where<this->code[i]->u.integer)
+      {
+        if ((this->size+1)>=this->capacity)
+        {
+          this->code=realloc(this->code,sizeof(struct Token*)*(this->capacity?(this->capacity*=2):(this->capacity=256)));
+        }
+        memmove(&this->code[i+1],&this->code[i],(this->size-i)*sizeof(struct Token*));
+        this->code[i]=line;
+        ++this->size;
+        return;
+      }
+      else if (where==this->code[i]->u.integer)
+      {
+        Token_destroy(this->code[i]);
+        this->code[i]=line;
+        return;
+      }
+      last=this->code[i]->u.integer;
+    }
+  }
+  else i=this->size;
+  if ((this->size+1)>=this->capacity)
+  {
+    this->code=realloc(this->code,sizeof(struct Token*)*(this->capacity?(this->capacity*=2):(this->capacity=256)));
+  }
+  this->code[i]=line;
+  ++this->size;
+}
+/*}}}*/
+void Program_delete(struct Program *this, const struct Pc *from, const struct Pc *to) /*{{{*/
+{
+  int i, first, last;
+
+  this->runnable=0;
+  this->unsaved=1;
+  first=from ? from->line : 0;
+  last=to ? to->line : this->size-1;
+  for (i=first; i<=last; ++i) Token_destroy(this->code[i]);
+  if ((last+1)!=this->size) memmove(&this->code[first],&this->code[last+1],(this->size-last+1)*sizeof(struct Token*));
+  this->size-=(last-first+1);
+}
+/*}}}*/
+void Program_addScope(struct Program *this, struct Scope *scope) /*{{{*/
+{
+  struct Scope *s;
+
+  s=this->scope;
+  this->scope=scope;
+  scope->next=s;
+}
+/*}}}*/
+struct Pc *Program_goLine(struct Program *this, long int line, struct Pc *pc) /*{{{*/
+{
+  int i;
+
+  for (i=0; i<this->size; ++i)
+  {
+    if (this->code[i]->type==T_INTEGER && line==this->code[i]->u.integer)
+    {
+      pc->line=i;
+      pc->token=this->code[i]+1;
+      return pc;
+    }
+  }
+  return (struct Pc*)0;
+}
+/*}}}*/
+struct Pc *Program_fromLine(struct Program *this, long int line, struct Pc *pc) /*{{{*/
+{
+  int i;
+
+  for (i=0; i<this->size; ++i)
+  {
+    if (this->code[i]->type==T_INTEGER && this->code[i]->u.integer>=line)
+    {
+      pc->line=i;
+      pc->token=this->code[i]+1;
+      return pc;
+    }
+  }
+  return (struct Pc*)0;
+}
+/*}}}*/
+struct Pc *Program_toLine(struct Program *this, long int line, struct Pc *pc) /*{{{*/
+{
+  int i;
+
+  for (i=this->size-1; i>=0; --i)
+  {
+    if (this->code[i]->type==T_INTEGER && this->code[i]->u.integer<=line)
+    {
+      pc->line=i;
+      pc->token=this->code[i]+1;
+      return pc;
+    }
+  }
+  return (struct Pc*)0;
+}
+/*}}}*/
+int Program_scopeCheck(struct Program *this, struct Pc *pc, struct Pc *fn) /*{{{*/
+{
+  struct Scope *scope;
+
+  if (fn==(struct Pc*)0) /* jump from global block must go to global pc */
+  {
+    for (scope=this->scope; scope; scope=scope->next)
+    {
+      if (pc->line<scope->begin.line) continue;
+      if (pc->line==scope->begin.line && pc->token<=scope->begin.token) continue;
+      if (pc->line>scope->end.line) continue;
+      if (pc->line==scope->end.line && pc->token>scope->end.token) continue;
+      return -1;
+    }
+  }
+  else /* jump from local block must go to local block */
+  {
+    scope=&(fn->token+1)->u.identifier->sym->u.sub.u.def.scope;
+    if (pc->line<scope->begin.line) return -1;
+    if (pc->line==scope->begin.line && pc->token<=scope->begin.token) return -1;
+    if (pc->line>scope->end.line) return -1;
+    if (pc->line==scope->end.line && pc->token>scope->end.token) return -1;
+  }
+  return 0;
+}
+/*}}}*/
+struct Pc *Program_dataLine(struct Program *this, long int line, struct Pc *pc) /*{{{*/
+{
+  if ((pc=Program_goLine(this,line,pc))==(struct Pc*)0) return (struct Pc*)0;
+  while (pc->token->type!=T_DATA)
+  {
+    if (pc->token->type==T_EOL) return (struct Pc*)0;
+    else ++pc->token;
+  }
+  return pc;
+}
+/*}}}*/
+struct Pc *Program_imageLine(struct Program *this, long int line, struct Pc *pc) /*{{{*/
+{
+  if ((pc=Program_goLine(this,line,pc))==(struct Pc*)0) return (struct Pc*)0;
+  while (pc->token->type!=T_IMAGE)
+  {
+    if (pc->token->type==T_EOL) return (struct Pc*)0;
+    else ++pc->token;
+  }
+  ++pc->token;
+  if (pc->token->type!=T_STRING) return (struct Pc*)0;
+  return pc;
+}
+/*}}}*/
+long int Program_lineNumber(const struct Program *this, const struct Pc *pc) /*{{{*/
+{
+  if (pc->line==-1) return 0;
+  if (this->numbered) return (this->code[pc->line]->u.integer);
+  else return (pc->line+1);
+}
+/*}}}*/
+struct Pc *Program_beginning(struct Program *this, struct Pc *pc) /*{{{*/
+{
+  if (this->size==0) return (struct Pc*)0;
+  else
+  {
+    pc->line=0;
+    pc->token=this->code[0]+1;
+    return pc;
+  }
+}
+/*}}}*/
+struct Pc *Program_end(struct Program *this, struct Pc *pc) /*{{{*/
+{
+  if (this->size==0) return (struct Pc*)0;
+  else
+  {
+    pc->line=this->size-1;
+    pc->token=this->code[this->size-1];
+    while (pc->token->type!=T_EOL) ++pc->token;
+    return pc;
+  }
+}
+/*}}}*/
+struct Pc *Program_nextLine(struct Program *this, struct Pc *pc) /*{{{*/
+{
+  if (pc->line+1==this->size) return (struct Pc*)0;
+  else
+  {
+    pc->token=this->code[++pc->line]+1;
+    return pc;
+  }
+}
+/*}}}*/
+int Program_skipEOL(struct Program *this, struct Pc *pc, int dev, int tr) /*{{{*/
+{
+  if (pc->token->type==T_EOL)
+  {
+    if (pc->line==-1 || pc->line+1==this->size) return 0;
+    {
+      pc->token=this->code[++pc->line]+1;
+      Program_trace(this,pc,dev,tr);
+      return 1;
+    }
+  }
+  else return 1;
+}
+/*}}}*/
+void Program_trace(struct Program *this, struct Pc *pc, int dev, int tr) /*{{{*/
+{
+  if (tr && this->trace && pc->line!=-1)
+  {
+    char buf[40];
+
+    sprintf(buf,"<%ld>\n",this->code[pc->line]->u.integer);
+    FS_putChars(dev,buf);
+  }
+}
+/*}}}*/
+void Program_PCtoError(struct Program *this, struct Pc *pc, struct Value *v) /*{{{*/
+{
+  struct String s;
+
+  String_new(&s);
+  if (pc->line>=0)
+  {
+    if (pc->line<(this->size-1) || pc->token->type!=T_EOL)
+    {
+      String_appendPrintf(&s,_(" in line %ld at:\n"),Program_lineNumber(this,pc));
+      Token_toString(this->code[pc->line],(struct Token*)0,&s,(int*)0,-1);
+      Token_toString(this->code[pc->line],pc->token,&s,(int*)0,-1);
+      String_appendPrintf(&s,"^\n");
+    }
+    else
+    {
+      String_appendPrintf(&s,_(" at: end of program\n"));
+    }
+  }
+  else
+  {
+    String_appendPrintf(&s,_(" at: "));
+    if (pc->token->type!=T_EOL) Token_toString(pc->token,(struct Token*)0,&s,(int*)0,-1);
+    else String_appendPrintf(&s,_("end of line\n"));
+  }
+  Value_errorSuffix(v,s.character);
+  String_destroy(&s);
+}
+/*}}}*/
+struct Value *Program_merge(struct Program *this, int dev, struct Value *value) /*{{{*/
+{
+  struct String s;
+  int l,err=0;
+
+  l=0;
+  while (String_new(&s),(err=FS_appendToString(dev,&s,1))!=-1 && s.length)
+  {
+    struct Token *line;
+
+    ++l;
+    if (l!=1 || s.character[0]!='#') 
+    {
+      line=Token_newCode(s.character);
+      if (line->type==T_INTEGER && line->u.integer>0) Program_store(this,line,this->numbered?line->u.integer:0);
+      else if (line->type==T_UNNUMBERED) Program_store(this,line,0);
+      else
+      {
+        Token_destroy(line);
+        return Value_new_ERROR(value,INVALIDLINE,l);
+      }
+    }
+    String_destroy(&s);
+  }
+  String_destroy(&s);
+  if (err) return Value_new_ERROR(value,IOERROR,FS_errmsg);
+  return (struct Value*)0;
+}
+/*}}}*/
+int Program_lineNumberWidth(struct Program *this) /*{{{*/
+{
+  int i,w=0;
+
+  for (i=0; i<this->size; ++i) if (this->code[i]->type==T_INTEGER)
+  {
+    int nw,ln;
+    for (ln=this->code[i]->u.integer,nw=1; ln/=10; ++nw);
+    if (nw>w) w=nw;
+  }
+  return w;
+}
+/*}}}*/
+struct Value *Program_list(struct Program *this, int dev, int watchIntr, struct Pc *from, struct Pc *to, struct Value *value) /*{{{*/
+{
+  int i,w;
+  int indent=0;
+  struct String s;
+
+  w=Program_lineNumberWidth(this);
+  for (i=0; i<this->size; ++i)
+  {
+    String_new(&s);
+    Token_toString(this->code[i],(struct Token*)0,&s,&indent,w);
+    if ((from==(struct Pc *)0 || from->line<=i) && (to==(struct Pc*)0 || to->line>=i))
+    {
+      if (FS_putString(dev,&s)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg);
+      if (watchIntr && FS_intr) return Value_new_ERROR(value,BREAK);
+    }
+    String_destroy(&s);
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+struct Value *Program_analyse(struct Program *this, struct Pc *pc, struct Value *value) /*{{{*/
+{
+  int i;
+
+  for (i=0; i<this->size; ++i)
+  {
+    pc->token=this->code[i];
+    pc->line=i;
+    if (pc->token->type==T_INTEGER || pc->token->type==T_UNNUMBERED) ++pc->token;
+    for (;;)
+    {
+      if (pc->token->type==T_GOTO || pc->token->type==T_RESUME || pc->token->type==T_RETURN || pc->token->type==T_END || pc->token->type==T_STOP)
+      {
+        ++pc->token;
+        while (pc->token->type==T_INTEGER)
+        {
+          ++pc->token;
+          if (pc->token->type==T_COMMA) ++pc->token;
+          else break;
+        }
+        if (pc->token->type==T_COLON)
+        {
+          ++pc->token;
+          switch (pc->token->type)
+          {
+            case T_EOL:
+            case T_DEFPROC:
+            case T_SUB:
+            case T_DEFFN:
+            case T_FUNCTION:
+            case T_COLON:
+            case T_REM:
+            case T_QUOTE: break; /* those are fine to be unreachable */
+            default: return Value_new_ERROR(value,UNREACHABLE);
+          }
+        }
+      }
+      if (pc->token->type==T_EOL) break;
+      else ++pc->token;
+    }
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+void Program_renum(struct Program *this, int first, int inc) /*{{{*/
+{
+  int i;
+  struct Token *token;
+
+  for (i=0; i<this->size; ++i)
+  {
+    for (token=this->code[i]; token->type!=T_EOL; )
+    {
+      if (token->type==T_GOTO || token->type==T_GOSUB || token->type==T_RESTORE || token->type==T_RESUME || token->type==T_USING)
+      {
+        ++token;
+        while (token->type==T_INTEGER)
+        {
+          struct Pc dst;
+
+          if (Program_goLine(this,token->u.integer,&dst)) token->u.integer=first+dst.line*inc;
+          ++token;
+          if (token->type==T_COMMA) ++token;
+          else break;
+        }
+      }
+      else ++token;
+    }
+  }
+  for (i=0; i<this->size; ++i)
+  {
+    assert(this->code[i]->type==T_INTEGER || this->code[i]->type==T_UNNUMBERED);
+    this->code[i]->type=T_INTEGER;
+    this->code[i]->u.integer=first+i*inc;
+  }
+  this->numbered=1;
+  this->runnable=0;
+  this->unsaved=1;
+}
+/*}}}*/
+void Program_unnum(struct Program *this) /*{{{*/
+{
+  char *ref;
+  int i;
+  struct Token *token;
+
+  ref=malloc(this->size);
+  memset(ref,0,this->size);
+  for (i=0; i<this->size; ++i)
+  {
+    for (token=this->code[i]; token->type!=T_EOL; ++token)
+    {
+      if (token->type==T_GOTO || token->type==T_GOSUB || token->type==T_RESTORE || token->type==T_RESUME)
+      {
+        ++token;
+        while (token->type==T_INTEGER)
+        {
+          struct Pc dst;
+
+          if (Program_goLine(this,token->u.integer,&dst)) ref[dst.line]=1;
+          ++token;
+          if (token->type==T_COMMA) ++token;
+          else break;
+        }
+      }
+    }
+  }
+  for (i=0; i<this->size; ++i)
+  {
+    assert(this->code[i]->type==T_INTEGER || this->code[i]->type==T_UNNUMBERED);
+    if (!ref[i])
+    {
+      this->code[i]->type=T_UNNUMBERED;
+      this->numbered=0;
+    }
+  }
+  free(ref);
+  this->runnable=0;
+  this->unsaved=1;
+}
+/*}}}*/
+int Program_setname(struct Program *this, const char *filename) /*{{{*/
+{
+  if (this->name.length) String_delete(&this->name,0,this->name.length);
+  if (filename) return String_appendChars(&this->name,filename);
+  else return 0;
+}
+/*}}}*/
+
+/*
+
+The list of line numbers is circular, which avoids the need to have one
+extra pointer for the head (for ordered output).  Instead only a pointer
+to the tail is needed.  The tail's next element is the head of the list.
+
+tail --> last element <-- ... <-- first element <--,
+              \                                   /
+               \_________________________________/
+
+*/
+
+struct Xref
+{
+  const void *key;
+  struct LineNumber
+  {
+    struct Pc line;
+    struct LineNumber *next;
+  } *lines;
+  struct Xref *l,*r;
+};
+
+static void Xref_add(struct Xref **root, int (*cmp)(const void*,const void*), const void *key, struct Pc *line) /*{{{*/
+{
+  int res;
+  struct LineNumber **tail;
+  struct LineNumber *new;
+
+  while (*root && (res=cmp(key,(*root)->key))) root=(res<0)?&(*root)->l:&(*root)->r;
+  if (*root==(struct Xref*)0)
+  {
+    *root=malloc(sizeof(struct Xref));
+    (*root)->key=key;
+    (*root)->l=(*root)->r=(struct Xref*)0;
+    /* create new circular list */
+    (*root)->lines=new=malloc(sizeof(struct LineNumber));
+    new->line=*line;
+    new->next=new;
+  }
+  else
+  {
+    /* add to existing circular list */
+    tail=&(*root)->lines;
+    if ((*tail)->line.line!=line->line)
+    {
+      new=malloc(sizeof(struct LineNumber));
+      new->line=*line;
+      new->next=(*tail)->next;
+      (*tail)->next=new;
+      *tail=new;
+    }
+  }
+}
+/*}}}*/
+static void Xref_destroy(struct Xref *root) /*{{{*/
+{
+  if (root)
+  {
+    struct LineNumber *cur,*next,*tail;
+
+    Xref_destroy(root->l);
+    Xref_destroy(root->r);
+    cur=tail=root->lines;
+    do
+    {
+      next=cur->next;
+      free(cur);
+      cur=next;
+    } while (cur!=tail);
+    free(root);
+  }
+}
+/*}}}*/
+static void Xref_print(struct Xref *root, void (*print)(const void *key, struct Program *p, int chn), struct Program *p, int chn) /*{{{*/
+{
+  if (root)
+  {
+    const struct LineNumber *cur,*tail;
+
+    Xref_print(root->l,print,p,chn);
+    print(root->key,p,chn);
+    cur=tail=root->lines;
+    do
+    {
+      char buf[128];
+
+      cur=cur->next;
+      if (FS_charpos(chn)>72) FS_putChars(chn,"\n        ");
+      sprintf(buf," %ld",Program_lineNumber(p,&cur->line));
+      FS_putChars(chn,buf);
+    } while (cur!=tail);
+    FS_putChar(chn,'\n');
+    Xref_print(root->r,print,p,chn);
+  }
+}
+/*}}}*/
+static int cmpLine(const void *a, const void *b) /*{{{*/
+{
+  const register struct Pc *pcA=(const struct Pc*)a,*pcB=(const struct Pc*)b;
+
+  return pcA->line-pcB->line;
+}
+/*}}}*/
+static void printLine(const void *k, struct Program *p, int chn) /*{{{*/
+{
+  char buf[80];
+
+  sprintf(buf,"%8ld",Program_lineNumber(p,(const struct Pc*)k));
+  FS_putChars(chn,buf);
+}
+/*}}}*/
+static int cmpName(const void *a, const void *b) /*{{{*/
+{
+  const register char *funcA=(const char*)a,*funcB=(const char*)b;
+
+  return strcmp(funcA,funcB);
+}
+/*}}}*/
+static void printName(const void *k, struct Program *p, int chn) /*{{{*/
+{
+  size_t len=strlen((const char*)k);
+
+  FS_putChars(chn,(const char*)k);
+  if (len<8) FS_putChars(chn,"        "+len);
+}
+/*}}}*/
+
+void Program_xref(struct Program *this, int chn) /*{{{*/
+{
+  struct Pc pc;
+  struct Xref *func,*var,*gosub,*goto_;
+  int nl=0;
+
+  assert(this->runnable);
+  func=(struct Xref*)0;
+  var=(struct Xref*)0;
+  gosub=(struct Xref*)0;
+  goto_=(struct Xref*)0;
+
+  for (pc.line=0; pc.line<this->size; ++pc.line)
+  {
+    struct On *on;
+
+    for (on=(struct On*)0,pc.token=this->code[pc.line]; pc.token->type!=T_EOL; ++pc.token)
+    {
+      switch (pc.token->type)
+      {
+        case T_ON: /*{{{*/
+        {
+          on=&pc.token->u.on;
+          break;
+        }
+        /*}}}*/
+        case T_GOTO: /*{{{*/
+        {
+          if (on)
+          {
+            int key;
+
+            for (key=0; key<on->pcLength; ++key) Xref_add(&goto_,cmpLine,&on->pc[key],&pc);
+            on=(struct On*)0;
+          }
+          else Xref_add(&goto_,cmpLine,&pc.token->u.gotopc,&pc);
+          break;
+        }
+        /*}}}*/
+        case T_GOSUB: /*{{{*/
+        {
+          if (on)
+          {
+            int key;
+
+            for (key=0; key<on->pcLength; ++key) Xref_add(&gosub,cmpLine,&on->pc[key],&pc);
+            on=(struct On*)0;
+          }
+          else Xref_add(&gosub,cmpLine,&pc.token->u.gosubpc,&pc);
+          break;
+        }
+        /*}}}*/
+        case T_DEFFN:
+        case T_DEFPROC:
+        case T_FUNCTION:
+        case T_SUB: /*{{{*/
+        {
+          ++pc.token;
+          Xref_add(&func,cmpName,&pc.token->u.identifier->name,&pc);
+          break;
+        }
+        /*}}}*/
+        default: break;
+      }
+    }
+  }
+
+  for (pc.line=0; pc.line<this->size; ++pc.line)
+  {
+    for (pc.token=this->code[pc.line]; pc.token->type!=T_EOL; ++pc.token)
+    {
+      switch (pc.token->type)
+      {
+        case T_DEFFN:
+        case T_DEFPROC:
+        case T_FUNCTION:
+        case T_SUB: /* skip identifier already added above */ /*{{{*/
+        {
+          ++pc.token;
+          break;
+        }
+        /*}}}*/
+        case T_IDENTIFIER: /*{{{*/
+        {
+          /* formal parameters have no assigned symbol */
+          if (pc.token->u.identifier->sym) switch (pc.token->u.identifier->sym->type)
+          {
+            case GLOBALVAR:
+            {
+              Xref_add(&var,cmpName,&pc.token->u.identifier->name,&pc);
+              break;
+            }
+            case USERFUNCTION:
+            {
+              Xref_add(&func,cmpName,&pc.token->u.identifier->name,&pc);
+              break;
+            }
+            default: break;
+          }
+          break;
+        }
+        /*}}}*/
+        default: break;
+      }
+    }
+  }
+
+  if (func)
+  {
+    FS_putChars(chn,_("Function Referenced in line\n"));
+    Xref_print(func,printName,this,chn);
+    Xref_destroy(func);
+    nl=1;
+  }
+
+  if (var)
+  {
+    if (nl) FS_putChar(chn,'\n');
+    FS_putChars(chn,_("Variable Referenced in line\n"));
+    Xref_print(var,printName,this,chn);
+    Xref_destroy(func);
+    nl=1;
+  }
+
+  if (gosub)
+  {
+    if (nl) FS_putChar(chn,'\n');
+    FS_putChars(chn,_("Gosub    Referenced in line\n"));
+    Xref_print(gosub,printLine,this,chn);
+    Xref_destroy(gosub);
+    nl=1;
+  }
+
+  if (goto_)
+  {
+    if (nl) FS_putChar(chn,'\n');
+    FS_putChars(chn,_("Goto     Referenced in line\n"));
+    Xref_print(goto_,printLine,this,chn);
+    Xref_destroy(goto_);
+    nl=1;
+  }
+}
+/*}}}*/

interpreters/bas/program.h

@@ -0,0 +1,35 @@
+#ifndef PROGRAM_H
+#define PROGRAM_H
+
+#include "programtypes.h"
+#include "token.h"
+
+extern struct Program *Program_new(struct Program *this);
+extern void Program_destroy(struct Program *this);
+extern void Program_norun(struct Program *this);
+extern void Program_store(struct Program *this, struct Token *line, long int where);
+extern void Program_delete(struct Program *this, const struct Pc *from, const struct Pc *to);
+extern void Program_addScope(struct Program *this, struct Scope *scope);
+extern struct Pc *Program_goLine(struct Program *this, long int line, struct Pc *pc);
+extern struct Pc *Program_fromLine(struct Program *this, long int line, struct Pc *pc);
+extern struct Pc *Program_toLine(struct Program *this, long int line, struct Pc *pc);
+extern int Program_scopeCheck(struct Program *this, struct Pc *pc, struct Pc *fn);
+extern struct Pc *Program_dataLine(struct Program *this, long int line, struct Pc *pc);
+extern struct Pc *Program_imageLine(struct Program *this, long int line, struct Pc *pc);
+extern long int Program_lineNumber(const struct Program *this, const struct Pc *pc);
+extern struct Pc *Program_beginning(struct Program *this, struct Pc *pc);
+extern struct Pc *Program_end(struct Program *this, struct Pc *pc);
+extern struct Pc *Program_nextLine(struct Program *this, struct Pc *pc);
+extern int Program_skipEOL(struct Program *this, struct Pc *pc, int dev, int tr);
+extern void Program_trace(struct Program *this, struct Pc *pc, int dev, int tr);
+extern void Program_PCtoError(struct Program *this, struct Pc *pc, struct Value *v);
+extern struct Value *Program_merge(struct Program *this, int dev, struct Value *value);
+extern int Program_lineNumberWidth(struct Program *this);
+extern struct Value *Program_list(struct Program *this, int dev, int watchIntr, struct Pc *from, struct Pc *to, struct Value *value);
+extern struct Value *Program_analyse(struct Program *this, struct Pc *pc, struct Value *value);
+extern void Program_renum(struct Program *this, int first, int inc);
+extern void Program_unnum(struct Program *this);
+extern int Program_setname(struct Program *this, const char *filename);
+extern void Program_xref(struct Program *this, int chn);
+
+#endif

interpreters/bas/programtypes.h

@@ -0,0 +1,33 @@
+#ifndef PROGRAMTYPES_H
+#define PROGRAMTYPES_H
+
+#include "str.h"
+
+struct Pc
+{
+  int line;
+  struct Token *token;
+};
+
+struct Scope
+{
+  struct Pc start;
+  struct Pc begin;
+  struct Pc end;
+  struct Scope *next;
+};
+
+struct Program
+{
+  int trace;
+  int numbered;
+  int size;
+  int capacity;
+  int runnable;
+  int unsaved;
+  struct String name;
+  struct Token **code;
+  struct Scope *scope;
+};
+
+#endif

interpreters/bas/statement.h

@@ -0,0 +1,104 @@
+#ifndef STATEMENT_H
+#define STATEMENT_H
+
+extern struct Value *stmt_CALL(struct Value *value);
+extern struct Value *stmt_CASE(struct Value *value);
+extern struct Value *stmt_CHDIR_MKDIR(struct Value *value);
+extern struct Value *stmt_CLEAR(struct Value *value);
+extern struct Value *stmt_CLOSE(struct Value *value);
+extern struct Value *stmt_CLS(struct Value *value);
+extern struct Value *stmt_COLOR(struct Value *value);
+extern struct Value *stmt_DATA(struct Value *value);
+extern struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value);
+extern struct Value *stmt_DEC_INC(struct Value *value);
+extern struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value);
+extern struct Value *stmt_DELETE(struct Value *value);
+extern struct Value *stmt_DIM(struct Value *value);
+extern struct Value *stmt_DISPLAY(struct Value *value);
+extern struct Value *stmt_DO(struct Value *value);
+extern struct Value *stmt_DOcondition(struct Value *value);
+extern struct Value *stmt_EDIT(struct Value *value);
+extern struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value);
+extern struct Value *stmt_END(struct Value *value);
+extern struct Value *stmt_ENDIF(struct Value *value);
+extern struct Value *stmt_ENDFN(struct Value *value);
+extern struct Value *stmt_ENDPROC_SUBEND(struct Value *value);
+extern struct Value *stmt_ENDSELECT(struct Value *value);
+extern struct Value *stmt_ENVIRON(struct Value *value);
+extern struct Value *stmt_FNEXIT(struct Value *value);
+extern struct Value *stmt_COLON_EOL(struct Value *value);
+extern struct Value *stmt_QUOTE_REM(struct Value *value);
+extern struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value);
+extern struct Value *stmt_ERASE(struct Value *value);
+extern struct Value *stmt_EXITDO(struct Value *value);
+extern struct Value *stmt_EXITFOR(struct Value *value);
+extern struct Value *stmt_FIELD(struct Value *value);
+extern struct Value *stmt_FOR(struct Value *value);
+extern struct Value *stmt_GET_PUT(struct Value *value);
+extern struct Value *stmt_GOSUB(struct Value *value);
+extern struct Value *stmt_RESUME_GOTO(struct Value *value);
+extern struct Value *stmt_KILL(struct Value *value);
+extern struct Value *stmt_LET(struct Value *value);
+extern struct Value *stmt_LINEINPUT(struct Value *value);
+extern struct Value *stmt_LIST_LLIST(struct Value *value);
+extern struct Value *stmt_LOAD(struct Value *value);
+extern struct Value *stmt_LOCAL(struct Value *value);
+extern struct Value *stmt_LOCATE(struct Value *value);
+extern struct Value *stmt_LOCK_UNLOCK(struct Value *value);
+extern struct Value *stmt_LOOP(struct Value *value);
+extern struct Value *stmt_LOOPUNTIL(struct Value *value);
+extern struct Value *stmt_LSET_RSET(struct Value *value);
+extern struct Value *stmt_IDENTIFIER(struct Value *value);
+extern struct Value *stmt_IF_ELSEIFIF(struct Value *value);
+extern struct Value *stmt_IMAGE(struct Value *value);
+extern struct Value *stmt_INPUT(struct Value *value);
+extern struct Value *stmt_MAT(struct Value *value);
+extern struct Value *stmt_MATINPUT(struct Value *value);
+extern struct Value *stmt_MATPRINT(struct Value *value);
+extern struct Value *stmt_MATREAD(struct Value *value);
+extern struct Value *stmt_MATREDIM(struct Value *value);
+extern struct Value *stmt_MATWRITE(struct Value *value);
+extern struct Value *stmt_NAME(struct Value *value);
+extern struct Value *stmt_NEW(struct Value *value);
+extern struct Value *stmt_NEXT(struct Value *value);
+extern struct Value *stmt_ON(struct Value *value);
+extern struct Value *stmt_ONERROR(struct Value *value);
+extern struct Value *stmt_ONERRORGOTO0(struct Value *value);
+extern struct Value *stmt_ONERROROFF(struct Value *value);
+extern struct Value *stmt_OPEN(struct Value *value);
+extern struct Value *stmt_OPTIONBASE(struct Value *value);
+extern struct Value *stmt_OPTIONRUN(struct Value *value);
+extern struct Value *stmt_OPTIONSTOP(struct Value *value);
+extern struct Value *stmt_OUT_POKE(struct Value *value);
+extern struct Value *stmt_PRINT_LPRINT(struct Value *value);
+extern struct Value *stmt_RANDOMIZE(struct Value *value);
+extern struct Value *stmt_READ(struct Value *value);
+extern struct Value *stmt_COPY_RENAME(struct Value *value);
+extern struct Value *stmt_RENUM(struct Value *value);
+extern struct Value *stmt_REPEAT(struct Value *value);
+extern struct Value *stmt_RESTORE(struct Value *value);
+extern struct Value *stmt_RETURN(struct Value *value);
+extern struct Value *stmt_RUN(struct Value *value);
+extern struct Value *stmt_SAVE(struct Value *value);
+extern struct Value *stmt_SELECTCASE(struct Value *value);
+extern struct Value *stmt_SHELL(struct Value *value);
+extern struct Value *stmt_SLEEP(struct Value *value);
+extern struct Value *stmt_STOP(struct Value *value);
+extern struct Value *stmt_SUBEXIT(struct Value *value);
+extern struct Value *stmt_SWAP(struct Value *value);
+extern struct Value *stmt_SYSTEM(struct Value *value);
+
+extern struct Value *stmt_TROFF(struct Value *value);
+extern struct Value *stmt_TRON(struct Value *value);
+extern struct Value *stmt_TRUNCATE(struct Value *value);
+extern struct Value *stmt_UNNUM(struct Value *value);
+extern struct Value *stmt_UNTIL(struct Value *value);
+extern struct Value *stmt_WAIT(struct Value *value);
+extern struct Value *stmt_WHILE(struct Value *value);
+extern struct Value *stmt_WEND(struct Value *value);
+extern struct Value *stmt_WIDTH(struct Value *value);
+extern struct Value *stmt_WRITE(struct Value *value);
+extern struct Value *stmt_XREF(struct Value *value);
+extern struct Value *stmt_ZONE(struct Value *value);
+
+#endif

interpreters/bas/str.c

@@ -0,0 +1,261 @@
+/* Dyanamic strings. */
+/* #includes */ /*{{{C}}}*//*{{{*/
+#include "config.h"
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "str.h"
+
+#ifdef USE_DMALLOC
+#include "dmalloc.h"
+#endif
+/*}}}*/
+
+int cistrcmp(const char *s, const char *r) /*{{{*/
+{
+  assert(s!=(char*)0);
+  assert(r!=(char*)0);
+  while (*s && tolower(*s)==tolower(*r)) { ++s; ++r; };
+  return ((tolower(*s)-tolower(*r)));
+}
+/*}}}*/
+
+struct String *String_new(struct String *this) /*{{{*/
+{
+  assert(this!=(struct String*)0);
+  this->length=0;
+  this->character=(char*)0;
+  this->field=(struct StringField*)0;
+  return this;
+}
+/*}}}*/
+void String_destroy(struct String *this) /*{{{*/
+{
+  assert(this!=(struct String*)0);
+  if (this->field) String_leaveField(this);
+  if (this->length) free(this->character);
+}
+/*}}}*/
+int String_joinField(struct String *this, struct StringField *field, char *character, size_t length) /*{{{*/
+{
+  struct String **n;
+
+  assert(this!=(struct String*)0);
+  if (this->field) String_leaveField(this);
+  this->field=field;
+  if ((n=(struct String**)realloc(field->refStrings,sizeof(struct String*)*(field->refCount+1)))==(struct String**)0) return -1;
+  field->refStrings=n;
+  field->refStrings[field->refCount]=this;
+  ++field->refCount;
+  if (this->length) free(this->character);
+  this->character=character;
+  this->length=length;
+  return 0;
+}
+/*}}}*/
+void String_leaveField(struct String *this) /*{{{*/
+{
+  struct StringField *field;
+  int i;
+  struct String **ref;
+
+  assert(this!=(struct String*)0);
+  field=this->field;
+  assert(field!=(struct StringField*)0);
+  for (i=0,ref=field->refStrings; i<field->refCount; ++i,++ref)
+  {
+    if (*ref==this)
+    {
+      int further=--field->refCount-i;
+
+      if (further) memmove(ref,ref+1,further*sizeof(struct String**));
+      this->character=(char*)0;
+      this->length=0;
+      this->field=(struct StringField*)0;
+      return;
+    }
+  }
+  assert(0);
+}
+/*}}}*/
+struct String *String_clone(struct String *this, const struct String *original) /*{{{*/
+{
+  assert(this!=(struct String*)0);
+  String_new(this);
+  String_appendString(this,original);
+  return this;
+}
+/*}}}*/
+int String_size(struct String *this, size_t length) /*{{{*/
+{
+  char *n;
+
+  assert(this!=(struct String*)0);
+  if (this->field) String_leaveField(this);
+  if (length)
+  {
+    if (length>this->length)
+    {
+      if ((n=realloc(this->character,length+1))==(char*)0) return -1;
+      this->character=n;
+    }
+    this->character[length]='\0';
+  }
+  else
+  {
+    if (this->length) free(this->character);
+    this->character=(char*)0;
+  }
+  this->length=length;
+  return 0;
+}
+/*}}}*/
+int String_appendString(struct String *this, const struct String *app) /*{{{*/
+{
+  size_t oldlength=this->length;
+
+  if (this->field) String_leaveField(this);
+  if (app->length==0) return 0;
+  if (String_size(this,this->length+app->length)==-1) return -1;
+  memcpy(this->character+oldlength,app->character,app->length);
+  return 0;
+}
+/*}}}*/
+int String_appendChar(struct String *this, char ch) /*{{{*/
+{
+  size_t oldlength=this->length;
+
+  if (this->field) String_leaveField(this);
+  if (String_size(this,this->length+1)==-1) return -1;
+  this->character[oldlength]=ch;
+  return 0;
+}
+/*}}}*/
+int String_appendChars(struct String *this, const char *ch) /*{{{*/
+{
+  size_t oldlength=this->length;
+  size_t chlen=strlen(ch);
+
+  if (this->field) String_leaveField(this);
+  if (String_size(this,this->length+chlen)==-1) return -1;
+  memcpy(this->character+oldlength,ch,chlen);
+  return 0;
+}
+/*}}}*/
+int String_appendPrintf(struct String *this, const char *fmt, ...) /*{{{*/
+{
+  char buf[1024];
+  size_t l,j;
+  va_list ap;
+
+  if (this->field) String_leaveField(this);
+  va_start(ap, fmt);
+  l=vsprintf(buf,fmt,ap);
+  va_end(ap);
+  j=this->length;
+  if (String_size(this,j+l)==-1) return -1;
+  memcpy(this->character+j,buf,l);
+  return 0;
+}
+/*}}}*/
+int String_insertChar(struct String *this, size_t where, char ch) /*{{{*/
+{
+  size_t oldlength=this->length;
+
+  if (this->field) String_leaveField(this);
+  assert(where<oldlength);
+  if (String_size(this,this->length+1)==-1) return -1;
+  memmove(this->character+where+1,this->character+where,oldlength-where);
+  this->character[where]=ch;
+  return 0;
+}
+/*}}}*/
+int String_delete(struct String *this, size_t where, size_t len) /*{{{*/
+{
+  size_t oldlength=this->length;
+
+  if (this->field) String_leaveField(this);
+  assert(where<oldlength);
+  assert(len>0);
+  if ((where+len)<oldlength) memmove(this->character+where,this->character+where+len,oldlength-where-len);
+  this->character[this->length-=len]='\0';
+  return 0;
+}
+/*}}}*/
+void String_ucase(struct String *this) /*{{{*/
+{
+  size_t i;
+
+  for (i=0; i<this->length; ++i) this->character[i]=toupper(this->character[i]);
+}
+/*}}}*/
+void String_lcase(struct String *this) /*{{{*/
+{
+  size_t i;
+
+  for (i=0; i<this->length; ++i) this->character[i]=tolower(this->character[i]);
+}
+/*}}}*/
+int String_cmp(const struct String *this, const struct String *s) /*{{{*/
+{
+  size_t pos;
+  int res;
+  const char *thisch,*sch;
+
+  for (pos=0,thisch=this->character,sch=s->character; pos<this->length && pos<s->length; ++pos,++thisch,++sch)
+  {
+    if ((res=(*thisch-*sch))) return res;
+  }
+  return (this->length-s->length);
+}
+/*}}}*/
+void String_lset(struct String *this, const struct String *s) /*{{{*/
+{
+  size_t copy;
+
+  copy=(this->length<s->length ? this->length : s->length);
+  if (copy) memcpy(this->character,s->character,copy);
+  if (copy<this->length) memset(this->character+copy,' ',this->length-copy);
+}
+/*}}}*/
+void String_rset(struct String *this, const struct String *s) /*{{{*/
+{
+  size_t copy;
+
+  copy=(this->length<s->length ? this->length : s->length);
+  if (copy) memcpy(this->character+this->length-copy,s->character,copy);
+  if (copy<this->length) memset(this->character,' ',this->length-copy);
+}
+/*}}}*/
+void String_set(struct String *this, size_t pos, const struct String *s, size_t length) /*{{{*/
+{
+  if (this->length>=pos)
+  {
+    if (this->length<(pos+length)) length=this->length-pos;
+    if (length) memcpy(this->character+pos,s->character,length);
+  }
+}
+/*}}}*/
+
+struct StringField *StringField_new(struct StringField *this) /*{{{*/
+{
+  this->refStrings=(struct String**)0;
+  this->refCount=0;
+  return this;
+}
+/*}}}*/
+void StringField_destroy(struct StringField *this) /*{{{*/
+{
+  int i;
+
+  for (i=this->refCount; i>0; ) String_leaveField(this->refStrings[--i]);
+  this->refCount=-1;
+  free(this->refStrings);
+}
+/*}}}*/

interpreters/bas/str.h

@@ -0,0 +1,43 @@
+#ifndef STR_H
+#define STR_H
+
+#include <sys/types.h>
+
+struct String
+{
+  size_t length;
+  char *character;
+  struct StringField *field;
+};
+
+struct StringField
+{
+  struct String **refStrings;
+  int refCount;
+};
+
+extern int cistrcmp(const char *s, const char *r);
+
+extern struct String *String_new(struct String *this);
+extern void String_destroy(struct String *this);
+extern int String_joinField(struct String *this, struct StringField *field, char *character, size_t length);
+extern void String_leaveField(struct String *this);
+extern struct String *String_clone(struct String *this, const struct String *clon);
+extern int String_appendString(struct String *this, const struct String *app);
+extern int String_appendChar(struct String *this, char ch);
+extern int String_appendChars(struct String *this, const char *ch);
+extern int String_appendPrintf(struct String *this, const char *fmt, ...);
+extern int String_insertChar(struct String *this, size_t where, char ch);
+extern int String_delete(struct String *this, size_t where, size_t len);
+extern void String_ucase(struct String *this);
+extern void String_lcase(struct String *this);
+extern int String_size(struct String *this, size_t length);
+extern int String_cmp(const struct String *this, const struct String *s);
+extern void String_lset(struct String *this, const struct String *s);
+extern void String_rset(struct String *this, const struct String *s);
+extern void String_set(struct String *this, size_t pos, const struct String *s, size_t length);
+
+extern struct StringField *StringField_new(struct StringField *this);
+extern void StringField_destroy(struct StringField *this);
+
+#endif

interpreters/bas/test/runbas.in

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+@VALGRIND@ ./bas "$@"

interpreters/bas/test/test01

@@ -0,0 +1,35 @@
+#!/bin/sh
+
+echo -n $0: 'Scalar variable assignment... '
+
+cat >test.bas <<eof
+10 a=1
+20 print a
+30 a$="hello"
+40 print a$
+50 a=0.0002
+60 print a
+70 a=2.e-6
+80 print a
+90 a=.2e-6
+100 print a
+eof
+
+cat >test.ref <<eof
+ 1 
+hello
+ 0.0002 
+ 2e-06 
+ 2e-07 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test02

@@ -0,0 +1,30 @@
+#!/bin/sh
+
+echo -n $0: 'Array variable assignment... '
+
+cat >test.bas <<eof
+10 dim a(1)
+20 a(0)=10
+30 a(1)=11
+40 a=12
+50 print a(0)
+60 print a(1)
+70 print a
+eof
+
+cat >test.ref <<eof
+ 10 
+ 11 
+ 12 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test03

@@ -0,0 +1,56 @@
+#!/bin/sh
+
+echo -n $0: 'FOR loops... '
+
+cat >test.bas <<eof
+ 10 for i=0 to 10
+ 20   print i
+ 30   if i=5 then exit for
+ 40 next
+ 50 for i=0 to 0
+ 60   print i
+ 70 next I
+ 80 for i=1 to 0 step -1
+ 90   print i
+100 next
+110 for i=1 to 0
+120   print i
+130 next
+140 for i$="" to "aaaaaaaaaa" step "a"
+150   print i$
+160 next
+eof
+
+cat >test.ref <<eof
+ 0 
+ 1 
+ 2 
+ 3 
+ 4 
+ 5 
+ 0 
+ 1 
+ 0 
+
+a
+aa
+aaa
+aaaa
+aaaaa
+aaaaaa
+aaaaaaa
+aaaaaaaa
+aaaaaaaaa
+aaaaaaaaaa
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test04

@@ -0,0 +1,34 @@
+#!/bin/sh
+
+echo -n $0: 'REPEAT UNTIL loop... '
+
+cat >test.bas <<eof
+10 a=1
+20 repeat 
+30   print a
+40   a=a+1
+50 until a=10
+eof
+
+cat >test.ref <<eof
+ 1 
+ 2 
+ 3 
+ 4 
+ 5 
+ 6 
+ 7 
+ 8 
+ 9 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test05

@@ -0,0 +1,31 @@
+#!/bin/sh
+
+echo -n $0: 'GOSUB RETURN subroutines... '
+
+cat >test5.bas <<eof
+10 gosub 100
+20 gosub 100
+30 end
+100 gosub 200
+110 gosub 200
+120 return
+200 print "hello, world":return
+eof
+
+cat >test5.ref <<eof
+hello, world
+hello, world
+hello, world
+hello, world
+eof
+
+sh ./test/runbas test5.bas >test5.data
+
+if cmp test5.ref test5.data
+then
+  rm -f test5.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test06

@@ -0,0 +1,42 @@
+#!/bin/sh
+
+echo -n $0: 'Recursive function without arguments... '
+
+cat >test.bas <<eof
+10 def fnloop
+20   if n=0.0 then
+30     r=0.0
+40   else
+50     print n
+60     n=n-1.0
+70     r=fnloop()
+80   end if
+90 =r
+100 n=10
+110 print fnloop
+eof
+
+cat >test.ref <<eof
+ 10 
+ 9 
+ 8 
+ 7 
+ 6 
+ 5 
+ 4 
+ 3 
+ 2 
+ 1 
+ 0 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test07

@@ -0,0 +1,25 @@
+#!/bin/sh
+
+echo -n $0: 'Recursive function with arguments... '
+
+cat >test.bas <<eof
+10 def fna(x)
+20   if x=0 then r=1 else r=x*fna(x-1)
+30 =r
+40 print fna(7)
+eof
+
+cat >test.ref <<eof
+ 5040 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test08

@@ -0,0 +1,34 @@
+#!/bin/sh
+
+echo -n $0: 'DATA, READ and RESTORE... '
+
+cat >test.bas <<eof
+10 data "a",b
+20 data "c","d
+40 read j$
+50 print "j=";j$
+60 restore 20
+70 for i=1 to 3
+80 read j$,k$
+90 print "j=";j$;" k=";k$
+100 next
+eof
+
+cat >test.ref <<'eof'
+j=a
+j=c k=d
+Error: end of `data' in line 80 at:
+80 read j$,k$
+        ^
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test09

@@ -0,0 +1,31 @@
+#!/bin/sh
+
+echo -n $0: 'LOCAL variables... '
+
+cat >test.bas <<eof
+10 def fna(a)
+20   local b
+30   b=a+1
+40 =b
+60 b=3
+70 print b
+80 print fna(4)
+90 print b
+eof
+
+cat >test.ref <<eof
+ 3 
+ 5 
+ 3 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test10

@@ -0,0 +1,80 @@
+#!/bin/sh
+
+echo -n $0: 'PRINT USING... '
+
+cat >test.bas <<'eof'
+ 10 print using "!";"abcdef"
+ 20 print using "\ \";"abcdef"
+ 30 print using "###-";-1
+ 40 print using "###-";0
+ 50 print using "###-";1
+ 60 print using "###+";-1
+ 70 print using "###+";0
+ 80 print using "###+";1
+ 90 print using "#####,";1000
+100 print using "**#,##.##";1000.00
+110 print using "+##.##";1
+120 print using "+##.##";1.23400
+130 print using "+##.##";123.456
+140 print using "+##.";123.456
+150 print using "+##";123.456
+160 print using "abc def ###.## efg";1.3
+170 print using "###.##^^^^^";5
+180 print using "###.##^^^^";1000
+190 print using ".##^^^^";5.0
+200 print using "##^^^^";2.3e-9
+210 print using ".##^^^^";2.3e-9
+220 print using "#.#^^^^";2.3e-9
+230 print using ".####^^^^^";-011466
+240 print using "$*,***,***,***.**";3729825.24
+250 print using "$**********.**";3729825.24
+260 print using "$$###.##";456.78
+270 print using "a!b";"S"
+280 print using "a!b";"S","T"
+290 print using "a!b!c";"S"
+300 print using "a!b!c";"S","T"
+eof
+
+cat >test.ref <<'eof'
+a
+abc
+  1-
+  0 
+  1 
+  1-
+  0+
+  1+
+ 1,000
+*1,000.00
+ +1.00
+ +1.23
++123.46
++123.
++123
+abc def   1.30 efg
+500.00E-002
+100.00E+01
+.50E+01
+23E-10
+.23E-08
+2.3E-09
+-.1147E+005
+$***3,729,825.24
+$**3729825.24
+$456.78
+aSb
+aSbaTb
+aSb
+aSbTc
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test11

@@ -0,0 +1,30 @@
+#!/bin/sh
+
+echo -n $0: 'OPEN and LINE INPUT... '
+
+cat >test.bas <<'eof'
+10 open "i",1,"test.bas"
+20 while not eof(1)
+30 line input #1,a$
+40 print a$
+50 wend
+eof
+
+cat >test.ref <<eof
+10 open "i",1,"test.bas"
+20 while not eof(1)
+30 line input #1,a$
+40 print a$
+50 wend
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test12

@@ -0,0 +1,32 @@
+#!/bin/sh
+
+echo -n $0: 'Exception handling... '
+
+cat >test.bas <<'eof'
+10 on error print "global handler 1 caught error in line ";erl : resume 30
+20 print mid$("",-1)
+30 on error print "global handler 2 caught error in line ";erl : end
+40 def procx
+50   on error print "local handler caught error in line";erl : goto 70
+60   print 1/0
+70 end proc
+80 procx
+90 print 1 mod 0
+eof
+
+cat >test.ref <<eof
+global handler 1 caught error in line  20 
+local handler caught error in line 60 
+global handler 2 caught error in line  90 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test13

@@ -0,0 +1,26 @@
+#!/bin/sh
+
+echo -n $0: 'Unnumbered lines... '
+
+cat >test.bas <<'eof'
+print "a"
+goto 20
+print "b"
+20 print "c"
+eof
+
+cat >test.ref <<eof
+a
+c
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test14

@@ -0,0 +1,242 @@
+#!/bin/sh
+
+echo -n $0: 'SELECT CASE... '
+
+cat >test.bas <<'eof'
+ 10 for i=0 to 9
+ 20   for j=0 to 9
+ 30     print i,j
+ 40     select case i
+ 50       case 0
+ 60         print "i after case 0"
+ 70       case 1
+ 80         print "i after case 1"
+ 90         select case j
+100           case 0
+110             print "j after case 0"
+120         end select
+130       case 3 to 5,7
+140         print "i after case 3 to 5, 7"
+150       case is <9
+160         print "is after case is <9"
+170       case else
+180         print "i after case else"
+190     end select
+200   next
+210 next
+eof
+
+cat >test.ref <<eof
+ 0             0 
+i after case 0
+ 0             1 
+i after case 0
+ 0             2 
+i after case 0
+ 0             3 
+i after case 0
+ 0             4 
+i after case 0
+ 0             5 
+i after case 0
+ 0             6 
+i after case 0
+ 0             7 
+i after case 0
+ 0             8 
+i after case 0
+ 0             9 
+i after case 0
+ 1             0 
+i after case 1
+j after case 0
+ 1             1 
+i after case 1
+ 1             2 
+i after case 1
+ 1             3 
+i after case 1
+ 1             4 
+i after case 1
+ 1             5 
+i after case 1
+ 1             6 
+i after case 1
+ 1             7 
+i after case 1
+ 1             8 
+i after case 1
+ 1             9 
+i after case 1
+ 2             0 
+is after case is <9
+ 2             1 
+is after case is <9
+ 2             2 
+is after case is <9
+ 2             3 
+is after case is <9
+ 2             4 
+is after case is <9
+ 2             5 
+is after case is <9
+ 2             6 
+is after case is <9
+ 2             7 
+is after case is <9
+ 2             8 
+is after case is <9
+ 2             9 
+is after case is <9
+ 3             0 
+i after case 3 to 5, 7
+ 3             1 
+i after case 3 to 5, 7
+ 3             2 
+i after case 3 to 5, 7
+ 3             3 
+i after case 3 to 5, 7
+ 3             4 
+i after case 3 to 5, 7
+ 3             5 
+i after case 3 to 5, 7
+ 3             6 
+i after case 3 to 5, 7
+ 3             7 
+i after case 3 to 5, 7
+ 3             8 
+i after case 3 to 5, 7
+ 3             9 
+i after case 3 to 5, 7
+ 4             0 
+i after case 3 to 5, 7
+ 4             1 
+i after case 3 to 5, 7
+ 4             2 
+i after case 3 to 5, 7
+ 4             3 
+i after case 3 to 5, 7
+ 4             4 
+i after case 3 to 5, 7
+ 4             5 
+i after case 3 to 5, 7
+ 4             6 
+i after case 3 to 5, 7
+ 4             7 
+i after case 3 to 5, 7
+ 4             8 
+i after case 3 to 5, 7
+ 4             9 
+i after case 3 to 5, 7
+ 5             0 
+i after case 3 to 5, 7
+ 5             1 
+i after case 3 to 5, 7
+ 5             2 
+i after case 3 to 5, 7
+ 5             3 
+i after case 3 to 5, 7
+ 5             4 
+i after case 3 to 5, 7
+ 5             5 
+i after case 3 to 5, 7
+ 5             6 
+i after case 3 to 5, 7
+ 5             7 
+i after case 3 to 5, 7
+ 5             8 
+i after case 3 to 5, 7
+ 5             9 
+i after case 3 to 5, 7
+ 6             0 
+is after case is <9
+ 6             1 
+is after case is <9
+ 6             2 
+is after case is <9
+ 6             3 
+is after case is <9
+ 6             4 
+is after case is <9
+ 6             5 
+is after case is <9
+ 6             6 
+is after case is <9
+ 6             7 
+is after case is <9
+ 6             8 
+is after case is <9
+ 6             9 
+is after case is <9
+ 7             0 
+i after case 3 to 5, 7
+ 7             1 
+i after case 3 to 5, 7
+ 7             2 
+i after case 3 to 5, 7
+ 7             3 
+i after case 3 to 5, 7
+ 7             4 
+i after case 3 to 5, 7
+ 7             5 
+i after case 3 to 5, 7
+ 7             6 
+i after case 3 to 5, 7
+ 7             7 
+i after case 3 to 5, 7
+ 7             8 
+i after case 3 to 5, 7
+ 7             9 
+i after case 3 to 5, 7
+ 8             0 
+is after case is <9
+ 8             1 
+is after case is <9
+ 8             2 
+is after case is <9
+ 8             3 
+is after case is <9
+ 8             4 
+is after case is <9
+ 8             5 
+is after case is <9
+ 8             6 
+is after case is <9
+ 8             7 
+is after case is <9
+ 8             8 
+is after case is <9
+ 8             9 
+is after case is <9
+ 9             0 
+i after case else
+ 9             1 
+i after case else
+ 9             2 
+i after case else
+ 9             3 
+i after case else
+ 9             4 
+i after case else
+ 9             5 
+i after case else
+ 9             6 
+i after case else
+ 9             7 
+i after case else
+ 9             8 
+i after case else
+ 9             9 
+i after case else
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test15

@@ -0,0 +1,41 @@
+#!/bin/sh
+
+echo -n $0: 'FIELD, PUT and GET... '
+
+cat >test.bas <<'eof'
+a$="a"
+open "r",1,"test.dat",128
+print "before field a$=";a$
+field #1,10 as a$
+field #1,5 as b$,5 as c$
+lset b$="hi"
+rset c$="ya"
+print "a$=";a$
+put #1
+close #1
+print "after close a$=";a$
+open "r",2,"test.dat",128
+field #2,10 as b$
+get #2
+print "after get b$=";b$
+close #2
+kill "test.dat"
+eof
+
+cat >test.ref <<eof
+before field a$=a
+a$=hi      ya
+after close a$=
+after get b$=hi      ya
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test16

@@ -0,0 +1,33 @@
+#!/bin/sh
+
+echo -n $0: 'SWAP... '
+
+cat >test.bas <<'eof'
+a=1 : b=2
+print "a=";a;"b=";b
+swap a,b
+print "a=";a;"b=";b
+dim a$(1,1),b$(1,1)
+a$(1,0)="a" : b$(0,1)="b"
+print "a$(1,0)=";a$(1,0);"b$(0,1)=";b$(0,1)
+swap a$(1,0),b$(0,1)
+print "a$(1,0)=";a$(1,0);"b$(0,1)=";b$(0,1)
+eof
+
+cat >test.ref <<'eof'
+a= 1 b= 2 
+a= 2 b= 1 
+a$(1,0)=ab$(0,1)=b
+a$(1,0)=bb$(0,1)=a
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test17

@@ -0,0 +1,40 @@
+#!/bin/sh
+
+echo -n $0: 'DO, EXIT DO, LOOP... '
+
+cat >test.bas <<'eof'
+print "loop started"
+i=1
+do
+  print "i is";i
+  i=i+1
+  if i>10 then exit do
+loop
+print "loop ended"
+eof
+
+cat >test.ref <<'eof'
+loop started
+i is 1 
+i is 2 
+i is 3 
+i is 4 
+i is 5 
+i is 6 
+i is 7 
+i is 8 
+i is 9 
+i is 10 
+loop ended
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test18

@@ -0,0 +1,43 @@
+#!/bin/sh
+
+echo -n $0: 'DO WHILE, LOOP... '
+
+cat >test.bas <<'eof'
+print "loop started"
+x$=""
+do while len(x$)<3
+  print "x$ is ";x$
+  x$=x$+"a"
+  y$=""
+  do while len(y$)<2
+    print "y$ is ";y$
+    y$=y$+"b"
+  loop
+loop
+print "loop ended"
+eof
+
+cat >test.ref <<'eof'
+loop started
+x$ is 
+y$ is 
+y$ is b
+x$ is a
+y$ is 
+y$ is b
+x$ is aa
+y$ is 
+y$ is b
+loop ended
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test19

@@ -0,0 +1,45 @@
+#!/bin/sh
+
+echo -n $0: 'ELSEIF... '
+
+cat >test.bas <<'eof'
+for x=1 to 3
+  if x=1 then
+    print "1a"
+  else
+    if x=2 then
+      print "2a"
+    else
+      print "3a"
+    end if
+  end if
+next
+
+for x=1 to 3
+  if x=1 then
+    print "1b"
+  elseif x=2 then
+    print "2b"
+  elseif x=3 then print "3b"
+next
+eof
+
+cat >test.ref <<'eof'
+1a
+2a
+3a
+1b
+2b
+3b
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test20

@@ -0,0 +1,46 @@
+#!/bin/sh
+
+echo -n $0: 'Caller trace... '
+
+cat >test.bas <<'eof'
+ 10 gosub 20
+ 20 gosub 30
+ 30 procb
+ 40 def proca
+ 50   print "hi"
+ 60   stop
+ 70 end proc
+ 80 def procb
+ 90   proca
+100 end proc
+eof
+
+cat >test.ref <<'eof'
+hi
+Break in line 60 at:
+60 stop
+   ^
+Proc Called in line 90 at:
+90 proca
+        ^
+Proc Called in line 30 at:
+30 procb
+        ^
+Called in line 20 at:
+20 gosub 30
+           ^
+Called in line 10 at:
+10 gosub 20
+           ^
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test21

@@ -0,0 +1,43 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix assignment... '
+
+cat >test.bas <<'eof'
+dim a(3,4)
+for i=0 to 3
+  for j=0 to 4
+    a(i,j)=i*10+j
+    print a(i,j);
+  next
+  print
+next
+mat b=a
+for i=0 to 3
+  for j=0 to 4
+    print b(i,j);
+  next
+  print
+next
+eof
+
+cat >test.ref <<'eof'
+ 0  1  2  3  4 
+ 10  11  12  13  14 
+ 20  21  22  23  24 
+ 30  31  32  33  34 
+ 0  0  0  0  0 
+ 0  11  12  13  14 
+ 0  21  22  23  24 
+ 0  31  32  33  34 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test22

@@ -0,0 +1,40 @@
+#!/bin/sh
+
+echo -n $0: 'MAT PRINT... '
+
+cat >test.bas <<'eof'
+dim a(2,2)
+for i=0 to 2
+  for j=0 to 2
+    a(i,j)=i*10+j
+  next
+next
+for j=1 to 2
+  for i=1 to 2
+    print using " ##.##";a(i,j),
+  next
+  print
+next
+mat print using " ##.##";a,a
+eof
+
+cat >test.ref <<'eof'
+ 11.00 21.00
+ 12.00 22.00
+ 11.00 12.00
+ 21.00 22.00
+
+ 11.00 12.00
+ 21.00 22.00
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test23

@@ -0,0 +1,40 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix addition and subtraction... '
+
+cat >test.bas <<'eof'
+dim a(2,2)
+a(2,2)=2.5
+dim b%(2,2)
+b%(2,2)=3
+mat print a
+mat a=a-b%
+mat print a
+dim c$(2,2)
+c$(2,1)="hi"
+mat print c$
+mat c$=c$+c$
+mat print c$
+eof
+
+cat >test.ref <<'eof'
+ 0             0            
+ 0             2.5          
+ 0             0            
+ 0            -0.5          
+                            
+hi                          
+                            
+hihi                        
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test24

@@ -0,0 +1,36 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix multiplication... '
+
+cat >test.bas <<'eof'
+10 dim b(2,3),c(3,2)
+20 for i=1 to 2 : for j=1 to 3 : read b(i,j) : next : next
+30 for i=1 to 3 : for j=1 to 2 : read c(i,j) : next : next
+40 mat a=b*c
+50 mat print b,c,a
+60 data 1,2,3,3,2,1
+70 data 1,2,2,1,3,3
+eof
+
+cat >test.ref <<'eof'
+ 1             2             3            
+ 3             2             1            
+
+ 1             2            
+ 2             1            
+ 3             3            
+
+ 14            13           
+ 10            11           
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test25

@@ -0,0 +1,50 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix scalar multiplication... '
+
+cat >test.bas <<'eof'
+10 dim a(3,3)
+20 for i=1 to 3 : for j=1 to 3 : read a(i,j) : next : next
+30 mat print a
+40 mat a=(3)*a
+45 print
+50 mat print a
+60 data 1,2,3,4,5,6,7,8,9
+80 dim inch_array(5,1),cm_array(5,1)
+90 mat read inch_array
+100 data 1,12,36,100,39.37 
+110 mat print inch_array
+120 mat cm_array=(2.54)*inch_array
+130 mat print cm_array
+eof
+
+cat >test.ref <<'eof'
+ 1             2             3            
+ 4             5             6            
+ 7             8             9            
+
+ 3             6             9            
+ 12            15            18           
+ 21            24            27           
+ 1            
+ 12           
+ 36           
+ 100          
+ 39.37        
+ 2.54         
+ 30.48        
+ 91.44        
+ 254          
+ 99.9998      
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test26

@@ -0,0 +1,26 @@
+#!/bin/sh
+
+echo -n $0: 'MAT READ... '
+
+cat >test.bas <<'eof'
+dim a(3,3)
+data 5,5,5,8,8,8,3,3
+mat read a(2,3)
+mat print a
+eof
+
+cat >test.ref <<'eof'
+ 5             5             5            
+ 8             8             8            
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test27

@@ -0,0 +1,33 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix inversion... '
+
+cat >test.bas <<'eof'
+data 1,2,3,4
+mat read a(2,2)
+mat print a
+mat b=inv(a)
+mat print b
+mat c=a*b
+mat print c
+eof
+
+cat >test.ref <<'eof'
+ 1             2            
+ 3             4            
+-2             1            
+ 1.5          -0.5          
+ 1             0            
+ 0             1            
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test28

@@ -0,0 +1,26 @@
+#!/bin/sh
+
+echo -n $0: 'TDL BASIC FNRETURN/FNEND... '
+
+cat >test.bas <<'eof'
+def fnfac(n)
+  if n=1 then fnreturn 1
+fnend n*fnfac(n-1)
+
+print fnfac(10)
+eof
+
+cat >test.ref <<'eof'
+ 3628800 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test29

@@ -0,0 +1,32 @@
+#!/bin/sh
+
+echo -n $0: 'TDL INSTR... '
+
+cat >test.bas <<'eof'
+print instr("123456789","456");" = 4?"
+print INSTR("123456789","654");" = 0?"
+print INSTR("1234512345","34");" = 3?"
+print INSTR("1234512345","34",6);" = 8?"
+print INSTR("1234512345","34",6,2);" = 0?"
+print INSTR("1234512345","34",6,4);" = 8?"
+eof
+
+cat >test.ref <<'eof'
+ 4  = 4?
+ 0  = 0?
+ 3  = 3?
+ 8  = 8?
+ 0  = 0?
+ 8  = 8?
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test30

@@ -0,0 +1,22 @@
+#!/bin/sh
+
+echo -n $0: 'Type mismatch check... '
+
+cat >test.bas <<'eof'
+print 1+"a"
+eof
+
+cat >test.ref <<'eof'
+Error: Invalid binary operand at: end of program
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test31

@@ -0,0 +1,43 @@
+#!/bin/sh
+
+echo -n $0: 'PRINT default format... '
+
+cat >test.bas <<'eof'
+10 for i=-8 to 8
+20   x=1+1/3 : y=1 : j=i
+30   for j=i to -1 : x=x/10 : y=y/10 : next
+40   for j=i to 1 step -1 : x=x*10 : y=y*10 : next
+50   print x,y
+60 next
+eof
+
+cat >test.ref <<'eof'
+ 1.333333e-08                1e-08 
+ 1.333333e-07                1e-07 
+ 1.333333e-06                1e-06 
+ 1.333333e-05                1e-05 
+ 0.000133      0.0001 
+ 0.001333      0.001 
+ 0.013333      0.01 
+ 0.133333      0.1 
+ 1.333333      1 
+ 13.33333      10 
+ 133.3333      100 
+ 1333.333      1000 
+ 13333.33      10000 
+ 133333.3      100000 
+ 1333333       1000000 
+ 1.333333e+07                1e+07 
+ 1.333333e+08                1e+08 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test32

@@ -0,0 +1,28 @@
+#!/bin/sh
+
+echo -n $0: 'SUB routines... '
+
+cat >test.bas <<'eof'
+PUTS("abc")
+END
+
+SUB PUTS(s$)
+  FOR i=1 to LEN(s$) : print mid$(s$,i,1); : NEXT
+  PRINT
+END SUB
+eof
+
+cat >test.ref <<'eof'
+abc
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test33

@@ -0,0 +1,39 @@
+#!/bin/sh
+
+echo -n $0: 'OPEN FOR BINARY... '
+
+cat >test.bas <<'eof'
+open "test.out" for binary as 1
+put 1,1,"xy"
+put 1,3,"z!"
+put 1,10,1/3
+put 1,20,9999
+close 1
+open "test.out" for binary as 1
+s$="    "
+get 1,1,s$
+get 1,10,x
+get 1,20,n%
+close
+print s$
+print x
+print n%
+kill "test.out"
+eof
+
+cat >test.ref <<'eof'
+xyz!
+ 0.333333 
+ 9999 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test34

@@ -0,0 +1,43 @@
+#!/bin/sh
+
+echo -n $0: 'OPTION BASE... '
+
+cat >test.bas <<'eof'
+option base 3
+dim a(3,5)
+a(3,3)=1
+a(3,5)=2
+
+print a(3,3)
+print a(3,5)
+
+option base -2
+dim b(-1,2)
+b(-2,-2)=10
+b(-1,2)=20
+
+print a(3,3)
+print a(3,5)
+print b(-2,-2)
+print b(-1,2)
+eof
+
+cat >test.ref <<'eof'
+ 1 
+ 2 
+ 1 
+ 2 
+ 10 
+ 20 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test35

@@ -0,0 +1,32 @@
+#!/bin/sh
+
+echo -n $0: 'Real to integer conversion... '
+
+cat >test.bas <<'eof'
+a%=1.2
+print a%
+a%=1.7
+print a%
+a%=-0.2
+print a%
+a%=-0.7
+print a%
+eof
+
+cat >test.ref <<'eof'
+ 1 
+ 2 
+ 0 
+-1 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test36

@@ -0,0 +1,31 @@
+#!/bin/sh
+
+echo -n $0: 'OPEN file locking... '
+
+cat >test.bas <<'eof'
+on error goto 10
+print "opening file"
+open "test.out" for output lock write as #1
+print "open succeeded"
+if command$<>"enough" then shell "sh ./test/runbas test.bas enough"
+end
+10 print "open failed"
+eof
+
+cat >test.ref <<'eof'
+opening file
+open succeeded
+opening file
+open failed
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test37

@@ -0,0 +1,24 @@
+#!/bin/sh
+
+echo -n $0: 'LINE INPUT reaching EOF... '
+
+cat >test.bas <<'eof'
+10 open "i",1,"test.ref"
+20 while not eof(1)
+30 line input #1,a$
+40 if a$="abc" then print a$; else print "def"
+50 wend
+eof
+
+awk 'BEGIN{ printf("abc") }' </dev/null >test.ref
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test38

@@ -0,0 +1,57 @@
+#!/bin/sh
+
+echo -n $0: 'MAT REDIM... '
+
+cat >test.bas <<'eof'
+dim x(10)
+mat read x
+mat print x
+mat redim x(7)
+mat print x
+mat redim x(12)
+mat print x
+data 1,2,3,4,5,6,7,8,9,10
+eof
+
+cat >test.ref <<'eof'
+ 1            
+ 2            
+ 3            
+ 4            
+ 5            
+ 6            
+ 7            
+ 8            
+ 9            
+ 10           
+ 1            
+ 2            
+ 3            
+ 4            
+ 5            
+ 6            
+ 7            
+ 1            
+ 2            
+ 3            
+ 4            
+ 5            
+ 6            
+ 7            
+ 0            
+ 0            
+ 0            
+ 0            
+ 0            
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test39

@@ -0,0 +1,32 @@
+#!/bin/sh
+
+echo -n $0: 'Nested function and procedure calls... '
+
+cat >test.bas <<'eof'
+def proc_a(x)
+print fn_b(1,x)
+end proc
+
+def fn_b(a,b)
+= a+fn_c(b)
+
+def fn_c(b)
+= b+3
+
+proc_a(2)
+eof
+
+cat >test.ref <<'eof'
+ 6 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test40

@@ -0,0 +1,26 @@
+#!/bin/sh
+
+echo -n $0: 'IMAGE... '
+
+cat >test.bas <<'eof'
+   d=3.1
+   print using "#.#";d
+   print using 10;d
+10 image #.##
+eof
+
+cat >test.ref <<'eof'
+3.1
+3.10
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test41

@@ -0,0 +1,32 @@
+#!/bin/sh
+
+echo -n $0: 'EXIT FUNCTION... '
+
+cat >test.bas <<'eof'
+function f(c)
+print "f running"
+if (c) then f=42 : exit function
+f=43
+end function
+
+print f(0)
+print f(1)
+eof
+
+cat >test.ref <<'eof'
+f running
+ 43 
+f running
+ 42 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test42

@@ -0,0 +1,36 @@
+#!/bin/sh
+
+echo -n $0: 'Arithmetic... '
+
+cat >test.bas <<eof
+10 print 4.7\3
+20 print -2.3\1
+30 print int(-2.3)
+40 print int(2.3)
+50 print fix(-2.3)
+60 print fix(2.3)
+70 print fp(-2.3)
+80 print fp(2.3)
+eof
+
+cat >test.ref <<eof
+ 1 
+-2 
+-3 
+ 2 
+-2 
+ 2 
+-0.3 
+ 0.3 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test43

@@ -0,0 +1,41 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix multiplication size checks... '
+
+cat >test.bas <<eof
+DIM a(3,3),b(3,1),c(3,3)
+MAT READ a
+MAT READ b
+MAT c=a*b
+MAT PRINT c
+DATA 1,2,3,4,5,6,7,8,9
+DATA 5,3,2
+
+erase b
+DIM b(3)
+RESTORE
+MAT READ a
+MAT READ b
+MAT c=a*b
+MAT PRINT c
+eof
+
+cat >test.ref <<eof
+ 17           
+ 47           
+ 77           
+Error: Dimension mismatch in line 14 at:
+mat c=a*b
+       ^
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test44

@@ -0,0 +1,38 @@
+#!/bin/sh
+
+echo -n $0: 'DELETE... '
+
+cat >test.bas <<eof
+10 print 10
+20 print 20
+30 print 30
+40 print 40
+50 print 50
+60 print 60
+70 print 70
+eof
+
+cat >test.input <<eof
+load "test.bas"
+delete -20
+delete 60-
+delete 30-40
+delete 15
+list
+eof
+
+cat >test.ref <<eof
+Error: No such line at: 15
+50 print 50
+eof
+
+sh ./test/runbas <test.input >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test45

@@ -0,0 +1,31 @@
+#!/bin/sh
+
+echo -n $0: 'MID$ on left side... '
+
+cat >test.bas <<'eof'
+10 mid$(a$,6,4) = "ABCD"
+20 print a$
+30 a$="0123456789"
+40 mid$(a$,6,4) = "ABCD"
+50 print a$
+60 a$="0123456789"
+70 let mid$(a$,6,4) = "ABCD"
+80 print a$
+eof
+
+cat >test.ref <<'eof'
+
+01234ABCD9
+01234ABCD9
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test46

@@ -0,0 +1,22 @@
+#!/bin/sh
+
+echo -n $0: 'END used without program... '
+
+cat >test.bas <<'eof'
+for i=1 to 10:print i;:next i:end
+eof
+
+cat >test.ref <<'eof'
+ 1  2  3  4  5  6  7  8  9  10 
+eof
+
+sh ./test/runbas <test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test47

@@ -0,0 +1,36 @@
+#!/bin/sh
+
+echo -n $0: 'MAT WRITE... '
+
+cat >test.bas <<'eof'
+dim a(3,4)
+for i=0 to 3
+  for j=0 to 4
+    a(i,j)=i*10+j
+    print a(i,j);
+  next
+  print
+next
+mat write a
+eof
+
+cat >test.ref <<'eof'
+ 0  1  2  3  4 
+ 10  11  12  13  14 
+ 20  21  22  23  24 
+ 30  31  32  33  34 
+11,12,13,14
+21,22,23,24
+31,32,33,34
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test48

@@ -0,0 +1,30 @@
+#!/bin/sh
+
+echo -n $0: 'Multi assignment... '
+
+cat >test.bas <<'eof'
+a,b = 10
+print a,b
+dim c(10)
+a,c(a) = 2
+print a,c(2),c(10)
+a$,b$="test"
+print a$,b$
+eof
+
+cat >test.ref <<'eof'
+ 10            10 
+ 2             0             2 
+test          test
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test49

@@ -0,0 +1,54 @@
+#!/bin/sh
+
+echo -n $0: 'Matrix determinant... '
+
+cat >test.bas <<'eof'
+width 120
+dim a(7,7),b(7,7)
+mat read a
+mat print a;
+print
+data 58,71,67,36,35,19,60
+data 50,71,71,56,45,20,52
+data 64,40,84,50,51,43,69
+data 31,28,41,54,31,18,33
+data 45,23,46,38,50,43,50
+data 41,10,28,17,33,41,46
+data 66,72,71,38,40,27,69
+mat b=inv(a)
+mat print b
+print det
+eof
+
+cat >test.ref <<'eof'
+ 58  71  67  36  35  19  60 
+ 50  71  71  56  45  20  52 
+ 64  40  84  50  51  43  69 
+ 31  28  41  54  31  18  33 
+ 45  23  46  38  50  43  50 
+ 41  10  28  17  33  41  46 
+ 66  72  71  38  40  27  69 
+
+ 9.636025e+07                320206       -537449        2323650      -1.135486e+07                3.019632e+07         
+              -9.650941e+07               
+ 4480          15           -25            108          -528           1404         -4487         
+-39436        -131           220          -951           4647         -12358         39497        
+ 273240        908          -1524          6589         -32198         85625        -273663       
+-1846174      -6135          10297        -44519         217549       -578534        1849032      
+ 1.315035e+07                43699        -73346         317110       -1549606       4120912      -1.31707e+07 
+
+-9.636079e+07               -320208        537452       -2323663       1.135493e+07               -3.019649e+07         
+               9.650995e+07               
+ 1 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test50

@@ -0,0 +1,36 @@
+#!/bin/sh
+
+echo -n $0: 'Min and max function... '
+
+cat >test.bas <<'eof'
+print min(1,2)
+print min(2,1)
+print min(-0.3,0.3)
+print min(-0.3,4)
+print max(1,2)
+print max(2,1)
+print max(-0.3,0.3)
+print max(-0.3,4)
+eof
+
+cat >test.ref <<'eof'
+ 1 
+ 1 
+-0.3 
+-0.3 
+ 2 
+ 2 
+ 0.3 
+ 4 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test51

@@ -0,0 +1,23 @@
+#!/bin/sh
+
+echo -n $0: 'Print items... '
+
+cat >test.bas <<'eof'
+PRINT "Line 1";TAB(78);1.23456789
+eof
+
+cat >test.ref <<'eof'
+Line 1                                                                       
+ 1.234568 
+eof
+
+sh ./test/runbas test.bas >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/test/test52

@@ -0,0 +1,37 @@
+#!/bin/sh
+
+echo -n $0: 'MAT INPUT... '
+
+cat >test.bas <<'eof'
+dim a(2,2)
+mat input a
+mat print a
+mat input a
+mat print a
+eof
+
+cat >test.input <<'eof'
+1,2,3,4,5
+1
+3,4
+eof
+
+cat >test.ref <<'eof'
+? 
+ 1             2            
+ 3             4            
+? ? 
+ 1             0            
+ 3             4            
+eof
+
+sh ./test/runbas test.bas <test.input >test.data
+
+if cmp test.ref test.data
+then
+  rm -f test.*
+  echo passed
+else
+  echo failed
+  exit 1
+fi

interpreters/bas/token.h

@@ -0,0 +1,458 @@
+#ifndef TOKEN_H
+#define TOKEN_H
+
+#include "autotypes.h"
+#include "value.h"
+#include "var.h"
+
+enum SymbolType { GLOBALVAR, GLOBALARRAY, LOCALVAR, BUILTINFUNCTION, USERFUNCTION };
+
+struct Symbol
+{
+  char *name;
+  enum SymbolType type;
+  union
+  {
+    struct Var var; /* GLOBALVAR, GLOBALARRAY */
+    struct
+    {
+      int offset; /* LOCALVAR */
+      enum ValueType type;
+    } local;
+    struct
+    {
+      union
+      {
+        struct /* BUILTINFUNCTION */
+        {
+          struct Value *(* call)(struct Value *value, struct Auto *stack);
+          struct Symbol *next;
+        } bltin;
+        struct    /* USERFUNTION */
+        {
+          struct Scope scope;
+          int localLength;
+          enum ValueType *localTypes;
+        } def;
+      } u;
+      int argLength;
+      enum ValueType *argTypes;
+      enum ValueType retType;
+    } sub;
+  } u;
+  struct Symbol *next;
+};
+
+#include "program.h"
+#include "str.h"
+
+struct Identifier
+{
+  struct Symbol *sym;
+  enum ValueType defaultType;
+  char name[2/* ... */];
+};
+
+struct Next
+{
+  struct Pc fr;
+  struct Pc var;
+  struct Pc limit;
+  struct Pc body;
+};
+
+struct On
+{
+  int pcLength;
+  struct Pc *pc;
+};
+
+struct Selectcase
+{
+  struct Pc endselect;
+  enum ValueType type;
+  struct Pc nextcasevalue;
+};
+
+struct Casevalue
+{
+  struct Pc endselect;
+  struct Pc nextcasevalue;
+};
+
+enum TokenType
+{
+  T_NOTOKEN=0,
+  T_ACCESS_READ,
+  T_ACCESS_READ_WRITE,
+  T_ACCESS_WRITE,
+  T_AND,
+  T_AS,
+  T_CALL,
+  T_CASEELSE,
+  T_CASEVALUE,
+  T_CHANNEL,
+  T_CHDIR,
+  T_CLEAR,
+  T_CLOSE,
+  T_CLS,
+  T_COLON,
+  T_COLOR,
+  T_COMMA,
+  T_CON,
+  T_COPY,
+  T_CP,
+  T_DATA,
+  T_DATAINPUT,
+  T_DEC,
+  T_DEFDBL,
+  T_DEFFN,
+  T_DEFINT,
+  T_DEFPROC,
+  T_DEFSTR,
+  T_DELETE,
+  T_DIM,
+  T_DISPLAY,
+  T_DIV,
+  T_DO,
+  T_DOUNTIL,
+  T_DOWHILE,
+  T_EDIT,
+  T_ELSE,
+  T_ELSEIFELSE,
+  T_ELSEIFIF,
+  T_END,
+  T_ENDFN,
+  T_ENDIF,
+  T_ENDPROC,
+  T_ENDSELECT,
+  T_ENVIRON,
+  T_EOL,
+  T_EQ,
+  T_EQV,
+  T_ERASE,
+  T_EXITDO,
+  T_EXITFOR,
+  T_FIELD,
+  T_FNEND,
+  T_FNEXIT,
+  T_FNRETURN,
+  T_FOR,
+  T_FOR_INPUT,
+  T_FOR_OUTPUT,
+  T_FOR_APPEND,
+  T_FOR_RANDOM,
+  T_FOR_BINARY,
+  T_FUNCTION,
+  T_GE,
+  T_GET,
+  T_GOSUB,
+  T_GOTO,
+  T_GT,
+  T_HEXINTEGER,
+  T_OCTINTEGER,
+  T_IDENTIFIER,
+  T_IDIV,
+  T_IDN,
+  T_IF,
+  T_IMAGE,
+  T_IMP,
+  T_INC,
+  T_INPUT,
+  T_INTEGER,
+  T_INV,
+  T_IS,
+  T_JUNK,
+  T_KILL,
+  T_LE,
+  T_LET,
+  T_LINEINPUT,
+  T_LIST,
+  T_LLIST,
+  T_LOAD,
+  T_LOCAL,
+  T_LOCATE,
+  T_LOCK,
+  T_LOCK_READ,
+  T_LOCK_WRITE,
+  T_LOOP,
+  T_LOOPUNTIL,
+  T_LPRINT,
+  T_LSET,
+  T_LT,
+  T_MAT,
+  T_MATINPUT,
+  T_MATPRINT,
+  T_MATREAD,
+  T_MATREDIM,
+  T_MATWRITE,
+  T_MINUS,
+  T_MKDIR,
+  T_MOD,
+  T_MULT,
+  T_NAME,
+  T_NE,
+  T_NEW,
+  T_NEXT,
+  T_NOT,
+  T_ON,
+  T_ONERROR,
+  T_ONERRORGOTO0,
+  T_ONERROROFF,
+  T_OP,
+  T_OPEN,
+  T_OPTIONBASE,
+  T_OPTIONRUN,
+  T_OPTIONSTOP,
+  T_OR,
+  T_OUT,
+  T_PLUS,
+  T_POKE,
+  T_POW,
+  T_PRINT,
+  T_PUT,
+  T_QUOTE,
+  T_RANDOMIZE,
+  T_READ,
+  T_REAL,
+  T_REM,
+  T_RENAME,
+  T_RENUM,
+  T_REPEAT,
+  T_RESTORE,
+  T_RESUME,
+  T_RETURN,
+  T_RSET,
+  T_RUN,
+  T_SAVE,
+  T_SELECTCASE,
+  T_SEMICOLON,
+  T_SHARED,
+  T_SHELL,
+  T_SLEEP,
+  T_SPC,
+  T_STEP,
+  T_STOP,
+  T_STRING,
+  T_SUB,
+  T_SUBEND,
+  T_SUBEXIT,
+  T_SWAP,
+  T_SYSTEM,
+  T_TAB,
+  T_THEN,
+  T_TO,
+  T_TRN,
+  T_TROFF,
+  T_TRON,
+  T_TRUNCATE,
+  T_UNLOCK,
+  T_UNNUM,
+  T_UNNUMBERED,
+  T_UNTIL,
+  T_USING,
+  T_WAIT,
+  T_WEND,
+  T_WHILE,
+  T_WIDTH,
+  T_WRITE,
+  T_XOR,
+  T_XREF,
+  T_ZER,
+  T_ZONE,
+  T_LASTTOKEN=T_ZONE
+};
+
+struct Token
+{
+  enum TokenType type;
+  struct Value *(*statement)(struct Value *value);
+  union
+  {
+    /* T_ACCESS_READ        */
+    /* T_ACCESS_READ_WRITE  */
+    /* T_ACCESS_WRITE       */
+    /* T_AND                */
+    /* T_AS                 */
+    /* T_CALL               */
+    /* T_CASEELSE           */ struct Casevalue *casevalue;
+    /* T_CASEIS             */ /* struct Casevalue *casevalue; */
+    /* T_CASEVALUE          */ /* struct Casevalue *casevalue; */
+    /* T_CHANNEL            */
+    /* T_CHDIR              */
+    /* T_CLEAR              */
+    /* T_CLOSE              */
+    /* T_CLS                */
+    /* T_COLON              */
+    /* T_COLOR              */
+    /* T_COMMA              */
+    /* T_CON                */
+    /* T_COPY               */
+    /* T_CP                 */
+    /* T_DATA               */ struct Pc nextdata;
+    /* T_DATAINPUT          */ char *datainput;
+    /* T_DEFFN              */ struct Symbol *localSyms;
+    /* T_DEFDBL             */
+    /* T_DEFINT             */
+    /* T_DEFPROC            */ /* struct Symbol *localSyms; */
+    /* T_DELETE             */
+    /* T_DIM                */
+    /* T_DIV                */
+    /* T_DO                 */ struct Pc exitdo;
+    /* T_DOUNTIL            */ /* struct Pc exitdo; */
+    /* T_DOWHILE            */ /* struct Pc exitdo; */
+    /* T_EDIT               */
+    /* T_ELSE               */ struct Pc endifpc;
+    /* T_ELSEIFELSE         */ /* struct Pc endifpc; */
+    /* T_ELSEIFIF           */ struct Pc elsepc;
+    /* T_END                */ struct Pc endpc;
+    /* T_ENDFN              */
+    /* T_ENDIF              */
+    /* T_ENDPROC            */
+    /* T_ENDSELECT          */
+    /* T_ENVIRON            */
+    /* T_EOL                */
+    /* T_EQ                 */ enum ValueType type;
+    /* T_EQV                */
+    /* T_ERASE              */
+    /* T_EXITDO             */ /* struct Pc exitdo; */
+    /* T_EXITFOR            */ struct Pc exitfor;
+    /* T_FIELD              */
+    /* T_FNEND              */
+    /* T_FNRETURN           */
+    /* T_FOR                */ /* struct Pc exitfor */
+    /* T_FOR_INPUT          */
+    /* T_FOR_OUTPUT         */
+    /* T_FOR_APPEND         */
+    /* T_FOR_RANDOM         */
+    /* T_FOR_BINARY         */
+    /* T_FUNCTION           */ /* struct Symbol *localSyms; */
+    /* T_GE                 */
+    /* T_GET                */
+    /* T_GOSUB              */ struct Pc gosubpc;
+    /* T_GOTO               */ struct Pc gotopc;
+    /* T_GT                 */
+    /* T_HEXINTEGER         */ long int hexinteger;
+    /* T_OCTINTEGER         */ long int octinteger;
+    /* T_IDENTIFIER         */ struct Identifier *identifier;
+    /* T_IDIV               */
+    /* T_IDN                */
+    /* T_IF                 */ /* struct Pc elsepc; */
+    /* T_IMAGE              */ /* struct String *string; */
+    /* T_IMP                */
+    /* T_INPUT              */
+    /* T_INTEGER            */ long int integer;
+    /* T_INV                */
+    /* T_IS                 */
+    /* T_JUNK               */ char junk;
+    /* T_KILL               */
+    /* T_LE                 */
+    /* T_LEN                */
+    /* T_LET                */
+    /* T_LINEINPUT          */
+    /* T_LIST               */
+    /* T_LLIST              */
+    /* T_LOAD               */
+    /* T_LOCAL              */
+    /* T_LOCATE             */
+    /* T_LOCK               */
+    /* T_LOCK_READ          */
+    /* T_LOCK_WRITE         */
+    /* T_LOOP               */ struct Pc dopc;
+    /* T_LOOPUNTIL          */ /* struct Pc dopc; */
+    /* T_LPRINT             */
+    /* T_LSET               */
+    /* T_LT                 */
+    /* T_MAT                */
+    /* T_MATINPUT           */
+    /* T_MATPRINT           */
+    /* T_MATREAD            */
+    /* T_MATREDIM           */
+    /* T_MINUS              */
+    /* T_MKDIR              */
+    /* T_MOD                */
+    /* T_MULT               */
+    /* T_NAME               */
+    /* T_NE                 */
+    /* T_NEW                */
+    /* T_NEXT               */ struct Next *next;
+    /* T_NOT                */
+    /* T_ON                 */ struct On on;
+    /* T_ONERROR            */
+    /* T_ONERRORGOTO0       */
+    /* T_ONERROROFF         */
+    /* T_OP                 */
+    /* T_OPEN               */
+    /* T_OPTIONBASE         */
+    /* T_OR                 */
+    /* T_OUT                */
+    /* T_PLUS               */
+    /* T_POKE               */
+    /* T_POW                */
+    /* T_PRINT              */
+    /* T_PUT                */
+    /* T_QUOTE              */ /* char *rem; */
+    /* T_RANDOMIZE          */
+    /* T_READ               */
+    /* T_REAL               */ double real;
+    /* T_REM                */ char *rem;
+    /* T_RENAME             */
+    /* T_RENUM              */
+    /* T_REPEAT             */
+    /* T_RESTORE            */ struct Pc restore;
+    /* T_RESUME             */ /* struct Pc gotopc; */
+    /* T_RETURN             */
+    /* T_RSET               */
+    /* T_RUN                */
+    /* T_SAVE               */
+    /* T_SELECTCASE         */ struct Selectcase *selectcase;
+    /* T_SEMICOLON          */
+    /* T_SHARED             */
+    /* T_SHELL              */
+    /* T_SLEEP              */
+    /* T_SPC                */
+    /* T_STEP               */
+    /* T_STOP               */
+    /* T_STRING             */ struct String *string;
+    /* T_SUB                */ /* struct Symbol *localSyms; */
+    /* T_SUBEND             */
+    /* T_SUBEXIT            */
+    /* T_SWAP               */
+    /* T_SYSTEM             */
+    /* T_TAB                */
+    /* T_THEN               */
+    /* T_TO                 */
+    /* T_TRN                */
+    /* T_TROFF              */
+    /* T_TRON               */
+    /* T_TRUNCATE           */
+    /* T_UNLOCK             */
+    /* T_UNNUM              */
+    /* T_UNNUMBERED         */
+    /* T_UNTIL              */ struct Pc until;
+    /* T_USING              */ struct Pc image;
+    /* T_WAIT               */
+    /* T_WEND               */ struct Pc *whilepc;
+    /* T_WHILE              */ struct Pc *afterwend;
+    /* T_WIDTH              */
+    /* T_WRITE              */
+    /* T_XOR                */
+    /* T_XREF               */
+    /* T_ZER                */
+    /* T_ZONE               */
+  } u;
+};
+
+extern struct Token *Token_newCode(const char *ln);
+extern struct Token *Token_newData(const char *ln);
+extern void Token_destroy(struct Token *token);
+extern struct String *Token_toString(struct Token *token, struct Token *spaceto, struct String *s, int *indent, int full);
+extern int Token_property[];
+#define TOKEN_ISBINARYOPERATOR(t)   (Token_property[t]&1)
+#define TOKEN_ISUNARYOPERATOR(t)    (Token_property[t]&(1<<1))
+#define TOKEN_BINARYPRIORITY(t)     ((Token_property[t]>>2)&7)
+#define TOKEN_UNARYPRIORITY(t)      ((Token_property[t]>>5)&7)
+#define TOKEN_ISRIGHTASSOCIATIVE(t) (Token_property[t]&(1<<8))
+extern void Token_init(int backslash_colon, int uppercase);
+
+#endif

interpreters/bas/value.h

@@ -0,0 +1,99 @@
+#ifndef VALUE_H
+#define VALUE_H
+
+#include "str.h"
+
+enum ValueType
+{
+  V_ERROR=1,
+  V_INTEGER,
+  V_NIL,
+  V_REAL,
+  V_STRING,
+  V_VOID
+};
+
+struct Value
+{
+  enum ValueType type;
+  union
+  {
+    /* V_ERROR   */ struct { char *msg; long int code; } error;
+    /* V_INTEGER */ long int integer;
+    /* V_NIL     */
+    /* V_REAL    */ double real;
+    /* V_STRING  */ struct String string;
+    /* V_VOID    */
+  } u;
+};
+
+extern const enum ValueType Value_commonType[V_VOID+1][V_VOID+1];
+
+#define VALUE_NEW_INTEGER(this,n) ((this)->type=V_INTEGER,(this)->u.integer=(n))
+#define VALUE_NEW_REAL(this,n) ((this)->type=V_REAL,(this)->u.real=(n))
+#define VALUE_RETYPE(v,t) ((v)->type==(t) ? (v) : Value_retype(v,t))
+#define VALUE_DESTROY(this) assert((this)!=(struct Value*)0); \
+  switch ((this)->type) \
+  { \
+    case V_ERROR: free((this)->u.error.msg); break; \
+    case V_INTEGER: break; \
+    case V_NIL: break; \
+    case V_REAL: break; \
+    case V_STRING: String_destroy(&(this)->u.string); break; \
+    case V_VOID: break; \
+    default: assert(0); \
+  } \
+  (this)->type=0;
+
+
+#ifndef HAVE_LRINT
+extern long int lrint(double d);
+#endif
+extern double Value_trunc(double d);
+extern double Value_round(double d);
+extern long int Value_toi(double d, int *overflow);
+extern long int Value_vali(const char *s, char **end, int *overflow);
+extern double Value_vald(const char *s, char **end, int *overflow);
+
+extern struct Value *Value_new_NIL(struct Value *this);
+extern struct Value *Value_new_ERROR(struct Value *this, int code, const char *error, ...);
+extern struct Value *Value_new_INTEGER(struct Value *this, int n);
+extern struct Value *Value_new_REAL(struct Value *this, double n);
+extern struct Value *Value_new_STRING(struct Value *this);
+extern struct Value *Value_new_VOID(struct Value *this);
+extern struct Value *Value_new_null(struct Value *this, enum ValueType type);
+extern int Value_isNull(const struct Value *this);
+extern void Value_destroy(struct Value *this);
+extern void Value_errorPrefix(struct Value *this, const char *prefix);
+extern void Value_errorSuffix(struct Value *this, const char *suffix);
+extern struct Value *Value_new_typeError(struct Value *this, enum ValueType t1, enum ValueType t2);
+extern struct Value *Value_retype(struct Value *this, enum ValueType type);
+extern struct Value *Value_clone(struct Value *this, const struct Value *original);
+extern struct Value *Value_uplus(struct Value *this, int calc);
+extern struct Value *Value_uneg(struct Value *this, int calc);
+extern struct Value *Value_unot(struct Value *this, int calc);
+extern struct Value *Value_add(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_sub(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_mult(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_div(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_idiv(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_mod(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_pow(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_and(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_or(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_xor(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_eqv(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_imp(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_lt(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_le(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_eq(struct Value *this, struct Value *s, int calc);
+extern struct Value *Value_ge(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_gt(struct Value *this, struct Value *x, int calc);
+extern struct Value *Value_ne(struct Value *this, struct Value *x, int calc);
+extern int Value_exitFor(struct Value *this, struct Value *limit, struct Value *step);
+extern struct String *Value_toString(struct Value *this, struct String *s, char pad, int headingsign, size_t width, int commas, int dollar, int dollarleft, int precision, int exponent, int trailingsign);
+extern struct Value *Value_toStringUsing(struct Value *this, struct String *s, struct String *using, size_t *usingpos);
+extern struct String *Value_toWrite(struct Value *this, struct String *s);
+extern struct Value *Value_nullValue(enum ValueType type);
+
+#endif

interpreters/bas/var.c

@@ -0,0 +1,431 @@
+/* #includes */ /*{{{C}}}*//*{{{*/
+#undef  _POSIX_SOURCE
+#define _POSIX_SOURCE   1
+#undef  _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 2
+
+#include "config.h"
+
+#include <assert.h>
+#ifdef HAVE_GETTEXT
+#include <libintl.h>
+#define _(String) gettext(String)
+#else
+#define _(String) String
+#endif
+#include <math.h>
+#include <stdlib.h>
+
+#include "error.h"
+#include "var.h"
+
+#ifdef USE_DMALLOC
+#include "dmalloc.h"
+#endif
+/*}}}*/
+
+struct Var *Var_new(struct Var *this, enum ValueType type, unsigned int dim, const unsigned int *geometry, int base) /*{{{*/
+{
+  unsigned int i;
+  size_t newsize;
+
+  this->type=type;
+  this->dim=dim;
+  this->base=base;
+  for (newsize=this->size=1,dim=0; dim<this->dim; ++dim)
+  {
+    if ((newsize*=geometry[dim])<this->size) return (struct Var*)0;
+    this->size=newsize;
+  }
+  if ((newsize*=sizeof(struct Value))<this->size) return (struct Var*)0;
+  if ((this->value=malloc(newsize))==(struct Value*)0) return (struct Var*)0;
+  if (dim)
+  {
+    this->geometry=malloc(sizeof(unsigned int)*dim);
+    for (i=0; i<dim; ++i) this->geometry[i]=geometry[i];
+  }
+  else
+  {
+    this->geometry=(unsigned int*)0;
+  }
+  for (i=0; i<this->size; ++i) Value_new_null(&(this->value[i]),type);
+  return this;
+}
+/*}}}*/
+struct Var *Var_new_scalar(struct Var *this) /*{{{*/
+{
+  this->dim=0;
+  this->size=1;
+  this->geometry=(unsigned int*)0;
+  this->value=malloc(sizeof(struct Value));
+  return this;
+}
+/*}}}*/
+void Var_destroy(struct Var *this) /*{{{*/
+{
+  while (this->size--) Value_destroy(&(this->value[this->size]));
+  free(this->value);
+  this->value=(struct Value*)0;
+  this->size=0;
+  this->dim=0;
+  if (this->geometry)
+  {
+    free(this->geometry);
+    this->geometry=(unsigned int*)0;
+  }
+}
+/*}}}*/
+void Var_retype(struct Var *this, enum ValueType type) /*{{{*/
+{
+  unsigned int i;
+
+  for (i=0; i<this->size; ++i)
+  {
+    Value_destroy(&(this->value[i]));
+    Value_new_null(&(this->value[i]),type);
+  }
+}
+/*}}}*/
+struct Value *Var_value(struct Var *this, unsigned int dim, int idx[], struct Value *value) /*{{{*/
+{
+  unsigned int offset;
+  unsigned int i;
+
+  assert(this->value);
+  if (dim!=this->dim) return Value_new_ERROR(value,DIMENSION);
+  for (offset=0,i=0; i<dim; ++i)
+  {
+    if (idx[i]<this->base || (idx[i]-this->base)>=this->geometry[i])
+    {
+      return Value_new_ERROR(value,OUTOFRANGE,_("array index"));
+    }
+    offset=offset*this->geometry[i]+(idx[i]-this->base);
+  }
+  assert(offset<this->size);
+  return this->value+offset;
+}
+/*}}}*/
+void Var_clear(struct Var *this) /*{{{*/
+{
+  size_t i;
+
+  for (i=0; i<this->size; ++i)
+  {
+    Value_destroy(&(this->value[i]));
+  }
+  if (this->geometry)
+  {
+    free(this->geometry);
+    this->geometry=(unsigned int*)0;
+    this->size=1;
+    this->dim=0;
+  }
+  Value_new_null(&(this->value[0]),this->type);
+}
+/*}}}*/
+struct Value *Var_mat_assign(struct Var *this, struct Var *x, struct Value *err, int work) /*{{{*/
+{
+  enum ValueType thisType=this->type;
+
+  if (work)
+  {
+    unsigned int i,j;
+    int unused=1-x->base;
+    int g0,g1;
+
+    assert(x->base==0 || x->base==1);
+    assert(x->dim==1 || x->dim==2);
+    if (this==x) return (struct Value*)0;
+    Var_destroy(this);
+    Var_new(this,thisType,x->dim,x->geometry,x->base);
+    g0=x->geometry[0];
+    g1=x->dim==1 ? unused+1 : x->geometry[1];
+    for (i=unused; i<g0; ++i) for (j=unused; j<g1; ++j)
+    {
+      unsigned int element=x->dim==1 ? i : i*g1+j;
+
+      Value_destroy(&(this->value[element]));
+      Value_clone(&(this->value[element]),&(x->value[element]));
+      Value_retype(&(this->value[element]),thisType);
+    }
+  }
+  else
+  {
+    if (Value_commonType[this->type][x->type]==V_ERROR) return Value_new_typeError(err,this->type,x->type);
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+struct Value *Var_mat_addsub(struct Var *this, struct Var *x, struct Var *y, int add, struct Value *err, int work) /*{{{*/
+{
+  enum ValueType thisType=this->type;
+  struct Value foo,bar;
+
+  if (work)
+  {
+    unsigned int i,j;
+    int unused=1-x->base;
+    int g0,g1;
+
+    assert(x->base==0 || x->base==1);
+    assert(x->dim==1 || x->dim==2);
+    if (x->base!=y->base || x->dim!=y->dim || x->geometry[0]!=y->geometry[0] || (x->dim==2 && x->geometry[1]!=y->geometry[1])) return Value_new_ERROR(err,DIMENSION);
+    if (this!=x && this!=y)
+    {
+      Var_destroy(this);
+      Var_new(this,thisType,x->dim,x->geometry,x->base);
+    }
+    g0=x->geometry[0];
+    g1=x->dim==1 ? unused+1 : x->geometry[1];
+    for (i=unused; i<g0; ++i) for (j=unused; j<g1; ++j)
+    {
+      unsigned int element=x->dim==1 ? i : i*g1+j;
+
+      Value_clone(&foo,&(x->value[element]));
+      Value_clone(&bar,&(y->value[element]));
+      if (add) Value_add(&foo,&bar,1);
+      else Value_sub(&foo,&bar,1);
+      if (foo.type==V_ERROR)
+      {
+        *err=foo;
+        Value_destroy(&bar);
+        return err;
+      }
+      Value_destroy(&bar);
+      Value_destroy(&(this->value[element]));
+      this->value[element]=*Value_retype(&foo,thisType);
+    }
+  }
+  else
+  {
+    Value_clone(err,x->value);
+    if (add) Value_add(err,y->value,0);
+    else Value_sub(err,y->value,0);
+    if (err->type==V_ERROR) return err;
+    Value_destroy(err);
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+struct Value *Var_mat_mult(struct Var *this, struct Var *x, struct Var *y, struct Value *err, int work) /*{{{*/
+{
+  enum ValueType thisType=this->type;
+  struct Var foo;
+
+  if (work)
+  {
+    unsigned int newdim[2];
+    unsigned int i,j,k;
+    int unused=1-x->base;
+
+    assert(x->base==0 || x->base==1);
+    if (x->dim!=2 || y->dim!=2 || x->base!=y->base || x->geometry[1]!=y->geometry[0]) return Value_new_ERROR(err,DIMENSION);
+    newdim[0]=x->geometry[0];
+    newdim[1]=y->geometry[1];
+    Var_new(&foo,thisType,2,newdim,0);
+    for (i=unused; i<newdim[0]; ++i) for (j=unused; j<newdim[1]; ++j)
+    {
+      struct Value *dp=&foo.value[i*newdim[1]+j];
+
+      Value_new_null(dp,thisType);
+      for (k=unused; k<x->geometry[1]; ++k)
+      {
+        struct Value p;
+
+        Value_clone(&p,&(x->value[i*x->geometry[1]+k]));
+        Value_mult(&p,&(y->value[k*y->geometry[1]+j]),1);
+        if (p.type==V_ERROR)
+        {
+          *err=p;
+          Var_destroy(&foo);
+          return err;
+        }
+        Value_add(dp,&p,1);
+        Value_destroy(&p);
+      }
+      Value_retype(dp,thisType);
+    }
+    Var_destroy(this);
+    *this=foo;
+  }
+  else
+  {
+    Value_clone(err,x->value);
+    Value_mult(err,y->value,0);
+    if (err->type==V_ERROR) return err;
+    Value_destroy(err);
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+struct Value *Var_mat_scalarMult(struct Var *this, struct Value *factor, struct Var *x, int work) /*{{{*/
+{
+  enum ValueType thisType=this->type;
+
+  if (work)
+  {
+    unsigned int i,j;
+    int unused=1-x->base;
+    int g0,g1;
+
+    assert(x->base==0 || x->base==1);
+    assert(x->dim==1 || x->dim==2);
+    if (this!=x)
+    {
+      Var_destroy(this);
+      Var_new(this,thisType,x->dim,x->geometry,0);
+    }
+    g0=x->geometry[0];
+    g1=x->dim==1 ? unused+1 : x->geometry[1];
+    for (i=unused; i<g0; ++i) for (j=unused; j<g1; ++j)
+    {
+      unsigned int element=x->dim==1 ? i : i*g1+j;
+      struct Value foo;
+
+      Value_clone(&foo,&(x->value[element]));
+      Value_mult(&foo,factor,1);
+      if (foo.type==V_ERROR)
+      {
+        Value_destroy(factor);
+        *factor=foo;
+        return factor;
+      }
+      Value_destroy(&(this->value[element]));
+      this->value[element]=*Value_retype(&foo,thisType);
+    }
+  }
+  else
+  {
+    if (Value_mult(factor,this->value,0)->type==V_ERROR) return factor;
+  }
+  return (struct Value*)0;
+}
+/*}}}*/
+void Var_mat_transpose(struct Var *this, struct Var *x) /*{{{*/
+{
+  unsigned int geometry[2];
+  enum ValueType thisType=this->type;
+  unsigned int i,j;
+  struct Var foo;
+
+  geometry[0]=x->geometry[1];
+  geometry[1]=x->geometry[0];
+  Var_new(&foo,thisType,2,geometry,0);
+  for (i=0; i<x->geometry[0]; ++i) for (j=0; j<x->geometry[1]; ++j)
+  {
+    Value_destroy(&foo.value[j*x->geometry[0]+i]);
+    Value_clone(&foo.value[j*x->geometry[0]+i],&(x->value[i*x->geometry[1]+j]));
+    Value_retype(&foo.value[j*x->geometry[0]+i],thisType);
+  }
+  Var_destroy(this);
+  *this=foo;
+}
+/*}}}*/
+struct Value *Var_mat_invert(struct Var *this, struct Var *x, struct Value *det, struct Value *err) /*{{{*/
+{
+  enum ValueType thisType=this->type;
+  int n,i,j,k,max;
+  double t,*a,*u,d;
+  int unused=1-x->base;
+
+  if (x->type!=V_INTEGER && x->type!=V_REAL) return Value_new_ERROR(err,TYPEMISMATCH5);
+  assert(x->base==0 || x->base==1);
+  if (x->geometry[0]!=x->geometry[1]) return Value_new_ERROR(err,DIMENSION);
+  n=x->geometry[0]-unused;
+
+  a=malloc(sizeof(double)*n*n);
+  u=malloc(sizeof(double)*n*n);
+  for (i=0; i<n; ++i) for (j=0; j<n; ++j)
+  {
+    if (x->type==V_INTEGER) a[i*n+j]=x->value[(i+unused)*(n+unused)+j+unused].u.integer;
+    else a[i*n+j]=x->value[(i+unused)*(n+unused)+j+unused].u.real;
+    u[i*n+j]=(i==j?1.0:0.0);
+  }
+  d=1.0;
+
+  for (i=0; i<n; ++i) /* get zeroes in column i below the main diagonale */
+  {
+    max=i;
+    for (j=i+1; j<n; ++j) if (fabs(a[j*n+i])>fabs(a[max*n+i])) max=j;
+    /* exchanging row i against row max */
+    if (i!=max) d=-d;
+    for (k=i; k<n; ++k) { t=a[i*n+k]; a[i*n+k]=a[max*n+k]; a[max*n+k]=t; }
+    for (k=0; k<n; ++k) { t=u[i*n+k]; u[i*n+k]=u[max*n+k]; u[max*n+k]=t; }
+    if (a[i*n+i]==0.0)
+    {
+      free(a);
+      free(u);
+      return Value_new_ERROR(err,SINGULAR);
+    }
+    for (j=i+1; j<n; ++j)
+    {
+      t=a[j*n+i]/a[i*n+i];
+      /* substract row i*t from row j */
+      for (k=i; k<n; ++k) a[j*n+k]-=a[i*n+k]*t;
+      for (k=0; k<n; ++k) u[j*n+k]-=u[i*n+k]*t;
+    }
+  }
+
+  for (i=0; i<n; ++i) d*=a[i*n+i]; /* compute determinant */
+
+  for (i=n-1; i>=0; --i) /* get zeroes in column i above the main diagonale */
+  {
+    for (j=0; j<i; ++j)
+    {
+      t=a[j*n+i]/a[i*n+i];
+      /* subtract row i*t from row j */
+      a[j*n+i]=0.0; /* a[j*n+i]-=a[i*n+i]*t; */
+      for (k=0; k<n; ++k) u[j*n+k]-=u[i*n+k]*t;
+    }
+    t=a[i*n+i];
+    a[i*n+i]=1.0; /* a[i*n+i]/=t; */
+    for (k=0; k<n; ++k) u[i*n+k]/=t;
+  }
+
+  free(a);
+  if (this!=x)
+  {
+    Var_destroy(this);
+    Var_new(this,thisType,2,x->geometry,x->base);
+  }
+  for (i=0; i<n; ++i) for (j=0; j<n; ++j)
+  {
+    Value_destroy(&this->value[(i+unused)*(n+unused)+j+unused]);
+    if (thisType==V_INTEGER) Value_new_INTEGER(&this->value[(i+unused)*(n+unused)+j+unused],u[i*n+j]);
+    else Value_new_REAL(&this->value[(i+unused)*(n+unused)+j+unused],u[i*n+j]);
+  }
+  free(u);
+  Value_destroy(det);
+  if (thisType==V_INTEGER) Value_new_INTEGER(det,d);
+  else Value_new_REAL(det,d);
+
+  return (struct Value*)0;
+}
+/*}}}*/
+struct Value *Var_mat_redim(struct Var *this, unsigned int dim, const unsigned int *geometry, struct Value *err) /*{{{*/
+{
+  unsigned int i,j,size;
+  struct Value *value;
+  int unused=1-this->base;
+  int g0,g1;
+
+  if (this->dim>0 && this->dim!=dim) return Value_new_ERROR(err,DIMENSION);
+  for (size=1,i=0; i<dim; ++i) size*=geometry[i];
+  value=malloc(sizeof(struct Value)*size);
+  g0=geometry[0];
+  g1=dim==1 ? 1 : geometry[1];
+  for (i=0; i<g0; ++i) for (j=0; j<g1; ++j)
+  {
+    if (this->dim==0 || i<unused || (dim==2 && j<unused) || i>=this->geometry[0] || (this->dim==2 && j>=this->geometry[1])) Value_new_null(&(value[i*g1+j]),this->type);
+    else Value_clone(&value[dim==1 ? i : i*g1+j],&this->value[dim==1 ? i : i*this->geometry[1]+j]);
+  }
+  for (i=0; i<this->size; ++i) Value_destroy(&this->value[i]);
+  free(this->value);
+  if (this->geometry==(unsigned int*)0) this->geometry=malloc(sizeof(unsigned int)*dim);
+  for (i=0; i<dim; ++i) this->geometry[i]=geometry[i];
+  this->dim=dim;
+  this->size=size;
+  this->value=value;
+  return (struct Value*)0;
+}
+/*}}}*/

interpreters/bas/var.h

@@ -0,0 +1,32 @@
+#ifndef VAR_H
+#define VAR_H
+
+#include "value.h"
+
+struct Var
+{
+  unsigned int dim;
+  unsigned int *geometry;
+  struct Value *value;
+  unsigned int size;
+  enum ValueType type;
+  char base;
+};
+
+#define VAR_SCALAR_VALUE(this) ((this)->value)
+
+extern struct Var *Var_new(struct Var *this, enum ValueType type, unsigned int dim, const unsigned int *geometry, int base);
+extern struct Var *Var_new_scalar(struct Var *this);
+extern void Var_destroy(struct Var *this);
+extern void Var_retype(struct Var *this, enum ValueType type);
+extern struct Value *Var_value(struct Var *this, unsigned int dim, int idx[], struct Value *value);
+extern void Var_clear(struct Var *this);
+extern struct Value *Var_mat_assign(struct Var *this, struct Var *x, struct Value *err, int work);
+extern struct Value *Var_mat_addsub(struct Var *this, struct Var *x, struct Var *y, int add, struct Value *err, int work);
+extern struct Value *Var_mat_mult(struct Var *this, struct Var *x, struct Var *y, struct Value *err, int work);
+extern struct Value *Var_mat_scalarMult(struct Var *this, struct Value *factor, struct Var *x, int work);
+extern void Var_mat_transpose(struct Var *this, struct Var *x);
+extern struct Value *Var_mat_invert(struct Var *this, struct Var *x, struct Value *det, struct Value *err);
+extern struct Value *Var_mat_redim(struct Var *this, unsigned int dim, const unsigned int *geometry, struct Value *err);
+
+#endif