diff options
author | Gregory Nutt <gnutt@nuttx.org> | 2014-10-27 07:53:12 -0600 |
---|---|---|
committer | Gregory Nutt <gnutt@nuttx.org> | 2014-10-27 07:53:12 -0600 |
commit | 4ef5633f361ab5302007045dcef945043d6d6225 (patch) | |
tree | 1806fe0ec9221c4e6c7439419e8b57bfe7865d29 | |
parent | f2fe892334074612e4e3159c754b65d13bc348fc (diff) | |
download | nuttx-4ef5633f361ab5302007045dcef945043d6d6225.tar.gz nuttx-4ef5633f361ab5302007045dcef945043d6d6225.tar.bz2 nuttx-4ef5633f361ab5302007045dcef945043d6d6225.zip |
Port of BAS 2.4 to NuttX by Alan Carvalho de Assis
102 files changed, 32532 insertions, 11 deletions
diff --git a/apps/interpreters/Kconfig b/apps/interpreters/Kconfig index e95215517..115876eb6 100644 --- a/apps/interpreters/Kconfig +++ b/apps/interpreters/Kconfig @@ -4,6 +4,7 @@ # source "$APPSDIR/interpreters/ficl/Kconfig" +source "$APPSDIR/interpreters/bas/Kconfig" config INTERPRETERS_PCODE bool "Pascal p-code interpreter" diff --git a/apps/interpreters/Make.defs b/apps/interpreters/Make.defs index 5d808d5d6..ad1b6903a 100644 --- a/apps/interpreters/Make.defs +++ b/apps/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 diff --git a/apps/interpreters/Makefile b/apps/interpreters/Makefile index 8c9ed8f8b..e7a1d2b00 100644 --- a/apps/interpreters/Makefile +++ b/apps/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) diff --git a/apps/interpreters/bas/INSTALL b/apps/interpreters/bas/INSTALL new file mode 100644 index 000000000..50dbe439d --- /dev/null +++ b/apps/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. + diff --git a/apps/interpreters/bas/Kconfig b/apps/interpreters/bas/Kconfig new file mode 100644 index 000000000..a02f95469 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/LICENSE b/apps/interpreters/bas/LICENSE new file mode 100644 index 000000000..80d651bdb --- /dev/null +++ b/apps/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. diff --git a/apps/interpreters/bas/Makefile b/apps/interpreters/bas/Makefile new file mode 100644 index 000000000..cd43c67e3 --- /dev/null +++ b/apps/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 + diff --git a/apps/interpreters/bas/Makefile.in b/apps/interpreters/bas/Makefile.in new file mode 100644 index 000000000..30f3a969d --- /dev/null +++ b/apps/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 +#}}} diff --git a/apps/interpreters/bas/NEWS b/apps/interpreters/bas/NEWS new file mode 100644 index 000000000..21029a52c --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/README b/apps/interpreters/bas/README new file mode 100644 index 000000000..0231dc938 --- /dev/null +++ b/apps/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. diff --git a/apps/interpreters/bas/auto.c b/apps/interpreters/bas/auto.c new file mode 100644 index 000000000..137d65220 --- /dev/null +++ b/apps/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; +} +/*}}}*/ diff --git a/apps/interpreters/bas/auto.h b/apps/interpreters/bas/auto.h new file mode 100644 index 000000000..73912ad1a --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/autotypes.h b/apps/interpreters/bas/autotypes.h new file mode 100644 index 000000000..8c11eabbf --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/bas.1.in b/apps/interpreters/bas/bas.1.in new file mode 100644 index 000000000..6b6370ab1 --- /dev/null +++ b/apps/interpreters/bas/bas.1.in @@ -0,0 +1,1189 @@ +' t +.TH BAS 1 "@UPDATED@" "" "User commands" +.SH NAME \"{{{roff}}}\"{{{ +bas \- BASIC interpreter +.\"}}} +.SH SYNOPSIS \"{{{ +.ad l +.B bas +.RB [ \-b ] +.RB [ \-l +.IR file ] +.RB [ \-r ] +.RB [ \-u ] +.RI [ "program " [ argument "...]]" +.br +.B bas +.RB [ \-\-backslash\-colon ] +.RB [ \-\-lp +.IR file ] +.RB [ \-\-restricted ] +.RB [ \-\-uppercase ] +.RI [ "program " [ argument "...]]" +.br +.B bas +.BR \-h | \-\-help +.br +.B bas +.BR \-\-version +.ad b +.\"}}} +.SH DESCRIPTION \"{{{ +.SS "Introduction" \"{{{ +.B Bas +is an interpreter for the classic dialect of the programming language +BASIC, as typically found on microcomputers of the eighties. If no +file is given, it reads optionally numbered lines from standard input. +Non-numbered lines are executed immediatly (direct mode), numbered +lines are stored in ascending order. The line number must be a positive +integer. All statements are compiled before the program is run, which +catches syntactic and other errors. Keywords and variable names are +not case sensitive. +.PP +If a program with unnumbered lines is loaded, storing or deleting +numbered lines in direct mode is not possible. You must use \fBrenum\fP +to renumber the program first or \fBedit\fP to modify the entire program +inside an editor. If a numbered program is loaded, typing a line number +with an otherwise empty line deletes that line same the \fBdelete\fP does. +.PP +If a \fIprogram\fP is given, it is loaded, compiled and run; \fBbas\fP +will exit if program execution \fBstop\fPs, \fBend\fPs or just hits the +end of the program. If the +first line of a program file begins with \fB#!\fP, it is ignored by +the interpreter. +.\"}}} +.SS "Statements" \"{{{ +Each line of a BASIC program contains one or more of the statements below. +Multiple statements are grouped by a colon (\fB:\fP) in between them. +Brackets (\fB[\fP and \fB]\fP) are converted to parentheses when loading +a program for compatibility with dialects that use them e.g. to indicate +array indices. +.IP "[\fBcall\fP] \fIfunction\fP[\fB(\fP\fIargument\fP{\fB,\fP \fIargument\fP\fB)\fP]" \"{{{ +Call the \fIfunction\fP or procedure. The ANSI syntax requires the +keyword \fBcall\fP, whereas other BASIC dialects don't. In \fBbas\fP, +\fBcall\fP is optional. +.\"}}} +.IP "\fBchdir\fP \fIdirectory$\fP" \"{{{ +Change the current directory to \fIdirectory$\fP. +.\"}}} +.IP "\fBclear\fP" \"{{{ +Set all numerical variables to 0 and all string variables to the empty string. +All arrays lose their dimension and geometry. All files are closed. +.\"}}} +.IP "\fBclose\fP [\fB#\fP\fIchannel%\fP{\fB,#\fP\fIchannel%\fP}]" \"{{{ +Close the specified channels. If no channels are given, all channels +but the standard input/output channel \fB#0\fP are closed. +.\"}}} +.IP "\fBcls\fP" \"{{{ +Clear the screen. Not all terminals support this. The rarely used keyword +\fBhome\fP will be converted to \fBcls\fP when loading a program. +.\"}}} +.IP "\fBcolor\fP [\fIforeground\fP\fB][\fB,\fP[\fP\fIbackground\fP][\fB,\fP[\fIborder\fP]]]" \"{{{ +All parameters must be between 0 and 15. If your terminal type supports +ANSI colour codes, the foreground colour will be set to the given value. +The background colour can only be set to one of the lower 8 colours, +selecting a higher colour silently uses the matching lower colour +(e.g. red instead of light red). The border colour is always ignored. +The following colours are available: black (0), blue (1), green (2), cyan +(3), red (4), magenta (5), brown (6), white (7), grey (8), light blue +(9), light green (10), light cyan (11), light red (12), light magenta +(13), yellow (14), bright white (15). +.\"}}} +.IP "\fBcopy\fP \fIfrom$\fP \fBto\fP \fIto$\fP" \"{{{ +Copy a file. +.\"}}} +.IP "\fBdata\fP \fIinput-data\fP{\fB,\fP\fIinput-data\fP}" \"{{{ +Store data to be accessed by \fBread\fP. The \fIinput-data\fP has the +same format as data that is read by \fBinput\fP statements. +Data can not be stored in direct mode. This statement is ignored +during execution. Abbreviation: \fBd.\fP +.\"}}} +.IP "\fBdec\fP \fIlvalue\fP{\fB,\fP\fIlvalue\fP}" \"{{{ +Decrement \fIlvalue\fP. +.\"}}} +.IP "\fBdef fn\fP\fIfunction\fP[\fB(\fP\fIparameter\fP[\fB,\fP\fIparameter\fP...]\fB)\fP]" \"{{{ +Define a function. Function identifiers always start with \fBfn\fP. +A function ends and returns its value using \fB=\fP\fIexpression\fP. +Additionally, a function may return a value using \fBfnreturn\fP +\fIexpression\fP before reaching its end. Functions can not be declared +in direct mode. Note: Multi line functions are not supported by all +BASIC dialects. Some dialects allow white space between the \fBfn\fP +and the rest of the identifier, because they use \fBfn\fP as token +to mark function identifiers for both declaration and function call. +\fBBas\fP removes that space when loading a program. +.\"}}} +.IP "\fBdefdbl\fP \fIvariable\fP[\fB\-\fP\fIvariable\fP]" \"{{{ +Declare the global \fIvariable\fP as real. Only unqualified variables (no +type extension) can be declared. Variable ranges can only be built from +single letter variables. Declaration is done at compile time. +.\"}}} +.IP "\fBdefint\fP \fIvariable\fP[\fB\-\fP\fIvariable\fP]" \"{{{ +Declare the global \fIvariable\fP as integer. +.\"}}} +.IP "\fBdefstr\fP \fIvariable\fP[\fB\-\fP\fIvariable\fP]" \"{{{ +Declare the global \fIvariable\fP as string. +.\"}}} +.IP "\fBdef proc\fP\fIfunction\fP[\fB(\fP\fIparameter\fP[\fB,\fP\fIparameter\fP...]\fB)\fP]" \"{{{ +Define a procedure (function that does not return a value). Procedure +identifiers always start with \fBproc\fP if defined this way. A procedure +ends with \fBend proc\fP. This is the BBC BASIC syntax. Procedures can +not be declared in direct mode. +.\"}}} +.IP "\fBdelete\fP [\fIfrom\fP][\fB\-\fP|\fB,\fP][\fIto\fP]" \"{{{ +Delete the specified line or range of lines. Unlike \fBlist\fP, the lines +must exist. +.\"}}} +.IP "\fBdim\fP \fIvariable\fP\|\fB(\fP\fIdimension%\fP{\fB,\fP\fIdimension%\fP}\fB)\fP" \"{{{ +Dimension the array \fIvariable\fP. If the array variable already exists, +it must first be \fBerase\fPd. The \fIdimension%\fP specifies the upper +index of the last element, not the number of elements! The lower index +is specified by \fBoption base\fP, it is zero by default. +.\"}}} +.IP "\fBdisplay\fP \fIfilename$\fP" \"{{{ +Display the contents of \fIfilename$\fP on standard output, like +.IR cat (1) +does. +.\"}}} +.IP "\fBdo\fP" \"{{{ +.IP "\fBexit do\fP" +.IP "\fBloop\fP" +Repeat the loop body in between \fBdo\fP and \fBloop\fP until \fBexit +do\fP ends looping. +.\"}}} +.IP "\fBdo until\fP \fIcondition\fP" \"{{{ +.IP "\fBexit do\fP" +.IP "\fBloop\fP" +Unless the \fIcondition\fP is true or \fBexit do\fP ends looping, +repeat the loop body in between \fBdo while\fP and \fBloop\fP. +This is equivalent to \fBwhile not\fP/\fBwend\fP. +.\"}}} +.IP "\fBdo while\fP \fIcondition\fP" \"{{{ +.IP "\fBexit do\fP" +.IP "\fBloop\fP" +While the \fIcondition\fP is true or \fBexit do\fP ends looping, +repeat the loop body in between \fBdo while\fP and \fBloop\fP. +This is equivalent to \fBwhile\fP/\fBwend\fP. +.\"}}} +.IP "\fBdo\fP" \"{{{ +.IP "\fBexit do\fP" +.IP "\fBloop until\fP \fIcondition\fP" +Repeat the loop body in between \fBdo\fP and \fBloop until\fP until the +\fIcondition\fP is true or until \fBexit do\fP ends looping. This is +equivalent to \fBrepeat\fP/\fBuntil\fP. +.\"}}} +.IP "\fBedit\fP [\fIline\fP]" \"{{{ +Save the program to a temporary file, start an external editor on that +file and load the program again from the file. If a \fIline\fP is given, +the editor is told to start on that line. \fBBas\fP knows the calling +conventions for a number of common editors, but if your favourite is not +among them or does not support that feature, the line will be ignored. +The editor is specified by the environment variable \fBVISUAL\fP, or +\fBEDITOR\fP if \fBVISUAL\fP is not set. If that is not set as well, +\fIvi\fP(1) is used. +.\"}}} +.IP "\fBend\fP" \"{{{ +End program execution. If the program was started from direct mode, +return to direct mode, otherwise the interpreter terminates. Although +allowed by BASIC itself, \fBbas\fP only allows \fBreturn\fP statements +to be followed by a colon and a comment, because anything else would +be unreachable. In interactive mode, a diagnostic message is printed +to indicate the program did not just terminated after the last line. +.\"}}} +.IP "\fBenviron\fP \fIentry$\fP" \"{{{ +Modify or add an environment \fIentry$\fP of the form +\fIvariable\fP\fB=\fP\fIvalue\fP. +.\"}}} +.IP "\fBerase\fP \fIvariable\fP{\fB,\fP\fIvariable\fP}" \"{{{ +Erase the array \fIvariable\fP. +.\"}}} +.IP "\fBfunction\fP \fIfunction\fP[\fB(\fP\fIparameter\fP[\fB,\fP\fIparameter\fP...]\fB)\fP]" \"{{{ +Define a function (ANSI BASIC style). A function ends using \fBend function\fP. +The name of the function is a local variable inside the function and its +value is returned as function result when program execution reaches the +end of the function. Functions can not be declared in direct mode. +.\"}}} +.IP "\fBfield\fP [\fB#\fP]\fIchannel%\fP\fB,\fP\fIwidth\fP \fBas\fP \fIlvalue$\fP {\fB,\fP\fIwidth\fP \fBas\fP \fIlvalue$\fP}" \"{{{ +Allocate \fIwidth\fP bytes in the record buffer to the \fIlvalue$\fP. +The total number of allocated bytes must not exceed the record length. +The same record buffer can be allocated to different lvalues +by using multiple field statements. Fielded lvalues must be set +with \fBlset\fP and \fBrset\fP. Simple assignments to them will cause +different storage to be allocated to them, thus not effecting the random +access buffer. +.\"}}} +.IP "\fBfor\fP \fIlvalue\fP \fB=\fP \fIexpression\fP \fBto\fP \fIexpression\fP [\fBstep\fP \fIexpression\fP]" \"{{{ +.IP "\fBnext\fP \fIlvalue\fP{\fB,\fP\fIlvalue\fP}" +The \fBfor\fP loop performs the initial variable assignment and then +executes the statements inside the loop, if the variable is lower or equal +than the limit (or greater than for negative steps). The \fBnext\fP +statement verifies if the variable already reached the value of the +\fBto\fP \fIexpression\fP. If not, it increments if by the value of +the \fBstep\fP \fIexpression\fP and causes a new repetition. A missing +\fBstep\fP \fIexpression\fP is treated as \fBstep 1\fP. The \fBnext\fP +statement may be followed by a list of lvalues. Due to the dynamic variable +geometry, the lvalues themselves +are only checked for belonging to the same variable as those in \fBfor\fP. +If no lvalues are given, the +innermost loop is terminated. For loops can be left by \fBexit for\fP. +Note: That statement is not offered by all BASIC dialects and most restrict +loop variables to scalar variables. +.\"}}} +.IP "\fBget\fP [\fB#\fP]\fIchannel%\fP [\fB,\fP\fIrecord\fP]" \"{{{ +Read the record buffer of \fIchannel%\fP from the file it is connected to, +which must be opened in \fBrandom\fP mode. If a \fIrecord\fP number is +given, the record is read there instead of being read from the current +record position. The first record is 1. +.\"}}} +.IP "\fBget\fP [\fB#\fP]\fIchannel%\fP\fB,\fP[\fIposition\fP]\fB,\fP\fIlvalue\fP" \"{{{ +Read the \fIlvalue\fP from the specified channel, which must be opened in +\fBbinary\fP mode. If a \fIposition\fP is given, the data is read there +instead of being read from the current position. The first position is 1. +.\"}}} +.IP "\fBgoto\fP \fIinteger\fP" \"{{{ +Continue execution at the specified line. If used from direct mode, the +program will first be compiled. The older two word \fBgo to\fP will be +converted into the newer \fBgoto\fP. Although allowed by BASIC itself, +\fBbas\fP only allows \fBgoto\fP statements to be followed by a colon +and a comment, because anything else would be unreachable. This also +concerns assigned \fBgoto\fP statements. +.\"}}} +.IP "\fBgosub\fP \fIinteger\fP" \"{{{ +Execute the subroutine at the specified line. The older two word \fBgo +sub\fP will be converted into the newer \fBgosub\fP. If used from direct +mode, the program will first be compiled. The \fBreturn\fP statement +returns from subroutines. Abbreviation: \fBr.\fP Although allowed by +BASIC itself, \fBbas\fP only allows \fBreturn\fP statements to be followed +by a colon and a comment, because anything else would be unreachable. +.\"}}} +.IP "\fBif\fP \fIcondition\fP [\fBthen\fP] \fIstatements\fP [\fBelse\fP \fIstatements\fP]" \"{{{ +If the \fIcondition\fP evaluates to a non-zero number of a non-empty +string, the statements after \fBthen\fP are executed. Otherwise, +the statements after \fBelse\fP are executed. If the \fBthen\fP or +\fBelse\fP statements are directly followed by an integer, \fBbas\fP +inserts a \fBgoto\fP statement before the number and if the condition +is directly followed by a \fBgoto\fP statement, a \fBthen\fP is inserted. +.IP "\fBif\fP \fIcondition\fP \fBthen\fP" +.IP "\fBelseif\fP \fIcondition\fP \fBthen\fP" +.IP "\fBelse\fP" +.IP "\fBend if\fP" +If the \fBthen\fP statement is at the end of a line, it introduces +a multi-line construct that ends with the \fBend if\fP statement (note +the white space between \fBend\fP and \fBif\fP). This form can not +be used in direct mode, where only one line can be entered at a time. +Abbreviations for \fBthen\fP and \fBelse\fP: \fBth.\fP and \fBel.\fP +.\"}}} +.IP "\fBimage\fP \fIformat\fP \"{{{ +Define a format for \fBprint using\fP. Instead of using string +variables, print formats can be defined this way and referred to by the +line number. The \fIformat\fP can be given as a string literal, which +allows leading and trailing space, or without enclosing double quotes. +\fBBas\fP converts the second form to a quoted string. This statement is +ignored during execution. \fBNote\fP: No two dialects share the syntax +and semantics for numbered print formats, but many offer it one way or +another. This statement allows you to adapt much existing code with small +changes, but probably differs from most dialects in one way or another. +.\"}}} +.IP "\fBinc\fP \fIlvalue\fP{\fB,\fP\fIlvalue\fP}" \"{{{ +Increment \fIlvalue\fP. +.\"}}} +.IP "\fBinput\fP [\fB#\fP\fIchannel%\fP\fB,\fP][\fB;\fP][\fIstring\fP[\fB;\fP|\fB,\fP|\fB:\fP]]\fIlvalue\fP{\fB,\fP\fIlvalue\fP}" \"{{{ +The \fBinput\fP statement prints the optional prompt \fIstring\fP and +a trailing question mark (\fB?\fP). After, it reads comma separated +values and assigns them to the given variables. If too few values are +typed in, missing values will be requested with the prompt \fB??\fP. +An empty value for a numeric variable means zero. If too much input +data is given, a warning is printed. If a channel other +than \fB#0\fP is specified, no question marks or error messages will be +printed, instead an error is returned. A semicolon before the prompt +will not move the cursor to a new line after pressing RETURN. If the +prompt is followed by a comma, colon or no punctuation at all, no question mark will +be printed after the prompt. \fBNote\fP: Some dialects allow a string +expression instead of the \fIstring\fP. +.\"}}} +.IP "\fBkill\fP \fIfilename$\fP" \"{{{ +Delete a file. +.\"}}} +.IP "[\fBlet\fP] \fIlvalue\fP{\fB,\fP\fIlvalue\fP} \fB=\fP \fIexpression\fP" \"{{{ +Evaluate the \fIexpression\fP and assign its value to each \fIlvalue\fP, +converting it, if needed. +\fILvalues\fP are variables or array variable elements. All assignments +are performed independently of each other. +.\"}}} +.IP "\fBline input\fP [\fB#\fP\fIchannel%\fP\fB,\fP][\fIstring\fP\fB;\fP|\fB,\fP]\fIlvalue$\fP" \"{{{ +The \fBline input\fP statement prints the optional prompt \fIstring\fP, +reads one line of input and assigns unmodified it to the \fIlvalue$\fP. +Using a comma instead of a semicolon makes no difference with this +statement. +.\"}}} +.IP "[\fBl\fP]\fBlist\fP [\fIfrom\fP][\fB\-\fP|\fB,\fP][\fIto\fP]" \"{{{ +List (part of) the program text. Control structures will automatically +be indented. If the parameter \fIfrom\fP is given, the listing starts +at the given line instead of the beginning. Similarly, \fIto\fP causes +the listing to end at line \fIto\fP instead of the end of the program. +The given line numbers do not have to exist, there are merely a numeric +range. The syntax variant using a minus sign as separator requires that +the first line is given as a literal number. This statement may also +be used inside programs, e.g. for \fBlist erl\fP. \fBllist\fP writes +the listing to the lp channel. +.\"}}} +.IP "\fBload\fP [\fIfile$\fP]" \"{{{ +Load the program \fIfile$\fP (direct mode only). The name may +be omitted to load a program of the name used by a previous \fBload\fP +or \fBsave\fP statement. +.\"}}} +.IP "\fBlocal\fP \fIvariable\fP{\fB,\fP\fIvariable\fP}" \"{{{ +Declare a variable local to the current function. The scope ranges +from the declaration to the end of the function. +.\"}}} +.IP "\fBlocate\fP \fIline\fP,\fIcolumn\fP" \"{{{ +Locate the cursor at the given \fIline\fP and \fIcolumn\fP. The first +line and column is 1. Not all terminals support this. +.\"}}} +.IP "\fBlock\fP [\fB#\fP]\fIchannel%\fP" \"{{{ +Wait for an exclusive lock on the file associated with the \fIchannel%\fP +to be granted. +.\"}}} +.IP "\fBlset\fP \fIvariable$\fP\fB=\fP\fIexpression\fP" \"{{{ +Store the left adjusted \fIexpression\fP value in the storage +currently occupied by the \fIvariable$\fP. If the storage does not suffice, +the \fIexpression\fP value is truncated, if its capacity exceeds the length +of the \fIexpression\fP value, it is padded with spaces. +.\"}}} +.IP "\fBrset\fP \fIvariable$\fP\fB=\fP\fIexpression\fP" \"{{{ +Store the right adjusted \fIexpression\fP value in the storage currently +occupied by the \fIvariable$\fP, padding with spaces from the right if +the storage capacity exceeds the length of the \fIexpression\fP value. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=\fP\fImatrixVariable\fP" \"{{{ +Matrix variables are one or two-dimensional array variables, but the elements +at index 0 in each dimension are unused. The \fIvariable\fP does not +have to be dimensioned. Note: If it is, some BASIC dialects require +that its number of elements must be equal or greater than that of +the \fImatrixVariable\fP, which is valid for all matrix assignments. +The \fIvariable\fP will be (re)dimensioned to the geometry of the +\fImatrixVariable\fP and all elements (starting at index 1, not 0) +of the \fImatrixVariable\fP will be copied to \fIvariable\fP. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=\fP\fImatrixVariable\fP[\fB+\fP|\fB\-\fP|\fB*\fP \fImatrixVariable\fP]" \"{{{ +The \fIvariable\fP will be (re)dimensioned as for matrix assignments +and the matrix sum (difference, product) will be assigned to it. Note: +Some BASIC dialects require that result matrix \fIvariable\fP must not +be a factor of the product, e.g. \fBa=a*a\fP is illegal in those dialects. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=(\fP\fIfactor\fP\fB)*\fP\fImatrixVariable\fP" \"{{{ +Assign the scalar product of the \fIfactor\fP and the \fImatrixVariable\fP to +\fIvariable\fP. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=con\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]" \"{{{ +Assign a matrix whose elements are all \fB1\fP to \fIvariable\fP. +If dimensions are specified, the matrix \fIvariable\fP will be +(re)dimensioned. A missing number of \fIcolumns\fP (re)dimensions the +variable with 2 columns, including column 0. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=idn\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]" \"{{{ +Assign a matrix whose diagonal elements are \fB1\fP and remaining +elements are \fB0\fP to \fIvariable\fP. Some dialects can only +generate square matrices and use only one argument to specify both +rows and columns. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=inv(\fP\fImatrixVariable\fP\fB)\fP" \"{{{ +Assign the inverse of the \fImatrixVariable\fP to \fIvariable\fP, +(re)dimensioning it if needed. Only two-dimensional square matrixes can be inverted. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=trn(\fP\fImatrixVariable\fP\fB)\fP" \"{{{ +Assign the transposed elements of \fImatrixVariable\fP to \fIvariable\fP, +(re)dimensioning it if needed. Note: Some BASIC dialects require that +\fIvariable\fP and \fImatrixVariable\fP are different. Only two-dimensional +matrixes can be transposed. +.\"}}} +.IP "\fBmat\fP \fIvariable\fP\fB=zer\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]" \"{{{ +Assign a matrix whose elements are all \fB0\fP to \fIvariable\fP. +.\"}}} +.IP "\fBmat input\fP [\fB#\fP\fIchannel%\fP\fB,\fP]\fIvariable\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]{\fB,\fP \fIvariable\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]}" \"{{{ +This statement reads all elements of a matrix \fIvariable\fP without row +or column 0 from the specified channel (or standard input, if no channel +is given). For two-dimensional matrices, the elements are read in row order. +Elements are separated with a comma. +If the channel is \fB#0\fP, the prompt \fB?\fP is printed until all elements are read. +.\"}}} +.IP "\fBmat print\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]][\fBusing\fP \fIformat\fP\fB;\fP]\fImatrixVariable\fP{\fB;\fP|\fB,\fP \fImatrixVariable\fP}[\fB;\fP|\fB,\fP]" \"{{{ +Print the given \fImatrixVariable\fP, optionally using the \fBusing\fP +format string or line (see \fBprint using\fP below) for +formatting the matrix elements. If no format string is used, a following +comma prints the elements in zoned format (default), whereas a semicolon +prints them without extra space between them. The output starts on a new +line, unless the output position is already at the beginning of a new line. +A blank line is printed between matrix variables. +.\"}}} +.IP "\fBmat read\fP \fIvariable\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]{\fB,\fP \fIvariable\fP[\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP]}" \"{{{ +Read constants from \fBdata\fP statemets and assign them to the elements +of the matrix \fIvariable\fP. +.\"}}} +.IP "\fBmat redim\fP \fIvariable\fP\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP{\fB,\fP \fIvariable\fP\fB(\fP\fIrows\fP[\fB,\fP\fIcolumns\fP]\fB)\fP}" \"{{{ +Resize a matrix \fIvariable\fP. The matrix must not exist before, in +which case it will be created. If it does exist, it must be of the same +dimension, but it may be smaller or larger. Truncated elements will be +permanently lost, new elements will be set to \fB0\fP for numeric and +\fB""\fP for string variables. Identical positions in the old and the +new matrix keep their value. Note: Some BASIC dialects require that +the matrix variable must exist before, some only forbid to grow matrix +variables beyond their original dimension and some keep the values at +the same storage position, which appears as if they got shuffled around +when changing the size and as if previously lost values reappear. +.\"}}} +.IP "\fBmat write\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]]\fImatrixVariable\fP{\fB;\fP|\fB,\fP \fImatrixVariable\fP}[\fB;\fP|\fB,\fP]" \"{{{ +Write the values of the given \fImatrixVariable\fP to the specified channel or +to standard output if no channel is given. Different values are +separated by commas and a newline is written at the end of a line. +Strings will be written enclosed in double quotes and positive numbers +are not written with a heading blank. +.\"}}} +.IP "\fBmid$(\fP\fIlvalue$\fP\fB,\fP\fIposition%\fP[\fB,\fP\fIlength%\fP]\fB)=\fP\fIvalue$\fP" \"{{{ +Replace the characters starting at the given \fIposition%\fP inside +\fIlvalue$\fP with the characters from \fIvalue$\fP. An optional +\fIlength%\fP limits how many characters of \fIlvalue$\fP are replaced. +The replacement will not go beyond the length of \fIlvalue$\fP. Note: +Not all BASIC dialects support this statement. +.\"}}} +.IP "\fBmkdir\fP \fIdirectory$\fP" \"{{{ +Create a \fIdirectory$\fP. +.\"}}} +.IP "\fBname\fP \fIoldname$\fP \fBas\fP \fInewname$\fP" \"{{{ +Rename the file \fIoldname$\fP to \fInewname$\fP. +.\"}}} +.IP "\fBnew\fP" \"{{{ +Erase the program to write a new one (direct mode only). +All files are closed and all variables removed. +.\"}}} +.IP "\fBon\fP \fIchoice%\fP \fBgoto\fP \fIline\fP{\fB,\fP\fIline\fP}" \"{{{ +If the integral value of \fIchoice\fP is 1, execution continues at the +first specified \fIline\fP, if 2, on the second, etc. If the value falls +outside the range for which lines are given, execution continues at the +next statement. +.\"}}} +.IP "\fBon\fP \fIchoice%\fP \fBgosub\fP \fIline\fP{\fB,\fP\fIline\fP}" \"{{{ +This is similar to \fBon goto\fP, but a \fBgosub\fP is executed instead +of the \fBgoto\fP. +.\"}}} +.IP "\fBon error goto 0\fP" \"{{{ +If executed in the context of an exception handler, re-throw the last +exception that happened. Otherwise disable exception handling. +.\"}}} +.IP "\fBon error\fP \fIstatements\fP" \"{{{ +Register the \fIstatements\fP as exception handler to catch any thrown +exceptions. Exception handlers inside procedures are always local: +If a procedure aborts by an unhandled exception, that exception may be +caught by its caller. If the \fIstatements\fP do not abort the program +or jump elsewhere, execution continues at the next line. Note: This +more general form differs from traditional interpreters that require +\fBon error goto\fP. +.\"}}} +.IP "\fBon error off\fP" \"{{{ +Disable exception handling. +.\"}}} +.IP "\fBopen\fP \fImode$\fP\fB,\fP[\fB#\fP]\fIchannel%\fP\fB,\fP\fIfile$\fP[\fB,\fP\fIlength\fP]" \"{{{ +Open the \fIfile$\fP through the \fIchannel%\fP. The mode must be +\fB"i"\fP for input, \fB"o"\fP for output, \fB"a"\fP for appending +output or \fB"r"\fP for random access. Opening the file for random +access requires the record \fIlength\fP to be specified. This syntax +is used by MBASIC and some other interpreters. +.\"}}} +.IP "\fBopen\fP \fIfile$\fP [\fBfor\fP \fBinput\fP|\fBoutput\fP|\fBappend\fP|\fBrandom\fP|\fBbinary\fP] [\fBaccess\fP \fBread\fP|\fBwrite\fP|\fBread write\fP] [\fBshared\fP|\fBlock read\fP|\fBlock write\fP] \fBas file\fP [\fB#\fP]\fIchannel%\fP [\fBlen=\fP\fIlength%\fP]" \"{{{ +Open the \fIfile$\fP through the \fIchannel%\fP. Files opened in +\fBinput\fP mode must already exist, whereas the other methods create +them as needed. If the file is opened for random access and no record +\fIlength\fP is specified, a record length of 1 is used. This is the +ANSI BASIC syntax found in more modern programs. The \fBbinary\fP mode +is similar to \fBrandom\fP mode, but there is no fixed record length: +Data is read and written directly using \fBget\fP and \fBput\fP without +using \fBfield\fP. If no open method is specified, the file is opened +as \fIrandom\fP. Optionally, a file access mode can be specified. +.IP +The file locking implementations vary greatly between dialects: Some +implementations offer independent locks for reading and writing, +others offer shared locks (usually used for many readers) and +exclusive locks (usually used for writers). Additionally, locks may +be advisory/cooperative or mandatory. Most dialects use exclusive +locks of highest protection by default. \fBBas\fP implements POSIX +shared/exclusive locks, which are usually advisory, and offers the +following: +.RS +.IP \fBshared\fP +any process can read or write file +.IP "\fBlock read\fP" +shared lock, \fBopen\fP fails if file is locked exclusively +.IP "\fBlock write\fP +exclusive lock +.IP "default" +no lock is taken, same as \fBshared\fP +.RE +.IP +Programs using locks may fail if the dialect they were written for +had different lock semantics! +.\"}}} +.IP "\fBoption base\fP \fIbase\fP" \"{{{ +Specify the lowest array index for \fBdim\fP (zero by default). Note: +Many BASIC dialects enforce the base to be 0 or 1, further they require +the base to be specified only once and before creating any arrays. +\fBBas\fP allows to set an individual base for any array, but all +\fBmat\fP functions require the bases of their operands to be equal and +to be 0 or 1. +.\"}}} +.IP "\fBoption run\fP" \"{{{ +Ignore terminal interrupts (usually control c) and XON/XOFF flow control (control s/control q). +.\"}}} +.IP "\fBoption stop\fP" \"{{{ +Accept terminal interrupts (usually control c) to stop a program and +XON/XOFF flow control (control s/control q) to stop and resume terminal +output. +.\"}}} +.IP "\fBout\fP \fIaddress\fP\fB,\fP\fIvalue\fP" \"{{{ +Write the \fPvalue\fP to the I/O port \fIaddress\fP. Direct port +access is not available in the portable version. +.\"}}} +.IP "\fBpoke\fP \fIaddress\fP\fB,\fP\fIvalue\fP" \"{{{ +Write the \fPvalue\fP to the memory \fIaddress\fP. Direct memory +access is not available in the portable version. +.\"}}} +.IP "[\fBl\fP]\fBprint\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]][\fBusing\fP \fIformat\fP\fB;\fP]{\fIexpression\fP|\fBtab(\fP\fIposition\fP\fB)\fP|\fBspc(\fP\fIlength\fP\fB)\fP|\fB;\fP|\fB,\fP}" \"{{{ +Evaluate the expressions and print their values to the integral +expression \fIchannel%\fP. If no channel is given, the standard output +channel \fB#0\fP will be used. The statement \fBlprint\fP prints to the +printer channel and no other channel can be specified. The \fBusing\fP +format string or line may contain the following characters: +.RS +.IP "\fB_\fP" +Print the following character instead of interpreting it as formatting +command. +.IP "\fB!\fP" +Print the first character of a string. +.IP "\fB\e\fP" +Print two more characters of a string as there are +spaces between the backslashes. +.IP "\fB&\fP" +Print a string without any formatting. Note: Some BASIC dialects use +\fB&\fP characters to specify the string width. A single \fB&\fP would +only print the first character in those dialects. In other dialects, +an ampersand represents one digit of the numeric format, padding the +number with zeroes. +.IP "\fB+\fP" +A plus at the beginning or end of a numeric format causes the sign to +be printed at the beginning or the end. +.IP "\fB\-\fP" +A minus at the end of a numeric format prints a trailing minus after +negative numbers and a space else. +.IP "\fB,\fP" +A comma inside the integral part of a numeric format inserts a comma +before each three-digit group of the integral part of the number. +It also represents one digit in the format. Although one comma suffices, +it makes formats more readable to insert a comma every three digits. +.IP "\fB#\fP" +Each hash sign represents one digit of the numeric format. If there +are fewer digits in the integral part of the value, it is preceded by +spaces. +.IP "\fB^\fP" +Each caret represents one digit of the exponent. At least three carets +are required, because the exponent is leaded by an \fBE\fP and the +epxonent sign is always printed. The number is printed in the numeric +format asked for by hash signs with the exponent adjusted accordingly, +e.g. printing \fB5\fP using \fB###.##^^^^^\fP results in \fB500.00E-002\fP. +.IP "\fB*\fP" +Like a hash sign, but the number will not be preceded by spaces, but +by asterisks. +.IP "\fB0\fP" +Like a hash sign, but the number will not be preceded by spaces, but +by zeroes. +.IP "\fB.\fP" +The dot specifies the position of the decimal point between a +pound/asterisk sign group for the integral value and an optional pound +sign group for the precision of the fractional part. +.IP "\fB$\fP" +A dollar sign prefixes the number with a dollar. Further dollar signs +increase the numeric width like \fB#\fP and \fB*\fP. If the dollar sign +stands in front of all padding, it will precede it, otherwise it will be +printed after any padding. +.IP "any other character" +Any other character is printed literally and separates different numeric +fields of a multi-field format. +.RE +.IP +If no format is given, positive values are printed with a heading space, +negative values are printed with a heading minus, the precision is set +as required and the number is followed by a space. \fBprint\fP without +\fBusing\fP will advance to the next line if the value of the expression +no longer fits into the current line. +.IP +A semicolon concatenates the output while a comma puts the values in +columns. A trailing semicolon suppresses printing a trailing newline. +The pseudo function \fBtab\fP, which must only be used within \fBprint\fP +statements, spaces to the specified print position (column) with 0 being +the leftmost position. If the current print position is already beyond +\fIvalue\fP, it does nothing. If \fIvalue\fP is beyond the output width, +advancing the position stops there. The pseudo function \fBspc\fP is similar +to \fBtab\fP, but it prints as many spaces as specified by its argument. +Abbreviation: \fB?\fP or \fBp.\fP +.\"}}} +.IP "\fBput\fP [\fB#\fP]\fIchannel%\fP [\fB,\fP\fIrecord\fP]" \"{{{ +Write the record buffer of \fIchannel%\fP to the file it is connected to, +which must be opened in \fBrandom\fP mode. If a \fIrecord\fP number +is given, the record is written there instead of being written to the +current record position. +.\"}}} +.IP "\fBput\fP [\fB#\fP]\fIchannel%\fP\fB,\fP[\fIposition\fP]\fB,\fP\fIvalue\fP" \"{{{ +Write the \fIvalue\fP to the specified channel, which must be opened +in \fBbinary\fP mode. If a \fIrecord\fP number is given, the data is +written there instead of being written to the current position. +.\"}}} +.IP "\fBrandomize\fP [\fInumber%\fP]" \"{{{ +Seed the random number generator. If no argument is given, it will be +initialised with a random number. +.\"}}} +.IP "\fBread\fP \fIlvalue\fP{\fB,\fP\fIlvalue\fP}" \"{{{ +Read constants from \fBdata\fP statements and assign them to the +\fIlvalue\fPs. +.\"}}} +.IP "\fBrem\fP \fIarbitrary text\fP" \"{{{ +This statement introduces comments. +.\"}}} +.IP "\fBrename\fP \fIfrom$\fP \fBto\fP \fIto$\fP" \"{{{ +Rename a file. +.\"}}} +.IP "\fB'\fP \fIarbitrary text\fP" \"{{{ +This is an alternative form of comments, which can directly follow +statements without a colon. An exclamation mark instead of the +quotation mark is also recognised and converted to a quotation mark. +.\"}}} +.IP "\fBrenum\fP [\fIfirst\fP[\fB,\fP\fIincrement\fP]]" \"{{{ +Renumber the program. The \fIfirst\fP line number and the line number +\fIincrement\fP can be optionally given. If omitted, a value of 10 will +be used for both. +.\"}}} +.IP "\fBrepeat\fP" \"{{{ +.IP "\fBuntil\fP \fIcondition\fP" +Execute the loop body and repeat doing so if the \fIcondition\fP is +not zero. The loop body will be executed at least once. Abbreviation: +\fBrep.\fP +.\"}}} +.IP "\fBrestore\fP [\fIline\fP]" \"{{{ +Restore the data pointer to the first \fBdata\fP statement for reading +data again. An optional line number restores the pointer to the first +\fBdata\fP statement in that line. Abbreviation: \fBres.\fP Note: Some +BASIC dialects allow to specify a line without a \fBdata\fP statement +and search beginning from that line for one. This implementation +does not allow that, because it is more often an error than used as +a feature. +.\"}}} +.IP "\fBresume\fP \fIline\fP" \"{{{ +End an exception handler and continue execution at the specified line. +This is only needed if you intend to re-throw exceptions by on \fBon error +goto 0\fP. +Although allowed by BASIC itself, \fBbas\fP +only allows \fBresume\fP statements to be followed by a colon and a comment, +because anything else would be unreachable. +.\"}}} +.IP "\fBrun\fP [\fIline\fP|\fIfile$\fP]" \"{{{ +Compile the program, clear all variables, close all files and start program execution. +If a file is specified, the file is loaded first and run from the +beginning. If a line is specified, execution starts at the given +line. +.\"}}} +.IP "\fBsave\fP [\fIfile$\fP]" \"{{{ +Save the program to the given \fIfile$\fP (direct mode only). The name may +be omitted to save the program under the name used by a previous \fBload\fP +or \fBsave\fP statement. +.\"}}} +.IP "\fBselect case\fP \fIselector\fP" \"{{{ +.IP "\fBcase\fP \fImatch\fP{\fB,\fP \fImatch\fP}" +.IP "\fImatch\fP = \fIexpression\fP [\fBto\fP \fIexpression\fP] | \fBis\fP \fIrelop\fP \fIexpression\fP" +.IP "\fBcase else\fP" +.IP "\fBend select\fP" +Execute the statements after the first \fBcase\fP statement that +matches the \fIselector\fP expression, then skip to the \fIend select\fP +statement. A single \fIexpression\fP matches its value, \fBto\fP matches +the range between the first and the second \fIexpression\fP including the +limits, and \fBis\fP compares the \fIselector\fP using the relational +operator with the \fIexpression\fP. The \fIcase else\fP branch always +matches if none of the above did. If the \fIselector\fP does not match +any branch, control passes to the statement following \fBend select\fP. +\fBNote\fP: Some BASIC dialects treat this case as an error. +.\"}}} +.IP "\fBshell\fP [\fIcommand$\fP]" \"{{{ +If a \fIcommand$\fP is given, it is executed as child process of +\fBbas\fP as bourne shell command. If used without a \fIcommand$\fP, +the shell specified by the environment variable \fBSHELL\fP (defaults +to the bourne shell if not set) is started without arguments. +.\"}}} +.IP "\fBsleep\fP \fIpause\fP" \"{{{ +The program pauses for \fIpause\fP seconds. If your system allows it, +fractional seconds can be used. +.\"}}} +.IP "\fBstop\fP" \"{{{ +Stop the program. Apart from printing where the program stopped, this +is identical to \fBend\fP. +.\"}}} +.IP "\fBsub\fP\fIfunction\fP[\fB(\fP\fIparameter\fP[\fB,\fP\fIparameter\fP...]\fB)\fP]" \"{{{ +Define a procedure (function that does not return a value). A procedure +ends with \fBsubend\fP; the alternative forms \fBsub end\fP and \fBend +sub\fP are converted to \fBsubend\fP when loading programs. A procedure +can be left by \fBsubexit\fP; again the alternative forms \fBsub exit\fP and +\fBexit sub\fP and converted to \fBsubexit\fP when loading programs. +Procedures can not be declared in direct +mode. This is the ANSI syntax. +.\"}}} +.IP "\fBswap\fP \fIlvalue1\fP\fB,\fP\fIlvalue2\fP" \"{{{ +Swap the contents of \fIlvalue1\fP and \fIlvalue2\fP. Both must +be of identical type. +.\"}}} +.IP "\fBsystem\fP" \"{{{ +Exit from \fBbas\fP. Alternatively, \fBbye\fP may be used. +.\"}}} +.IP "\fBtron\fP" \"{{{ +Enable tracing by printing the line number of each executed program line. +.\"}}} +.IP "\fBtroff\fP" \"{{{ +Disable program tracing. +.\"}}} +.IP "\fBtruncate\fP [\fB#\fP]\fIchannel%\fP" \"{{{ +Truncate the file after the current position. The file must be opened with +write access. +.\"}}} +.IP "\fBunlock\fP [\fB#\fP]\fIchannel%\fP" \"{{{ +Release any locks on the file associated with the \fIchannel%\fP. +.\"}}} +.IP "\fBunnum\fP" \"{{{ +Remove all line numbers that are not needed, which is the the opposite +to \fBrenum\fP. This command is specific to \fBbas\fP, although a +similar command is found in Bytewater BASIC. +.\"}}} +.IP "\fBwait\fP \fIaddress\fP\fB,\fP\fImask\fP\fB,\fP\fIselect\fP" \"{{{ +Wait until the I/O port \fIaddress\fP (XORed with \fIselect\fP, if specified) +masked out using \fImask\fP is not equal zero. Direct port access is not +available in the portable version. +.\"}}} +.IP "\fBwhile\fP \fIexpression\fP" \"{{{ +.IP "\fBwend\fP" +While the \fIexpression\fP is not zero, the loop body, ended by \fBwend\fP, +will be repeatedly executed. +.\"}}} +.IP "\fBwidth\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]] [[\fIwidth%\fP][\fB,\fP\fIzone%\fP]]" \"{{{ +Set the channel \fIwidth%\fP. After \fIwidth%\fP characters have been +printed to the channel, a newline character is automatically sent to it +for starting a new line. A \fIwidth%\fP of zero sets the channel width +to infinite. Optionally, the \fIzone\fP width can be specified. Note: Some +dialects use this, others use the \fBzone\fP statement. +.\"}}} +.IP "\fBwrite\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]]{\fIexpression\fP|\fB,\fP|\fB;\fP}" \"{{{ +Write the values of the given expressions to the specified channel or +to standard output if no channel is given. Different expressions are +separated by commas and a newline is written at the end of the list. +Strings will be written enclosed in double quotes and positive numbers +are not written with a heading blank. +.\"}}} +.IP "\fBxref\fP" \"{{{ +Output a list of all functions, global variables, \fBGOSUB\fP and \fBGOTO\fP +statements and the line numbers where they are referenced. +.\"}}} +.IP "\fBzone\fP [\fB#\fP\fIchannel%\fP[\fB,\fP]]\fIwidth%\fP" \"{{{ +Set the channel zone \fIwidth%\fP. A comma in PRINT advances to the +next print zone, similar to a tabulator. +.\"}}} +.\"}}} +.SS "Expressions and Functions" \"{{{ +Expressions consist of operators or functions that act on integer, +real (floating point) or string values. Beside decimal notation, +integer values can be written as hexadecimal values by prefixing them +with \fB&h\fP and as octal values by prefixing them with \fB&o\fP. +String constants may contain paired double quotes to specify double quote +characters inside strings. If the constant is terminated by the end of +the line, the trailing double quote can be omitted. Numeric constants +with the suffix \fB#\fP or \fB!\fP are always regarded as floating point +constants, \fBbas\fP ignores the precision specification, because it +does not offer different precisions. Integer constants may be followed +by the suffix \fB%\fP. If an integer literal is outside the integer +value range, it is treated as a floating point literal. +.PP +The table below shows the available operators with decreasing priority. +The operator \fB=>\fP is converted to \fB>=\fP, \fB=<\fP is converted +to \fB<=\fP and \fB><\fP is converted to \fB<>\fP when programs are loaded. +.PP +.TS +box,center; +c l +cfB l. +operator meaning +_ +^ exponentiation +_ +\- unary negation ++ unary plus +_ +* multiplication +/ floating-point division +\e integer division (equal to fix(a/b)) +mod modulo +_ ++ addition, string concatenation +\- substraction +_ +> greater than +>= greater than or equal to +\&= equal to +<> not equal to +<= less than or equal to +< less than +_ +not binary complement +_ +and binary and +_ +or binary or +xor binary exclusive or +eqv binary equivalent +imp binary implication +.TE +.sp .5v +.PP +Besides operators, various builtin functions can be used in expressions. +The dollar character (\fB$\fP) denotes that the argument must be of +the type string. The actual parameters of functions, both builtin +and user-defined, as well as subroutines, are passed by value. Note: +Modern (not old) ANSI BASIC passes actual parameters by reference. +Many classic dialects don't offer call by reference and \fBbas\fP +follows that direction. Arguments to functions and subroutines must +be enclosed in parentheses. Note: Some dialects allow to omit them, +which introduces ambiguity in some cases. +.IP "\fBabs(\fP\fIx\fP\fB)\fP" +Return the absolute value of \fIn\fP. +.IP "\fBasc(\fP\fIstring$\fP\fB)\fP" +Return the numeric value of the first character of the \fIstring\fP. +.IP "\fBatn(\fP\fIx\fP\fB)\fP" +Return the arctangent value of \fIx\fP. +.IP "\fBbin$(\fP\fIn%\fP\fB)\fP" +Return a string containing the binary conversion of \fIn%\fP. +.IP "\fBbin$(\fP\fIn%\fP\fB,\fP\fIdigits%\fP\fB)\fP" +Return a string containing the binary conversion of \fIn%\fP +with the specified number of \fIdigits%\fP. +.IP "\fBchr$(\fP\fIvalue%\fP\fB)\fP" +Return a string of length 1 that contains the character with the given +\fIvalue%\fP. +.IP "\fBcint(\fP\fIx\fP\fB)\fP" +Return the integral value value nearest to \fIx\fP (rounded upwards). +.IP "\fBcode(\fP\fIstring$\fP\fB)\fP" +Return the numeric value of the first character of the \fIstring\fP. +This is the same as \fBasc(\fP\fIstring\fP\fB)\fP, used by dialects +that took non-ASCII systems into consideration. +.IP "\fBcommand$\fP" +Return extra command line arguments after the program name, separated +by spaces. The program name is not part of the return value. Note: +This function is implemented for compatibility and does not deal with +arguments with embedded spaces. +.IP "\fBcommand$(\fP\fIn%\fP\fB)\fP" +Return the \fIn%\fPth argument passed to the program, starting with 1. +The first returned argument (index 0) is the program name. +.IP "\fBcos(\fP\fIx_rad\fP\fB)\fP" +Return the cosine value of \fIx_rad\fP. +.IP "\fBcvd(\fP\fIx$\fP\fB)\fP" +Convert a string value generated by \fBmkd$(\fP\fIx\fP\fB)\fP back to +a floating point value. The string characters contain the bytes of a +C double precision value. The string length and the byte encoding is +machine dependent and not portable. +.IP "\fBcvs(\fP\fIx$\fP\fB)\fP" +Convert a string value generated by \fBmks$(\fP\fIx\fP\fB)\fP back to +a floating point value. The string characters contain the bytes of a +C single precision value. The string length and the byte encoding is +machine dependent and not portable. +.IP "\fBcvi(\fP\fIx$\fP\fB)\fP" +Convert a string value back to an integral value. +The string characters contain the bytes of a signed little endian number +and the sign bit of the last byte determines the sign of the resulting +number. +.IP "\fBdate$\fP" +Return the date as a 10-character string in the form +\fImm\fP\fB\-\fP\fIdd\fP\fB\-\fP\fIyyyy\fP. +.IP "\fBdec$(\fP\fIx\fP,\fBformat$\fP\fB)\fP" +Convert \fIx\fP to a string according to the \fBprint using\fP \fIformat$\fP. +.IP "\fBdeg(\fP\fIradians\fP\fB)\fP" +Convert radians to degrees. +.IP "\fBdet\fP" +Return the determinant of the last matrix inverted. +.IP "\fBedit$(\fP\fIstring$\fP\fB,\fP\fIcode%\fP\fB)\fP" +Return the result of editing the \fIstring$\fP as indicated by the \fIcode%\fP. +The following editing codes are available: +.RS +.IP 1 +discard parity bit +.IP 2 +discard all spaces and tabs +.IP 4 +discard all carriage returns, line feeds, form feeds, +deletes, escapes and nulls +.IP 8 +discard leading spaces and tabs +.IP 16 +convert multiple spaces and tabs to one space +.IP 32 +convert lower case to upper case +.IP 64 +convert left brackets to left parentheses and right +brackes to right parentheses +.IP 128 +discard trailing spaces and tabs +.IP 256 +suppress all editing for characters within matching +single or double quotes. If the matching quote is missing, +suppress all editing up to the end of the string. +.RE +.IP +The codes can be added for combined editing operations. +.IP "\fBenviron$(\fP\fIn%\fP\fB)\fP" +Return the \fIn%\fPth environment entry in the form +\fIvariable\fP\fB=\fP\fIvalue\fP, starting with 1. If \fIn%\fP is larger +than the number of entries, an empty string is returned. +.IP "\fBenviron$(\fP\fIvariable$\fP\fB)\fP" +Return the value of the specified environment \fIvariable$\fP. If there +is no such variable, an empty string is returned. +.IP "\fBeof(\fP\fIchannel%\fP\fB)\fP" +Return true if the end of the channel has been reached. This must be +used to avoid that \fBinput\fP tries to read past the end of a file. +.IP "\fBerl\fP" +Return the number of the line where the last exception was thrown. +.IP "\fBerr\fP" +Return a numeric code for the last exception that was thrown. The use +of this function is not portable. +.IP "\fBexp(\fP\fIx\fP\fB)\fP" +Return the value of e raised to the power of \fIx\fP. +.IP "\fBfalse\fP" +Return 0. +.IP "\fBfind$(\fP\fIpattern$\fP[\fB,\fP\fInth%\fP]\fB)\fP +Return the first (or \fInth%\fP, starting from 0, if specified) filename +that matches the given pattern or the empty string, if no filename +matches the pattern. This function is usually used to check for the +existance of a file. The pattern may use the wildcards \fB*\fP to match +an arbitrary number of characters and \fB?\fP to match a single character. +Note: On some systems, the star does not match a dot inside a filename. +In this implementation, the star matches everything and \fB*.*\fP only +matches files with a dot in their name, not files without an extension. +Some systems also encode file attributes in the eigth bit of the +file name and programs strip that bit from the output of \fBfind$\fP. +It is recommended to use only 7-bit file names with applications using +this function. +.IP "\fBfix(\fP\fIx\fP\fB)\fP" +Return the integral part of a floating point value. +.IP "\fBfp(\fP\fIx\fP\fB)\fP" +Return the fractional part of a floating point value. +.IP "\fBfrac(\fP\fIx\fP\fB)\fP" +Return the fractional part of a floating point value; same as \fBfp\fP. +.IP "\fBfreefile\fP" +Return the first free file handle. +.IP "\fBhex$(\fP\fIn%\fP\fB)\fP" +Return a string containing the hexadecimal conversion of \fIn%\fP. +.IP "\fBhex$(\fP\fIn%\fP\fB,\fP\fIdigits%\fP\fB)\fP" +Return a string containing the hexadecimal conversion of \fIn%\fP +with the specified number of \fIdigits%\fP. +.IP "\fBinkey$\fP[\fB(\fP\fItimeout%\fP[\fB,\fP\fIchannel\fP]\fB)\fP]" +Wait at most \fItimeout\fP hundredths of a second for a character to +be read from the terminal. If a character could be read, return it, +otherwise return the empty string. Omitting the \fItimeout%\fP will +return immediatly if no character is available. Note: Some BASIC +dialects wait until a character is available if no timeout is given +instead of returning an empty string. Convert those programs by using +\fBinput$(1)\fP instead. +.IP "\fBinp(\fP\fIaddress\fP\fB)\fP" +Return the value of the I/O port \fIaddress\fP. Direct port access is +not available in the portable version. +.IP "\fBinput$(\fP\fIlength\fP[\fB,\fP\fIchannel\fP]\fB)\fP" +Read a string of \fIlength\fP characters from standard input or from +the specified \fIchannel\fP. The characters will not be echoed. +.IP "\fBinstr(\fP\fIhaystack$\fP\fB,\fP\fIneedle$\fP\fB)\fP" +Return the position of \fIneedle$\fP in \fIhaystack$\fP. If \fIneedle$\fP +is not found, then 0 is returned. +.IP "\fBinstr(\fP\fIstart%\fP\fB,\fP\fIhaystack$\fP\fB,\fP\fIneedle$\fP\fB)\fP" +As above, but start searching at position \fIstart%\fP (first position is 1). +.IP "\fBinstr(\fP\fIhaystack$\fP\fB,\fP\fIneedle$\fP\fB,\fP\fIstart%\fP\fB)\fP" +As above, but some BASIC dialects have this order of parameters. +.IP "\fBinstr(\fP\fIhaystack$\fP\fB,\fP\fIneedle$\fP\fB,\fP\fIstart%\fP\fB,\fP\fIlength%\fP\fB)\fP" +As above, but only limit search to the first \fIlength%\fP characters +starting at position \fIstart%\fP. +.IP "\fBint(\fP\fIx\fP\fB)\fP" +Return the integral value nearest to \fIx\fP (rounded downwards). +.IP "\fBint%(\fP\fIx\fP\fB)\fP" +Same as \fBint\fP, but return an integer. +.IP "\fBip(\fP\fIx\fP\fB)\fP" +Return the integral part of a floating point value; same as \fBfix\fP. +.IP "\fBlcase$(\fP\fIstring$\fP\fB)\fP" +Return the string with all characters changed to lower case. +.IP "\fBlower$(\fP\fIstring$\fP\fB)\fP" +Same as \fBlcase\fP, some dialects call it this way. +.IP "\fBleft$(\fP\fIstring$\fP\fB,\fP\fIn%\fP\fB)\fP" +Return the first \fIn%\fP characters of the \fIstring\fP. If \fIn\fP is +greater than the number of characters in the string, the whole +string is returned. +.IP "\fBlen(\fP\fIstring$\fP\fB)\fP" +Return the length (number of characters) of the \fIstring\fP. +.IP "\fBloc(\fP\fIchannel%\fP\fB)\fP" +If used on random-access files, the number of the last accessed record +is returned. For sequential files, the current read/write position is +returned. Note: Some BASIC dialects return the record position in bytes +and the read/write position in pseudo-records. +.IP "\fBlof(\fP\fIchannel%\fP\fB)\fP" +Return the size of the file that is attached to the channel (bytes +for sequential or binary files, records for random-access files). +This may not work correctly for files with sizes that exceed the range +of integer numbers. Note: Some BASIC dialects return the number of +bytes even for random-access files. +.IP "\fBlog(\fP\fIx\fP\fB)\fP" +Return the natural logarithm of \fIx\fP. +.IP "\fBlog10(\fP\fIx\fP\fB)\fP" +Return the base-10 logarithm of \fIx\fP. +.IP "\fBlog2(\fP\fIx\fP\fB)\fP" +Return the base-2 logarithm of \fIx\fP. +.IP "\fBmatch(\fP\fIneedle$\fP\fB,\fP\fIhaystack$\fP\fB,\fP\fIstart%\fP\fB)\fP" +Return the first position of \fIneedle$\fP in \fIhaystack$\fP that +is greater than or equal \fIstart%\fP. If the search fails or if +\fIstart%\fP exceeds the length of \fIhaystack$\fP, 0 will be returned. +The following characters in \fIneedle$\fP have a special meaning: +\fB!\fP matches any letter, \fB#\fP matches any digit, \fB?\fP matches +any character and \fB\e\fP quotes the next character, e.g. \fB\e?\fP +matches a question mark. +.IP "\fBmax(\fP\fIx\fP\fB,\fP\fIy\fP\fB)\fP" +Return the maximum of \fIx\fP and \fIy\fP. +.IP "\fBltrim$(\fP\fIstring$\fP\fB)\fP" +Return the string without leading spaces. +.IP "\fBmid$(\fP\fIstring$\fP\fB,\fP\fIposition%\fP[\fB,\fP\fIlen%\fP]\fB)\fP" +Return the substring of \fIstring\fP that begins at the given +\fIposition%\fP (the first character is at position 1). If \fIstring\fP +is too short for a substring of \fIlen%\fP characters, fewer characters +will be returned. +.IP "\fBmin(\fP\fIx\fP\fB,\fP\fIy\fP\fB)\fP" +Return the minimum of \fIx\fP and \fIy\fP. +.IP "\fBmkd$(\fP\fIx\fP\fB)\fP" +Return a string whose characters contain the bytes of a C double precision +number. The string length and byte encoding depends of the machine type +and is not portable. +.IP "\fBmks$(\fP\fIx\fP\fB)\fP" +Return a string whose characters contain the bytes of a C single precision +number. The string length and byte encoding depends of the machine type +and is not portable. +.IP "\fBmki$(\fP\fIx\fP\fB)\fP" +Return a string whose characters contain the bytes of a little endian +integral value. The string length depends of the machine type, but +the little endian encoding allows to store only e.g. the first two bytes +if the value does not exceed the range of a signed 16 bit number. +.IP "\fBoct$(\fP\fIn%\fP\fB)\fP" +Return a string containing the octal conversion of \fIn%\fP. +.IP "\fBpeek(\fP\fIaddress\fP\fB)\fP" +Return the value of the memory \fIaddress\fP. Direct memory access is +not available in the portable version. +.IP "\fBpi\fP" +Return the constant pi. +.IP "\fBpos(\fP\fIdummy\fP\fB)\fP" +Return the current cursor position, starting with 1 as the leftmost +position. The numeric \fIdummy\fP argument is needed, because old BASIC +implementations did not allow functions without arguments. +.IP "\fBpos(\fP\fIhaystack$\fP\fB,\fP\fIneedle$\fP\fB,\fP\fIstart%\fP\fB)\fP" +Same as \fBinstr$\fP, some dialects use this function name. +.IP "\fBrad(\fP\fIdegrees\fP\fB)\fP" +Convert degrees to radians. +.IP "\fBright$(\fP\fIstring$\fP\fB,\fP\fIn%\fP\fB)\fP" +Return the last \fIn\fP characters of the \fIstring\fP. If \fIn%\fP is +greater than the number of characters in the string, the whole +string is returned. +.IP "\fBrnd(\fP[\fIx%\fP]\fB)\fP" +Return a random integer number between 1 and \fIx%\fP. If \fIx%\fP is zero, +one or missing, a real number between 0.0 and 1.0 is returned. If \fIx%\fP is +negative, the random number generator will be seeded with \fB-\fP\fIx%\fP +and the functions returns a value as if \fB-\fP\fIx%\fP had been passed +to it. +.IP "\fBrtrim$(\fP\fIstring$\fP\fB)\fP" +Return the string without trailing spaces. +.IP "\fBseg$(\fP\fIstring$\fP\fB,\fP\fIposition%\fP\fB,\fP\fIlen%\fP\fB)\fP" +Same as \fBmid$\fP, some dialects use this function name. +.IP "\fBsgn(\fP\fIx\fP\fB)\fP" +Return the sign \fIx\fP: \-1 for negative numbers, 0 for 0 and 1 for +positive numbers. +.IP "\fBsin(\fP\fIx_rad\fP\fB)\fP" +Return the sine value of \fIx_rad\fP. +.IP "\fBspace$(\fP\fIlength%\fP\fB)\fP" +Return a string containing \fIlength%\fP spaces. +.IP "\fBsqr(\fP\fIx\fP\fB)\fP" +Return the square root of \fIx\fP. +.IP "\fBstr$(\fP\fIx\fP\fB)\fP" +Return a string that contains the decimal represantation of \fIx\fP. +.IP "\fBstring$(\fP\fIlength\fP\fB,\fP\fIx\fP\fB)\fP" +Return a string of size \fIlength\fP whose characters have the decimal +code \fIx\fP. +.IP "\fBstring$(\fP\fIlength%\fP\fB,\fP\fIx$\fP\fB)\fP" +Return a string of size \fIlength%\fP whose characters are the first +character of \fIx$\fP. +.IP "\fBstrip$(\fP\fIstring\fP\fB)\fP" +Return the string with the eighth bit of each character cleared. +.IP "\fBtan(\fP\fIx_rad\fP\fB)\fP" +Return the tangent of \fIx_rad\fP. +.IP "\fBtime\fP" +Return the current value of the centisecond counter. +.IP "\fBtime$\fP" +Return the time as a 8-character string in the form +\fIhh\fP\fB\-\fP\fImm\fP\fB\-\fP\fIss\fP. +.IP "\fBtimer\fP +Return the number of seconds elapsed since midnight local time. +.IP "\fBtrue\fP" +Return \-1. +.IP "\fBucase$(\fP\fIstring$\fP\fB)\fP" +Return the string with all characters changed to upper case. +.IP "\fBupper$(\fP\fIstring$\fP\fB)\fP" +Same as \fBucase$\fP, some dialects call it this way. +.IP "\fBval(\fP\fIstring$\fP\fB)\fP" +If possible, then convert the \fIstring$\fP into an integer or floating +point value, ignoring trailing junk. Otherwise, return 0.0. Like +anywhere else, hexadecimal values are specified by a leading \fB&h\fP. +.\"}}} +.\"}}} +.SH OPTIONS \"{{{ +.IP "\fB\-b\fP, \fB\-\-backslash\-colon\fP" +Convert backslashs to colons. By default, a backslash is the operator +for integer division, but in some BASIC dialects it forms compound +statements as the colon does. +.IP "\fB\-l\fP \fIfile\fP, \fB\-\-lp\fP \fIfile\fP" +Write \fBLLIST\fP and \fBLPRINT\fP output to \fIfile\fP. By default, +that output will be written to \fB/dev/null\fP. +.IP "\fB\-r\fP, \fB\-\-restricted\fP" +Restricted operation which does not allow to fork a shell. +.IP "\fB\-u\fP, \fB\-\-uppercase\fP" +Output all tokens in uppercase. By default, they are lowercase, +which is easier to read, but some BASIC dialects require uppercase. +This option allows to save programs for those dialects. +.IP "\fB\-h\fP, \fB\-\-help\fP" +Output usage and exit. +.IP "\fB\-v\fP, \fB\-\-version\fP" +Display version information and exit. +.\"}}} +.SH AUTHOR \"{{{ +This program is copyright 1999\(en2014 Michael Haardt +<michael@moria.de>. +.PP +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: +.PP +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. +.PP +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. +.\"}}} +.SH HISTORY \"{{{ +There has been a \fIbas\fP(1) command in UNIX v7, but its syntax +was strongly influenced by C, unlike common classic BASIC dialects, and +thus not compatible with this implementation. +.\"}}} +.SH "SEE ALSO" \"{{{ +The Usenet group comp.lang.basic.misc discusses the classic BASIC dialect. +.\"}}} diff --git a/apps/interpreters/bas/bas.c b/apps/interpreters/bas/bas.c new file mode 100644 index 000000000..eba40371f --- /dev/null +++ b/apps/interpreters/bas/bas.c @@ -0,0 +1,1736 @@ +/* #includes */ /*{{{C}}}*//*{{{*/ +#include "config.h" + +#include <sys/stat.h> +#include <sys/types.h> +#include <sys/wait.h> +#include <assert.h> +#include <ctype.h> +#include <errno.h> +#include <fcntl.h> +#ifdef HAVE_GETTEXT +#include <libintl.h> +#define _(String) gettext(String) +#else +#define _(String) String +#endif +#include <limits.h> +#include <math.h> +#include <string.h> +#include <stdlib.h> +#include <stdio.h> +#include <time.h> +#include <unistd.h> + +#include "getopt.h" + +#include "auto.h" +#include "bas.h" +#include "error.h" +#include "fs.h" +#include "global.h" +#include "program.h" +#include "value.h" +#include "var.h" + +#ifdef USE_DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ +/* #defines */ /*{{{*/ +#define DIRECTMODE (pc.line==-1) +#ifndef __GNUC__ +#define inline +#endif +/*}}}*/ + +/* types */ /*{{{*/ +enum LabelType +{ + L_IF=1, + L_ELSE, + L_DO, + L_DOcondition, + L_FOR, + L_FOR_VAR, + L_FOR_LIMIT, + L_FOR_BODY, + L_REPEAT, + L_SELECTCASE, + L_WHILE, + L_FUNC +}; + +struct LabelStack +{ + enum LabelType type; + struct Pc patch; +}; +/*}}}*/ +/* variables */ /*{{{*/ +static unsigned int labelStackPointer,labelStackCapacity; +static struct LabelStack *labelStack; +static struct Pc *lastdata; +static struct Pc curdata; +static struct Pc nextdata; +static enum { DECLARE, COMPILE, INTERPRET } pass; +static int stopped; +static int optionbase; +static struct Pc pc; +static struct Auto stack; +static struct Program program; +static struct Global globals; +static int run_restricted; + +int bas_argc; +char *bas_argv0; +char **bas_argv; +int bas_end; +/*}}}*/ +/* forward prototypes */ /*{{{*/ +static struct Value *statements(struct Value *value); +static struct Value *compileProgram(struct Value *v, int clearGlobals); +static struct Value *eval(struct Value *value, const char *desc); +/*}}}*/ + +static char *mytmpnam(void) /*{{{*/ +{ + static char buf[_POSIX_PATH_MAX]; + const char *tmpdir; + unsigned int i; + int fd=-1; + + if ((tmpdir=getenv("TMPDIR"))==(char*)0) tmpdir="/tmp"; + if ((strlen(tmpdir)+1+8+1)>=_POSIX_PATH_MAX) return (char*)0; + i=getpid(); + while (i<0xffffffff && (snprintf(buf,sizeof(buf),"%s/%08x",tmpdir,i),(fd=open(buf,O_RDWR|O_CREAT|O_EXCL,0600)))==-1 && errno==EEXIST) ++i; + if (fd==-1) return (char*)0; + close(fd); + return buf; +} +/*}}}*/ +static int cat(const char *filename) /*{{{*/ +{ + int fd; + char buf[4096]; + ssize_t l; + int err; + + if ((fd=open(filename,O_RDONLY))==-1) return -1; + while ((l=read(fd,buf,sizeof(buf)))>0) + { + ssize_t off,w; + + off=0; + while (off<l) + { + if ((w=write(1,buf+off,l-off))==-1) + { + err=errno; + close(fd); + errno=err; + return -1; + } + off+=w; + } + } + if (l==-1) + { + err=errno; + close(fd); + errno=err; + return -1; + } + close(fd); + return 0; +} +/*}}}*/ +static struct Value *lvalue(struct Value *value) /*{{{*/ +{ + struct Symbol *sym; + struct Pc lvpc=pc; + + sym=pc.token->u.identifier->sym; + assert(pass==DECLARE || sym->type==GLOBALVAR || sym->type==GLOBALARRAY || sym->type==LOCALVAR); + if ((pc.token+1)->type==T_OP) + { + struct Pc idxpc; + unsigned int dim,capacity; + int *idx; + + pc.token+=2; + dim=0; + capacity=0; + idx=(int*)0; + while (1) + { + if (dim==capacity && pass==INTERPRET) /* enlarge idx */ /*{{{*/ + { + int *more; + + more=realloc(idx,sizeof(unsigned int)*(capacity?(capacity*=2):(capacity=3))); + if (!more) + { + if (capacity) free(idx); + return Value_new_ERROR(value,OUTOFMEMORY); + } + idx=more; + } + /*}}}*/ + idxpc=pc; + if (eval(value,_("index"))->type==V_ERROR || VALUE_RETYPE(value,V_INTEGER)->type==V_ERROR) + { + if (capacity) free(idx); + pc=idxpc; + return value; + } + if (pass==INTERPRET) + { + idx[dim]=value->u.integer; + ++dim; + } + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pc.token->type!=T_CP) + { + assert(pass!=INTERPRET); + return Value_new_ERROR(value,MISSINGCP); + } + else ++pc.token; + switch (pass) + { + case INTERPRET: + { + if ((value=Var_value(&(sym->u.var),dim,idx,value))->type==V_ERROR) pc=lvpc; + free(idx); + return value; + } + case DECLARE: + { + return Value_nullValue(V_INTEGER); + } + case COMPILE: + { + return Value_nullValue(sym->type==GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,sym)); + } + default: assert(0); + } + return (struct Value*)0; + } + else + { + ++pc.token; + switch (pass) + { + case INTERPRET: return VAR_SCALAR_VALUE(sym->type==GLOBALVAR ? &(sym->u.var) : Auto_local(&stack,sym->u.local.offset)); + case DECLARE: return Value_nullValue(V_INTEGER); + case COMPILE: return Value_nullValue(sym->type==GLOBALVAR? sym->u.var.type : Auto_varType(&stack,sym)); + default: assert(0); + } + return (struct Value*)0; + } +} +/*}}}*/ +static struct Value *func(struct Value *value) /*{{{*/ +{ + struct Identifier *ident; + struct Pc funcpc=pc; + int firstslot=-99; + int args=0; + struct Symbol *sym; + + assert(pc.token->type==T_IDENTIFIER); + /* + Evaluating a function in direct mode may start a program, so it needs to + be compiled. If in direct mode, programs will be compiled after the + direct mode pass DECLARE, but errors are ignored at that point, because + the program may not be needed. If the program is fine, its symbols will + be available during the compile phase already. If not and we need it + at this point, compile it again to get the error and abort. + */ + if (DIRECTMODE && !program.runnable && pass!=DECLARE) + { + if (compileProgram(value,0)->type==V_ERROR) return value; + Value_destroy(value); + } + ident=pc.token->u.identifier; + assert(pass==DECLARE || ident->sym->type==BUILTINFUNCTION || ident->sym->type==USERFUNCTION); + ++pc.token; + if (pass!=DECLARE) + { + firstslot=stack.stackPointer; + if (ident->sym->type==USERFUNCTION && ident->sym->u.sub.retType!=V_VOID) + { + struct Var *v=Auto_pushArg(&stack); + Var_new(v,ident->sym->u.sub.retType,0,(const unsigned int*)0,0); + } + } + if (pc.token->type==T_OP) /* push arguments to stack */ /*{{{*/ + { + ++pc.token; + if (pc.token->type!=T_CP) while (1) + { + if (pass==DECLARE) + { + if (eval(value,_("actual parameter"))->type==V_ERROR) return value; + Value_destroy(value); + } + else + { + struct Var *v=Auto_pushArg(&stack); + + Var_new_scalar(v); + if (eval(v->value,(const char*)0)->type==V_ERROR) + { + Value_clone(value,v->value); + while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var); + return value; + } + v->type=v->value->type; + } + ++args; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pc.token->type!=T_CP) + { + if (pass!=DECLARE) + { + while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var); + } + return Value_new_ERROR(value,MISSINGCP); + } + ++pc.token; + } + /*}}}*/ + if (pass==DECLARE) Value_new_null(value,ident->defaultType); + else + { + int i; + int nomore; + int argerr; + int overloaded; + + if (pass==INTERPRET && ident->sym->type==USERFUNCTION) + { + for (i=0; i<ident->sym->u.sub.u.def.localLength; ++i) + { + struct Var *v=Auto_pushArg(&stack); + Var_new(v,ident->sym->u.sub.u.def.localTypes[i],0,(const unsigned int*)0,0); + } + } + Auto_pushFuncRet(&stack,firstslot,&pc); + + sym=ident->sym; + overloaded=(pass==COMPILE && sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next); + do + { + nomore=(pass==COMPILE && !(sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next)); + argerr=0; + if (args<sym->u.sub.argLength) /*{{{*/ + { + if (nomore) Value_new_ERROR(value,TOOFEW); + argerr=1; + } + /*}}}*/ + else if (args>sym->u.sub.argLength) /*{{{*/ + { + if (nomore) Value_new_ERROR(value,TOOMANY); + argerr=1; + } + /*}}}*/ + else /*{{{*/ + { + for (i=0; i<args; ++i) + { + struct Value *arg=Var_value(Auto_local(&stack,i),0,(int*)0,value); + + assert(arg->type!=V_ERROR); + if (overloaded) + { + if (arg->type!=sym->u.sub.argTypes[i]) + { + if (nomore) Value_new_ERROR(value,TYPEMISMATCH2,i+1); + argerr=1; + break; + } + } + else if (Value_retype(arg,sym->u.sub.argTypes[i])->type==V_ERROR) + { + if (nomore) Value_new_ERROR(value,TYPEMISMATCH3,arg->u.error.msg,i+1); + argerr=1; + break; + } + } + } + /*}}}*/ + if (argerr) + { + if (nomore) + { + Auto_funcReturn(&stack,(struct Pc*)0); + pc=funcpc; + return value; + } + else sym=sym->u.sub.u.bltin.next; + } + } while (argerr); + ident->sym=sym; + if (sym->type==BUILTINFUNCTION) + { + if (pass==INTERPRET) + { + if (sym->u.sub.u.bltin.call(value,&stack)->type==V_ERROR) pc=funcpc; + } + else Value_new_null(value,sym->u.sub.retType); + } + else if (sym->type==USERFUNCTION) + { + if (pass==INTERPRET) + { + int r=1; + + pc=sym->u.sub.u.def.scope.start; + if (pc.token->type==T_COLON) ++pc.token; + else Program_skipEOL(&program,&pc,STDCHANNEL,1); + do + { + if (statements(value)->type==V_ERROR) + { + if (strchr(value->u.error.msg,'\n')==(char*)0) + { + Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,value); + Program_PCtoError(&program,&pc,value); + } + if (stack.onerror.line!=-1) + { + stack.resumeable=1; + pc=stack.onerror; + } + else + { + Auto_frameToError(&stack,&program,value); + break; + } + } + else if (value->type!=V_NIL) break; + Value_destroy(value); + } while ((r=Program_skipEOL(&program,&pc,STDCHANNEL,1))); + if (!r) Value_new_VOID(value); + } + else Value_new_null(value,sym->u.sub.retType); + } + Auto_funcReturn(&stack,pass==INTERPRET && value->type!=V_ERROR ? &pc : (struct Pc*)0); + } + return value; +} +/*}}}*/ + +#ifdef USE_LR0 +/* Grammar with LR(0) sets */ /*{{{*/ +/* +Grammar: + +1 EV -> E +2 E -> E op E +3 E -> op E +4 E -> ( E ) +5 E -> value + +i0: +EV -> . E goto(0,E)=5 +E -> . E op E goto(0,E)=5 +E -> . op E +,- shift 2 +E -> . ( E ) ( shift 3 +E -> . value value shift 4 + +i5: +EV -> E . else accept +E -> E . op E op shift 1 + +i2: +E -> op . E goto(2,E)=6 +E -> . E op E goto(2,E)=6 +E -> . op E +,- shift 2 +E -> . ( E ) ( shift 3 +E -> . value value shift 4 + +i3: +E -> ( . E ) goto(3,E)=7 +E -> . E op E goto(3,E)=7 +E -> . op E +,- shift 2 +E -> . ( E ) ( shift 3 +E -> . value value shift 4 + +i4: +E -> value . reduce 5 + +i1: +E -> E op . E goto(1,E)=8 +E -> . E op E goto(1,E)=8 +E -> . op E +,- shift 2 +E -> . ( E ) ( shift 3 +E -> . value value shift 4 + +i6: +E -> op E . reduce 3 +E -> E . op E op* shift 1 *=if stack[-2] contains op of unary lower priority + +i7: +E -> ( E . ) ) shift 9 +E -> E . op E op shift 1 + +i8: +E -> E op E . reduce 2 +E -> E . op E op* shift 1 *=if stack[-2] contains op of lower priority or if + if it is of equal priority and right associative + +i9: +E -> ( E ) . reduce 4 + +*/ +/*}}}*/ +static struct Value *eval(struct Value *value, const char *desc) /*{{{*/ +{ + /* variables */ /*{{{*/ + static const int gotoState[10]={ 5,8,6,7,-1,-1,-1,-1,-1,-1 }; + int capacity=10; + struct Pdastack + { + union + { + enum TokenType token; + struct Value value; + } u; + char state; + }; + struct Pdastack *pdastack=malloc(capacity*sizeof(struct Pdastack)); + struct Pdastack *sp=pdastack; + struct Pdastack *stackEnd=pdastack+capacity-1; + enum TokenType ip; + /*}}}*/ + + sp->state=0; + while (1) + { + if (sp==stackEnd) + { + pdastack=realloc(pdastack,(capacity+10)*sizeof(struct Pdastack)); + sp=pdastack+capacity-1; + capacity+=10; + stackEnd=pdastack+capacity-1; + } + ip=pc.token->type; + switch (sp->state) + { + case 0: + case 1: + case 2: + case 3: /*{{{*/ /* including 4 */ + { + if (ip==T_IDENTIFIER) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0 + ) + { + Value_new_ERROR(value,UNDECLARED); + goto error; + } + } + if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR)) + { + struct Value *l; + + if ((l=lvalue(value))->type==V_ERROR) goto error; + Value_clone(&sp->u.value,l); + } + else + { + struct Pc var=pc; + + func(&sp->u.value); + if (sp->u.value.type==V_VOID) + { + pc=var; + Value_new_ERROR(value,VOIDVALUE); + goto error; + } + } + } + /*}}}*/ + else if (ip==T_INTEGER) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.integer); + ++pc.token; + } + /*}}}*/ + else if (ip==T_REAL) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + VALUE_NEW_REAL(&sp->u.value,pc.token->u.real); + ++pc.token; + } + /*}}}*/ + else if (TOKEN_ISUNARYOPERATOR(ip)) /*{{{*/ + { + /* printf("state %d: shift 2\n",sp->state); */ + ++sp; + sp->state=2; + sp->u.token=ip; + ++pc.token; + } + /*}}}*/ + else if (ip==T_HEXINTEGER) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.hexinteger); + ++pc.token; + } + /*}}}*/ + else if (ip==T_OCTINTEGER) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.octinteger); + ++pc.token; + } + /*}}}*/ + else if (ip==T_OP) /*{{{*/ + { + /* printf("state %d: shift 3\n",sp->state); */ + ++sp; + sp->state=3; + sp->u.token=T_OP; + ++pc.token; + } + /*}}}*/ + else if (ip==T_STRING) /*{{{*/ + { + /* printf("state %d: shift 4\n",sp->state); */ + /* printf("state 4: reduce E -> value\n"); */ + ++sp; + sp->state=gotoState[(sp-1)->state]; + Value_new_STRING(&sp->u.value); + String_destroy(&sp->u.value.u.string); + String_clone(&sp->u.value.u.string,pc.token->u.string); + ++pc.token; + } + /*}}}*/ + else /*{{{*/ + { + char state=sp->state; + + if (state==0) + { + if (desc) Value_new_ERROR(value,MISSINGEXPR,desc); + else value=(struct Value*)0; + } + else Value_new_ERROR(value,MISSINGEXPR,_("operand")); + goto error; + } + /*}}}*/ + break; + } + /*}}}*/ + case 5: /*{{{*/ + { + if (TOKEN_ISBINARYOPERATOR(ip)) + { + /* printf("state %d: shift 1\n",sp->state); */ + ++sp; + sp->state=1; + sp->u.token=ip; + ++pc.token; + break; + } + else + { + assert(sp==pdastack+1); + *value=sp->u.value; + free(pdastack); + return value; + } + break; + } + /*}}}*/ + case 6: /*{{{*/ + { + if (TOKEN_ISBINARYOPERATOR(ip) && TOKEN_UNARYPRIORITY((sp-1)->u.token)<TOKEN_BINARYPRIORITY(ip)) + { + assert(TOKEN_ISUNARYOPERATOR((sp-1)->u.token)); + /* printf("state %d: shift 1 (not reducing E -> op E)\n",sp->state); */ + ++sp; + sp->state=1; + sp->u.token=ip; + ++pc.token; + } + else + { + enum TokenType op; + + /* printf("reduce E -> op E\n"); */ + --sp; + op=sp->u.token; + sp->u.value=(sp+1)->u.value; + switch (op) + { + case T_PLUS: break; + case T_MINUS: Value_uneg(&sp->u.value,pass==INTERPRET); break; + case T_NOT: Value_unot(&sp->u.value,pass==INTERPRET); break; + default: assert(0); + } + sp->state=gotoState[(sp-1)->state]; + if (sp->u.value.type==V_ERROR) + { + *value=sp->u.value; + --sp; + goto error; + } + } + break; + } + /*}}}*/ + case 7: /*{{{*/ /* including 9 */ + { + if (TOKEN_ISBINARYOPERATOR(ip)) + { + /* printf("state %d: shift 1\n"sp->state); */ + ++sp; + sp->state=1; + sp->u.token=ip; + ++pc.token; + } + else if (ip==T_CP) + { + /* printf("state %d: shift 9\n",sp->state); */ + /* printf("state 9: reduce E -> ( E )\n"); */ + --sp; + sp->state=gotoState[(sp-1)->state]; + sp->u.value=(sp+1)->u.value; + ++pc.token; + } + else + { + Value_new_ERROR(value,MISSINGCP); + goto error; + } + break; + } + /*}}}*/ + case 8: /*{{{*/ + { + int p1,p2; + + if + ( + TOKEN_ISBINARYOPERATOR(ip) + && + ( + ((p1=TOKEN_BINARYPRIORITY((sp-1)->u.token))<(p2=TOKEN_BINARYPRIORITY(ip))) + || (p1==p2 && TOKEN_ISRIGHTASSOCIATIVE((sp-1)->u.token)) + ) + ) + { + /* printf("state %d: shift 1\n",sp->state); */ + ++sp; + sp->state=1; + sp->u.token=ip; + ++pc.token; + } + else + { + /* printf("state %d: reduce E -> E op E\n",sp->state); */ + if (Value_commonType[(sp-2)->u.value.type][sp->u.value.type]==V_ERROR) + { + Value_destroy(&sp->u.value); + sp-=2; + Value_destroy(&sp->u.value); + Value_new_ERROR(value,INVALIDOPERAND); + --sp; + goto error; + } + else switch ((sp-1)->u.token) + { + case T_LT: Value_lt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_LE: Value_le(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_EQ: Value_eq(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_GE: Value_ge(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_GT: Value_gt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_NE: Value_ne(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_PLUS: Value_add(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_MINUS: Value_sub(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_MULT: Value_mult(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_DIV: Value_div(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_IDIV: Value_idiv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_MOD: Value_mod(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_POW: Value_pow(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_AND: Value_and(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_OR: Value_or(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_XOR: Value_xor(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_EQV: Value_eqv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + case T_IMP: Value_imp(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break; + default: assert(0); + } + Value_destroy(&sp->u.value); + sp-=2; + sp->state=gotoState[(sp-1)->state]; + if (sp->u.value.type==V_ERROR) + { + *value=sp->u.value; + --sp; + goto error; + } + } + break; + } + /*}}}*/ + } + } + error: + while (sp>pdastack) + { + switch (sp->state) + { + case 5: + case 6: + case 7: + case 8: Value_destroy(&sp->u.value); + } + --sp; + } + free(pdastack); + return value; +} +/*}}}*/ +#else +static inline struct Value *binarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/ +{ + enum TokenType op; + struct Pc oppc; + + if (level(value)==(struct Value*)0) return (struct Value*)0; + if (value->type==V_ERROR) return value; + do + { + struct Value x; + + op=pc.token->type; + if (!TOKEN_ISBINARYOPERATOR(op) || TOKEN_BINARYPRIORITY(op)!=prio) return value; + oppc=pc; + ++pc.token; + if (level(&x)==(struct Value*)0) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGEXPR,_("binary operand")); + } + if (x.type==V_ERROR) + { + Value_destroy(value); + *value=x; + return value; + } + if (Value_commonType[value->type][x.type]==V_ERROR) + { + Value_destroy(value); + Value_destroy(&x); + return Value_new_ERROR(value,INVALIDOPERAND); + } + else switch (op) + { + case T_LT: Value_lt(value,&x,pass==INTERPRET); break; + case T_LE: Value_le(value,&x,pass==INTERPRET); break; + case T_EQ: Value_eq(value,&x,pass==INTERPRET); break; + case T_GE: Value_ge(value,&x,pass==INTERPRET); break; + case T_GT: Value_gt(value,&x,pass==INTERPRET); break; + case T_NE: Value_ne(value,&x,pass==INTERPRET); break; + case T_PLUS: Value_add(value,&x,pass==INTERPRET); break; + case T_MINUS: Value_sub(value,&x,pass==INTERPRET); break; + case T_MULT: Value_mult(value,&x,pass==INTERPRET); break; + case T_DIV: Value_div(value,&x,pass==INTERPRET); break; + case T_IDIV: Value_idiv(value,&x,pass==INTERPRET); break; + case T_MOD: Value_mod(value,&x,pass==INTERPRET); break; + case T_POW: Value_pow(value,&x,pass==INTERPRET); break; + case T_AND: Value_and(value,&x,pass==INTERPRET); break; + case T_OR: Value_or(value,&x,pass==INTERPRET); break; + case T_XOR: Value_xor(value,&x,pass==INTERPRET); break; + case T_EQV: Value_eqv(value,&x,pass==INTERPRET); break; + case T_IMP: Value_imp(value,&x,pass==INTERPRET); break; + default: assert(0); + } + Value_destroy(&x); + } while (value->type!=V_ERROR); + if (value->type==V_ERROR) pc=oppc; + return value; +} +/*}}}*/ +static inline struct Value *unarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/ +{ + enum TokenType op; + struct Pc oppc; + + op=pc.token->type; + if (!TOKEN_ISUNARYOPERATOR(op) || TOKEN_UNARYPRIORITY(op)!=prio) return level(value); + oppc=pc; + ++pc.token; + if (unarydown(value,level,prio)==(struct Value*)0) return Value_new_ERROR(value,MISSINGEXPR,_("unary operand")); + if (value->type==V_ERROR) return value; + switch (op) + { + case T_PLUS: Value_uplus(value,pass==INTERPRET); break; + case T_MINUS: Value_uneg(value,pass==INTERPRET); break; + case T_NOT: Value_unot(value,pass==INTERPRET); break; + default: assert(0); + } + if (value->type==V_ERROR) pc=oppc; + return value; +} +/*}}}*/ +static struct Value *eval8(struct Value *value) /*{{{*/ +{ + switch (pc.token->type) + { + case T_IDENTIFIER: /*{{{*/ + { + struct Pc var; + struct Value *l; + + var=pc; + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + assert(pass==DECLARE || pc.token->u.identifier->sym); + if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR)) + { + if ((l=lvalue(value))->type==V_ERROR) return value; + Value_clone(value,l); + } + else + { + func(value); + if (value->type==V_VOID) + { + Value_destroy(value); + pc=var; + return Value_new_ERROR(value,VOIDVALUE); + } + } + break; + } + /*}}}*/ + case T_INTEGER: /*{{{*/ + { + VALUE_NEW_INTEGER(value,pc.token->u.integer); + ++pc.token; + break; + } + /*}}}*/ + case T_REAL: /*{{{*/ + { + VALUE_NEW_REAL(value,pc.token->u.real); + ++pc.token; + break; + } + /*}}}*/ + case T_STRING: /*{{{*/ + { + Value_new_STRING(value); + String_destroy(&value->u.string); + String_clone(&value->u.string,pc.token->u.string); + ++pc.token; + break; + } + /*}}}*/ + case T_HEXINTEGER: /*{{{*/ + { + VALUE_NEW_INTEGER(value,pc.token->u.hexinteger); + ++pc.token; + break; + } + /*}}}*/ + case T_OCTINTEGER: /*{{{*/ + { + VALUE_NEW_INTEGER(value,pc.token->u.octinteger); + ++pc.token; + break; + } + /*}}}*/ + case T_OP: /*{{{*/ + { + ++pc.token; + if (eval(value,_("parenthetic"))->type==V_ERROR) return value; + if (pc.token->type!=T_CP) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGCP); + } + ++pc.token; + break; + } + /*}}}*/ + default: /*{{{*/ + { + return (struct Value *)0; + } + /*}}}*/ + } + return value; +} +/*}}}*/ +static struct Value *eval7(struct Value *value) /*{{{*/ +{ + return binarydown(value,eval8,7); +} +/*}}}*/ +static struct Value *eval6(struct Value *value) /*{{{*/ +{ + return unarydown(value,eval7,6); +} +/*}}}*/ +static struct Value *eval5(struct Value *value) /*{{{*/ +{ + return binarydown(value,eval6,5); +} +/*}}}*/ +static struct Value *eval4(struct Value *value) /*{{{*/ +{ + return binarydown(value,eval5,4); +} +/*}}}*/ +static struct Value *eval3(struct Value *value) /*{{{*/ +{ + return binarydown(value,eval4,3); +} +/*}}}*/ +static struct Value *eval2(struct Value *value) /*{{{*/ +{ + return unarydown(value,eval3,2); +} +/*}}}*/ +static struct Value *eval1(struct Value *value) /*{{{*/ +{ + return binarydown(value,eval2,1); +} +/*}}}*/ +static struct Value *eval(struct Value *value, const char *desc) /*{{{*/ +{ + /* avoid function calls for atomic expression */ + switch (pc.token->type) + { + case T_STRING: + case T_REAL: + case T_INTEGER: + case T_HEXINTEGER: + case T_OCTINTEGER: + case T_IDENTIFIER: if (!TOKEN_ISBINARYOPERATOR((pc.token+1)->type) && (pc.token+1)->type!=T_OP) return eval7(value); + default: break; + } + if (binarydown(value,eval1,0)==(struct Value*)0) + { + if (desc) return Value_new_ERROR(value,MISSINGEXPR,desc); + else return (struct Value*)0; + } + else return value; +} +/*}}}*/ +#endif + +static void new(void) /*{{{*/ +{ + Global_destroy(&globals); + Global_new(&globals); + Auto_destroy(&stack); + Auto_new(&stack); + Program_destroy(&program); + Program_new(&program); + FS_closefiles(); + optionbase=0; +} +/*}}}*/ +static void pushLabel(enum LabelType type, struct Pc *patch) /*{{{*/ +{ + if (labelStackPointer==labelStackCapacity) + { + struct LabelStack *more; + + more=realloc(labelStack,sizeof(struct LabelStack)*(labelStackCapacity?(labelStackCapacity*=2):(32))); + labelStack=more; + } + labelStack[labelStackPointer].type=type; + labelStack[labelStackPointer].patch=*patch; + ++labelStackPointer; +} +/*}}}*/ +static struct Pc *popLabel(enum LabelType type) /*{{{*/ +{ + if (labelStackPointer==0 || labelStack[labelStackPointer-1].type!=type) return (struct Pc*)0; + else return &labelStack[--labelStackPointer].patch; +} +/*}}}*/ +static struct Pc *findLabel(enum LabelType type) /*{{{*/ +{ + int i; + + for (i=labelStackPointer-1; i>=0; --i) if (labelStack[i].type==type) return &labelStack[i].patch; + return (struct Pc*)0; +} +/*}}}*/ +static void labelStackError(struct Value *v) /*{{{*/ +{ + assert(labelStackPointer); + pc=labelStack[labelStackPointer-1].patch; + switch (labelStack[labelStackPointer-1].type) + { + case L_IF: Value_new_ERROR(v,STRAYIF); break; + case L_DO: Value_new_ERROR(v,STRAYDO); break; + case L_DOcondition: Value_new_ERROR(v,STRAYDOcondition); break; + case L_ELSE: Value_new_ERROR(v,STRAYELSE2); break; + case L_FOR_BODY: + { + Value_new_ERROR(v,STRAYFOR); + pc=*findLabel(L_FOR); + break; + } + case L_WHILE: Value_new_ERROR(v,STRAYWHILE); break; + case L_REPEAT: Value_new_ERROR(v,STRAYREPEAT); break; + case L_SELECTCASE: Value_new_ERROR(v,STRAYSELECTCASE); break; + case L_FUNC: Value_new_ERROR(v,STRAYFUNC); break; + default: assert(0); + } +} +/*}}}*/ +static const char *topLabelDescription(void) /*{{{*/ +{ + if (labelStackPointer==0) + { + return _("program"); + } + switch (labelStack[labelStackPointer-1].type) + { + case L_IF: return _("`if' branch"); + case L_DO: return _("`do' loop"); + case L_DOcondition: return _("`do while' or `do until' loop"); + case L_ELSE: return _("`else' branch"); + case L_FOR_BODY: return _("`for' loop"); + case L_WHILE: return _("`while' loop"); + case L_REPEAT: return _("`repeat' loop"); + case L_SELECTCASE: return _("`select case' control structure"); + case L_FUNC: return _("function or procedure"); + default: assert(0); + } + /* NOTREACHED */ + return (const char*)0; +} +/*}}}*/ +static struct Value *assign(struct Value *value) /*{{{*/ +{ + struct Pc expr; + + if (strcasecmp(pc.token->u.identifier->name,"mid$")==0) /* mid$(a$,n,m)=b$ */ /*{{{*/ + { + long int n,m; + struct Value *l; + + ++pc.token; + if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP); + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSTRIDENT); + if (pass==DECLARE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0 + ) + { + return Value_new_ERROR(value,REDECLARATION); + } + } + if ((l=lvalue(value))->type==V_ERROR) return value; + if (pass==COMPILE && l->type!=V_STRING) return Value_new_ERROR(value,TYPEMISMATCH4); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + if (eval(value,_("position"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + n=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && n<1) return Value_new_ERROR(value,OUTOFRANGE,"position"); + if (pc.token->type==T_COMMA) + { + ++pc.token; + if (eval(value,_("length"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + m=value->u.integer; + if (pass==INTERPRET && m<0) return Value_new_ERROR(value,OUTOFRANGE,_("length")); + Value_destroy(value); + } + else m=-1; + if (pc.token->type!=T_CP) return Value_new_ERROR(value,MISSINGCP); + ++pc.token; + if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ); + ++pc.token; + if (eval(value,_("rhs"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pass==INTERPRET) + { + if (m==-1) m=value->u.string.length; + String_set(&l->u.string,n-1,&value->u.string,m); + } + } + /*}}}*/ + else /*{{{*/ + { + struct Value **l=(struct Value**)0; + int i, used=0, capacity=0; + struct Value retyped_value; + + for (;;) + { + if (used==capacity) + { + struct Value **more; + + capacity=capacity?2*capacity:2; + more=realloc(l,capacity*sizeof(*l)); + l=more; + } + + if (pass==DECLARE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0 + ) + { + if (capacity) free(l); + return Value_new_ERROR(value,REDECLARATION); + } + } + if ((l[used]=lvalue(value))->type==V_ERROR) return value; + ++used; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ); + ++pc.token; + expr=pc; + if (eval(value,_("rhs"))->type==V_ERROR) return value; + for (i=0; i<used; ++i) + { + Value_clone(&retyped_value,value); + if (pass!=DECLARE && VALUE_RETYPE(&retyped_value,(l[i])->type)->type==V_ERROR) + { + pc=expr; + free(l); + Value_destroy(value); + *value=retyped_value; + return value; + } + if (pass==INTERPRET) + { + Value_destroy(l[i]); + *(l[i])=retyped_value; + } + } + free(l); + Value_destroy(value); + *value=retyped_value; /* for status only */ + } + /*}}}*/ + return value; +} +/*}}}*/ +static struct Value *compileProgram(struct Value *v, int clearGlobals) /*{{{*/ +{ + struct Pc begin; + + stack.resumeable=0; + if (clearGlobals) + { + Global_destroy(&globals); + Global_new(&globals); + } + else Global_clearFunctions(&globals); + if (Program_beginning(&program,&begin)) + { + struct Pc savepc; + int savepass; + + savepc=pc; + savepass=pass; + Program_norun(&program); + for (pass=DECLARE; pass!=INTERPRET; ++pass) + { + if (pass==DECLARE) + { + stack.begindata.line=-1; + lastdata=&stack.begindata; + } + optionbase=0; + FS_intr=0; + stopped=0; + program.runnable=1; + pc=begin; + while (1) + { + statements(v); + if (v->type==V_ERROR) break; + Value_destroy(v); + if (!Program_skipEOL(&program,&pc,0,0)) { Value_new_NIL(v); break; } + } + if (v->type!=V_ERROR && labelStackPointer>0) + { + Value_destroy(v); + labelStackError(v); + } + if (v->type==V_ERROR) + { + labelStackPointer=0; + Program_norun(&program); + if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */ + pass=savepass; + return v; + } + } + pc=begin; + if (Program_analyse(&program,&pc,v)) + { + labelStackPointer=0; + Program_norun(&program); + if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */ + pass=savepass; + return v; + } + curdata=stack.begindata; + pc=savepc; + pass=savepass; + } + return Value_new_NIL(v); +} +/*}}}*/ +static void runline(struct Token *line) /*{{{*/ +{ + struct Value value; + + FS_flush(STDCHANNEL); + for (pass=DECLARE; pass!=INTERPRET; ++pass) + { + curdata.line=-1; + pc.line=-1; + pc.token=line; + optionbase=0; + FS_intr=0; + stopped=0; + statements(&value); + if (value.type!=V_ERROR && pc.token->type!=T_EOL) + { + Value_destroy(&value); + Value_new_ERROR(&value,SYNTAX); + } + if (value.type!=V_ERROR && labelStackPointer>0) + { + Value_destroy(&value); + labelStackError(&value); + } + if (value.type==V_ERROR) + { + struct String s; + + Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value); + Program_PCtoError(&program,&pc,&value); + labelStackPointer=0; + FS_putChars(STDCHANNEL,_("Error: ")); + String_new(&s); + Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0); + Value_destroy(&value); + FS_putString(STDCHANNEL,&s); + String_destroy(&s); + return; + } + if (!program.runnable && pass==COMPILE) + { + Value_destroy(&value); + (void)compileProgram(&value,0); + } + } + + pc.line=-1; + pc.token=line; + optionbase=0; + curdata=stack.begindata; + nextdata.line=-1; + Value_destroy(&value); + pass=INTERPRET; + FS_allowIntr(1); + do + { + assert(pass==INTERPRET); + statements(&value); + assert(pass==INTERPRET); + if (value.type==V_ERROR) + { + if (strchr(value.u.error.msg,'\n')==(char*)0) + { + Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value); + Program_PCtoError(&program,&pc,&value); + } + if (stack.onerror.line!=-1) + { + stack.resumeable=1; + pc=stack.onerror; + } + else + { + struct String s; + + String_new(&s); + if (!stopped) + { + stopped=0; + FS_putChars(STDCHANNEL,_("Error: ")); + } + Auto_frameToError(&stack,&program,&value); + Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0); + while (Auto_gosubReturn(&stack,(struct Pc*)0)); + FS_putString(STDCHANNEL,&s); + String_destroy(&s); + Value_destroy(&value); + break; + } + } + Value_destroy(&value); + } while (pc.token->type!=T_EOL || Program_skipEOL(&program,&pc,STDCHANNEL,1)); + FS_allowIntr(0); +} +/*}}}*/ +static struct Value *evalGeometry(struct Value *value, unsigned int *dim, unsigned int geometry[]) /*{{{*/ +{ + struct Pc exprpc=pc; + + if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + if (pass==INTERPRET && value->u.integer<optionbase) + { + Value_destroy(value); + pc=exprpc; + return Value_new_ERROR(value,OUTOFRANGE,_("dimension")); + } + geometry[0]=value->u.integer-optionbase+1; + Value_destroy(value); + if (pc.token->type==T_COMMA) + { + ++pc.token; + exprpc=pc; + if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + if (pass==INTERPRET && value->u.integer<optionbase) + { + Value_destroy(value); + pc=exprpc; + return Value_new_ERROR(value,OUTOFRANGE,_("dimension")); + } + geometry[1]=value->u.integer-optionbase+1; + Value_destroy(value); + *dim=2; + } + else *dim=1; + if (pc.token->type==T_CP) ++pc.token; + else return Value_new_ERROR(value,MISSINGCP); + return (struct Value*)0; +} +/*}}}*/ +static struct Value *convert(struct Value *value, struct Value *l, struct Token *t) /*{{{*/ +{ + switch (l->type) + { + case V_INTEGER: + { + char *datainput; + char *end; + long int v; + int overflow; + + if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("integer")); + datainput=t->u.datainput; + v=Value_vali(datainput,&end,&overflow); + if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("integer")); + if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value")); + Value_destroy(l); + VALUE_NEW_INTEGER(l,v); + break; + } + case V_REAL: + { + char *datainput; + char *end; + double v; + int overflow; + + if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("real")); + datainput=t->u.datainput; + v=Value_vald(datainput,&end,&overflow); + if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("real")); + if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value")); + Value_destroy(l); + VALUE_NEW_REAL(l,v); + break; + } + case V_STRING: + { + Value_destroy(l); + Value_new_STRING(l); + if (t->type==T_STRING) String_appendString(&l->u.string,t->u.string); + else String_appendChars(&l->u.string,t->u.datainput); + break; + } + default: assert(0); + } + return (struct Value*)0; +} +/*}}}*/ +static struct Value *dataread(struct Value *value, struct Value *l) /*{{{*/ +{ + if (curdata.line==-1) + { + return Value_new_ERROR(value,ENDOFDATA); + } + if (curdata.token->type==T_DATA) + { + nextdata=curdata.token->u.nextdata; + ++curdata.token; + } + if (convert(value,l,curdata.token)) + { + return value; + } + ++curdata.token; + if (curdata.token->type==T_COMMA) ++curdata.token; + else curdata=nextdata; + return (struct Value*)0; +} +/*}}}*/ +static struct Value more_statements; +#include "statement.c" +static struct Value *statements(struct Value *value) /*{{{*/ +{ + more: + if (pc.token->statement) + { + struct Value *v; + + if ((v=pc.token->statement(value))) + { + if (v==&more_statements) goto more; + else return value; + } + } + else return Value_new_ERROR(value,MISSINGSTATEMENT); + + if (FS_intr) + { + stopped=1; + return Value_new_ERROR(value,BREAK); + } + else if (pc.token->type==T_COLON && (pc.token+1)->type==T_ELSE) ++pc.token; + else if ((pc.token->type==T_COLON && (pc.token+1)->type!=T_ELSE) || pc.token->type==T_QUOTE) + { + ++pc.token; + goto more; + } + else if ((pass==DECLARE || pass==COMPILE) && pc.token->type!=T_EOL && pc.token->type!=T_ELSE) + { + return Value_new_ERROR(value,MISSINGCOLON); + } + return Value_new_NIL(value); +} +/*}}}*/ + +void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd) /*{{{*/ +{ +#ifdef HAVE_GETTEXT + bindtextdomain("bas",LOCALEDIR); + textdomain("bas"); +#endif + stack.begindata.line=-1; + Token_init(backslash_colon,uppercase); + Global_new(&globals); + Auto_new(&stack); + Program_new(&program); + FS_opendev(STDCHANNEL,0,1); + FS_opendev(LPCHANNEL,-1,lpfd); + run_restricted=restricted; +} +/*}}}*/ +void bas_runFile(const char *runFile) /*{{{*/ +{ + struct Value value; + int dev; + + new(); + if ((dev=FS_openin(runFile))==-1) + { + const char *errmsg=FS_errmsg; + + FS_putChars(0,_("bas: Executing `")); + FS_putChars(0,runFile); + FS_putChars(0,_("' failed (")); + FS_putChars(0,errmsg); + FS_putChars(0,_(").\n")); + } + else if (Program_merge(&program,dev,&value)) + { + struct String s; + + FS_putChars(0,"bas: "); + String_new(&s); + Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0); + FS_putString(0,&s); + String_destroy(&s); + FS_putChar(0,'\n'); + Value_destroy(&value); + } + else + { + struct Token line[2]; + + Program_setname(&program,runFile); + line[0].type=T_RUN; + line[0].statement=stmt_RUN; + line[1].type=T_EOL; + line[1].statement=stmt_COLON_EOL; + + FS_close(dev); + runline(line); + } +} +/*}}}*/ +void bas_runLine(const char *runLine) /*{{{*/ +{ + struct Token *line; + + line=Token_newCode(runLine); + runline(line+1); + Token_destroy(line); +} +/*}}}*/ +void bas_interpreter(void) /*{{{*/ +{ + if (FS_istty(STDCHANNEL)) + { + //FS_putChars(STDCHANNEL,"bas " VERSION "\n"); //acassis: fix it + FS_putChars(STDCHANNEL,"Copyright 1999-2014 Michael Haardt.\n"); + FS_putChars(STDCHANNEL,_("This is free software with ABSOLUTELY NO WARRANTY.\n")); + } + new(); + while (1) + { + struct Token *line; + struct String s; + + FS_intr=0; stopped=0; + FS_allowIntr(1); + FS_nextline(STDCHANNEL); + if (FS_istty(STDCHANNEL)) FS_putChars(STDCHANNEL,"> "); + FS_flush(STDCHANNEL); + String_new(&s); + if (FS_appendToString(STDCHANNEL,&s,1)==-1) + { + if (FS_intr) + { + FS_putChars(STDCHANNEL,_("\nBreak\n")); + FS_flush(STDCHANNEL); + String_destroy(&s); + continue; + } + else + { + FS_putChars(STDCHANNEL,FS_errmsg); + FS_flush(STDCHANNEL); + String_destroy(&s); + break; + } + } + if (s.length==0) + { + String_destroy(&s); + break; + } + line=Token_newCode(s.character); + String_destroy(&s); + if (line->type!=T_EOL) + { + if (line->type==T_INTEGER && line->u.integer>0) + { + if (program.numbered) + { + if ((line+1)->type==T_EOL) + { + struct Pc where; + + if (Program_goLine(&program,line->u.integer,&where)==(struct Pc*)0) FS_putChars(STDCHANNEL,(NOSUCHLINE)); + else Program_delete(&program,&where,&where); + Token_destroy(line); + } + else Program_store(&program,line,line->u.integer); + } + else + { + FS_putChars(STDCHANNEL,_("Use `renum' to number program first")); + Token_destroy(line); + } + } + else if (line->type==T_UNNUMBERED) + { + runline(line+1); + Token_destroy(line); + if (FS_istty(STDCHANNEL) && bas_end>0) + { + FS_putChars(STDCHANNEL,_("END program\n")); + bas_end=0; + } + } + else + { + FS_putChars(STDCHANNEL,_("Invalid line\n")); + Token_destroy(line); + } + } + else Token_destroy(line); + } + FS_allowIntr(0); +} +/*}}}*/ +void bas_exit(void) /*{{{*/ +{ + Auto_destroy(&stack); + Global_destroy(&globals); + Program_destroy(&program); + if (labelStack) free(labelStack); + FS_closefiles(); + FS_close(LPCHANNEL); + FS_close(STDCHANNEL); +} +/*}}}*/ diff --git a/apps/interpreters/bas/bas.h b/apps/interpreters/bas/bas.h new file mode 100644 index 000000000..f54bfbb22 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/bas.pot b/apps/interpreters/bas/bas.pot new file mode 100644 index 000000000..0bb0e33c4 --- /dev/null +++ b/apps/interpreters/bas/bas.pot @@ -0,0 +1,1103 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR. +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2014-10-25 20:16+0200\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" +"Language-Team: LANGUAGE <LL@li.org>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=CHARSET\n" +"Content-Transfer-Encoding: 8bit\n" + +#: auto.c:145 +msgid "Called" +msgstr "" + +#: auto.c:155 +msgid "Proc Called" +msgstr "" + +#: bas.c:181 +msgid "index" +msgstr "" + +#: bas.c:277 +msgid "actual parameter" +msgstr "" + +#: bas.c:651 +msgid "operand" +msgstr "" + +#: bas.c:847 +msgid "binary operand" +msgstr "" + +#: bas.c:898 +msgid "unary operand" +msgstr "" + +#: bas.c:988 +msgid "parenthetic" +msgstr "" + +#: bas.c:1133 +msgid "program" +msgstr "" + +#: bas.c:1137 +msgid "`if' branch" +msgstr "" + +#: bas.c:1138 +msgid "`do' loop" +msgstr "" + +#: bas.c:1139 +msgid "`do while' or `do until' loop" +msgstr "" + +#: bas.c:1140 +msgid "`else' branch" +msgstr "" + +#: bas.c:1141 +msgid "`for' loop" +msgstr "" + +#: bas.c:1142 +msgid "`while' loop" +msgstr "" + +#: bas.c:1143 +msgid "`repeat' loop" +msgstr "" + +#: bas.c:1144 +msgid "`select case' control structure" +msgstr "" + +#: bas.c:1145 +msgid "function or procedure" +msgstr "" + +#: bas.c:1180 global.c:179 global.c:208 global.c:955 +msgid "position" +msgstr "" + +#: bas.c:1187 bas.c:1189 global.c:180 global.c:196 global.c:209 global.c:242 +#: global.c:841 global.c:863 global.c:886 global.c:1048 global.c:1071 +#: global.c:1185 global.c:1240 global.c:1289 global.c:1299 global.c:1318 +msgid "length" +msgstr "" + +#: bas.c:1197 bas.c:1242 statement.c:1671 +msgid "rhs" +msgstr "" + +#: bas.c:1367 bas.c:1415 +msgid "Error: " +msgstr "" + +#: bas.c:1435 bas.c:1440 bas.c:1448 bas.c:1453 statement.c:503 statement.c:511 +msgid "dimension" +msgstr "" + +#: bas.c:1476 bas.c:1479 statement.c:413 value.c:56 +msgid "integer" +msgstr "" + +#: bas.c:1480 bas.c:1496 +msgid "converted value" +msgstr "" + +#: bas.c:1492 bas.c:1495 statement.c:414 value.c:57 +msgid "real" +msgstr "" + +#: bas.c:1597 +msgid "bas: Executing `" +msgstr "" + +#: bas.c:1599 +msgid "' failed (" +msgstr "" + +#: bas.c:1601 +msgid ").\n" +msgstr "" + +#: bas.c:1645 +msgid "This is free software with ABSOLUTELY NO WARRANTY.\n" +msgstr "" + +#: bas.c:1663 +msgid "" +"\n" +"Break\n" +msgstr "" + +#: bas.c:1701 error.h:95 +msgid "Use `renum' to number program first" +msgstr "" + +#: bas.c:1711 +msgid "END program\n" +msgstr "" + +#: bas.c:1717 +msgid "Invalid line\n" +msgstr "" + +#: error.h:15 +msgid "Formal parameter already declared" +msgstr "" + +#: error.h:16 +msgid "Variable already declared as `local'" +msgstr "" + +#: error.h:17 +#, c-format +msgid "Identifier can not be declared as %s" +msgstr "" + +#: error.h:18 +msgid "Ranges must be constructed from single letter identifiers" +msgstr "" + +#: error.h:19 +#, c-format +msgid "Missing line number at the beginning of text line %d" +msgstr "" + +#: error.h:20 +msgid "Invalid unary operand" +msgstr "" + +#: error.h:21 +msgid "Invalid binary operand" +msgstr "" + +#: error.h:22 +msgid "Missing `as'" +msgstr "" + +#: error.h:23 +msgid "Missing colon `:'" +msgstr "" + +#: error.h:24 +msgid "Missing comma `,'" +msgstr "" + +#: error.h:25 +msgid "Missing right parenthesis `)'" +msgstr "" + +#: error.h:26 +msgid "Missing `data' input" +msgstr "" + +#: error.h:27 +msgid "Missing `dec'/`inc' variable identifier" +msgstr "" + +#: error.h:28 +msgid "Missing equal sign `='" +msgstr "" + +#: error.h:29 +#, c-format +msgid "Expected %s expression" +msgstr "" + +#: error.h:30 +msgid "Missing `file'" +msgstr "" + +#: error.h:31 +msgid "Missing `goto' or `gosub'" +msgstr "" + +#: error.h:32 +msgid "Missing variable identifier" +msgstr "" + +#: error.h:33 +msgid "Missing procedure identifier" +msgstr "" + +#: error.h:34 +msgid "Missing function identifier" +msgstr "" + +#: error.h:35 +msgid "Missing array variable identifier" +msgstr "" + +#: error.h:36 +msgid "Missing string variable identifier" +msgstr "" + +#: error.h:37 +msgid "Missing loop variable identifier" +msgstr "" + +#: error.h:38 +msgid "Missing formal parameter identifier" +msgstr "" + +#: error.h:39 +msgid "Missing `read' variable identifier" +msgstr "" + +#: error.h:40 +msgid "Missing `swap' variable identifier" +msgstr "" + +#: error.h:41 +msgid "Missing matrix variable identifier" +msgstr "" + +#: error.h:42 +msgid "Missing line increment" +msgstr "" + +#: error.h:43 +msgid "Missing `len'" +msgstr "" + +#: error.h:44 +msgid "Missing line number" +msgstr "" + +#: error.h:45 +msgid "Missing left parenthesis `('" +msgstr "" + +#: error.h:46 +msgid "Missing semicolon `;'" +msgstr "" + +#: error.h:47 +msgid "Missing semicolon `;' or comma `,'" +msgstr "" + +#: error.h:48 +msgid "Missing star `*'" +msgstr "" + +#: error.h:49 +msgid "Missing statement" +msgstr "" + +#: error.h:50 +msgid "Missing `then'" +msgstr "" + +#: error.h:51 +msgid "Missing `to'" +msgstr "" + +#: error.h:52 +msgid "Nested definition" +msgstr "" + +#: error.h:53 +msgid "No program" +msgstr "" + +#: error.h:54 +msgid "No such `data' line" +msgstr "" + +#: error.h:55 +msgid "No such line" +msgstr "" + +#: error.h:56 +msgid "Redeclaration as different kind of symbol" +msgstr "" + +#: error.h:57 +msgid "`case' without `select case'" +msgstr "" + +#: error.h:58 +msgid "`do' without `loop'" +msgstr "" + +#: error.h:59 +msgid "`do while' or `do until' without `loop'" +msgstr "" + +#: error.h:60 +msgid "`else' without `if'" +msgstr "" + +#: error.h:61 +msgid "`else' without `end if'" +msgstr "" + +#: error.h:62 +msgid "`end if' without multiline `if' or `else'" +msgstr "" + +#: error.h:63 +#, c-format +msgid "`subend', `end sub' or `endproc' without `sub' or `def proc' inside %s" +msgstr "" + +#: error.h:64 +#, c-format +msgid "`subexit' without `sub' inside %s" +msgstr "" + +#: error.h:65 +msgid "`end select' without `select case'" +msgstr "" + +#: error.h:66 +msgid "`end function' without `def fn' or `function'" +msgstr "" + +#: error.h:67 +msgid "`=' returning from function without `def fn'" +msgstr "" + +#: error.h:68 +msgid "`exit do' without `do'" +msgstr "" + +#: error.h:69 +msgid "`exit for' without `for'" +msgstr "" + +#: error.h:70 +msgid "`fnend' without `def fn'" +msgstr "" + +#: error.h:71 +msgid "`exit function' outside function declaration" +msgstr "" + +#: error.h:72 +msgid "`fnreturn' without `def fn'" +msgstr "" + +#: error.h:73 +msgid "`for' without `next'" +msgstr "" + +#: error.h:74 +msgid "Function/procedure declaration without end" +msgstr "" + +#: error.h:75 +msgid "`if' without `end if'" +msgstr "" + +#: error.h:76 +msgid "`local' without `def fn' or `def proc'" +msgstr "" + +#: error.h:77 +msgid "`loop' without `do'" +msgstr "" + +#: error.h:78 +msgid "`loop until' without `do'" +msgstr "" + +#: error.h:79 +#, c-format +msgid "`next' without `for' inside %s" +msgstr "" + +#: error.h:80 +msgid "`repeat' without `until'" +msgstr "" + +#: error.h:81 +msgid "`select case' without `end select'" +msgstr "" + +#: error.h:82 +msgid "`until' without `repeat'" +msgstr "" + +#: error.h:83 +#, c-format +msgid "`wend' without `while' inside %s" +msgstr "" + +#: error.h:84 +msgid "`while' without `wend'" +msgstr "" + +#: error.h:85 +msgid "Syntax" +msgstr "" + +#: error.h:86 +msgid "Too few parameters" +msgstr "" + +#: error.h:87 +msgid "Too many parameters" +msgstr "" + +#: error.h:88 +#, c-format +msgid "Type mismatch (has %s, need %s)" +msgstr "" + +#: error.h:89 +#, c-format +msgid "Type mismatch of argument %d" +msgstr "" + +#: error.h:90 +#, c-format +msgid "%s of argument %d" +msgstr "" + +#: error.h:91 +msgid "Type mismatch (need string variable)" +msgstr "" + +#: error.h:92 +msgid "Type mismatch (need numeric variable)" +msgstr "" + +#: error.h:93 +msgid "Type mismatch (need numeric value)" +msgstr "" + +#: error.h:94 +msgid "Undeclared function or variable" +msgstr "" + +#: error.h:96 +msgid "Line out of scope" +msgstr "" + +#: error.h:97 +msgid "Procedures do not return values" +msgstr "" + +#: error.h:98 +msgid "Unreachable statement" +msgstr "" + +#: error.h:99 +msgid "Wrong access mode" +msgstr "" + +#: error.h:100 +msgid "`next' variable does not match `for' variable" +msgstr "" + +#: error.h:101 +msgid "No such `image' line" +msgstr "" + +#: error.h:102 +msgid "Missing `image' format" +msgstr "" + +#: error.h:103 +msgid "Missing relational operator" +msgstr "" + +#: error.h:107 +msgid "Missing `input' data" +msgstr "" + +#: error.h:108 +msgid "Missing character after underscore `_' in format string" +msgstr "" + +#: error.h:109 +msgid "Not allowed in interactive mode" +msgstr "" + +#: error.h:110 +msgid "Not allowed in program mode" +msgstr "" + +#: error.h:111 +msgid "Break" +msgstr "" + +#: error.h:112 +#, c-format +msgid "%s is undefined" +msgstr "" + +#: error.h:113 +#, c-format +msgid "%s is out of range" +msgstr "" + +#: error.h:114 +msgid "`resume' without exception" +msgstr "" + +#: error.h:115 +msgid "`return' without `gosub'" +msgstr "" + +#: error.h:116 +#, c-format +msgid "Bad %s conversion" +msgstr "" + +#: error.h:117 +#, c-format +msgid "Input/Output error (%s)" +msgstr "" + +#: error.h:118 +#, c-format +msgid "Input/Output error (Creating `%s' failed: %s)" +msgstr "" + +#: error.h:119 +#, c-format +msgid "Input/Output error (Closing `%s' failed: %s)" +msgstr "" + +#: error.h:120 +#, c-format +msgid "Input/Output error (Opening `%s' failed: %s)" +msgstr "" + +#: error.h:121 +#, c-format +msgid "Setting environment variable failed (%s)" +msgstr "" + +#: error.h:122 +msgid "Trying to redimension existing array" +msgstr "" + +#: error.h:123 +#, c-format +msgid "Forking child process failed (%s)" +msgstr "" + +#: error.h:124 +msgid "Invalid mode" +msgstr "" + +#: error.h:125 +msgid "end of `data'" +msgstr "" + +#: error.h:126 +msgid "Dimension mismatch" +msgstr "" + +#: error.h:127 +#, c-format +msgid "Variable dimension must be 2 (is %d), base must be 0 or 1 (is %d)" +msgstr "" + +#: error.h:128 +msgid "Singular matrix" +msgstr "" + +#: error.h:129 +msgid "Syntax error in print format" +msgstr "" + +#: error.h:130 +msgid "Out of memory" +msgstr "" + +#: error.h:131 +msgid "Restricted" +msgstr "" + +#: fs.c:80 +#, c-format +msgid "channel #%d not open" +msgstr "" + +#: fs.c:90 +#, c-format +msgid "channel #%d not opened for writing" +msgstr "" + +#: fs.c:96 +#, c-format +msgid "channel #%d not opened for reading" +msgstr "" + +#: fs.c:102 +#, c-format +msgid "channel #%d not opened for random access" +msgstr "" + +#: fs.c:108 +#, c-format +msgid "channel #%d not opened for binary access" +msgstr "" + +#: fs.c:114 +#, c-format +msgid "channel #%d not opened for random or binary access" +msgstr "" + +#: fs.c:241 +msgid "environment variable TERM is not set" +msgstr "" + +#: fs.c:248 +msgid "reading terminal description failed" +msgstr "" + +#: fs.c:253 +#, c-format +msgid "unknown terminal type %s" +msgstr "" + +#: fs.c:281 +#, c-format +msgid "terminal type %s can not clear the screen" +msgstr "" + +#: fs.c:294 +#, c-format +msgid "terminal type %s can not position the cursor" +msgstr "" + +#: fs.c:356 fs.c:362 fs.c:368 +msgid "This installation does not support terminal handling" +msgstr "" + +#: fs.c:396 fs.c:477 fs.c:550 fs.c:599 fs.c:632 +msgid "channel already open" +msgstr "" + +#: fs.c:669 fs.c:692 fs.c:736 fs.c:768 fs.c:1338 +msgid "channel not open" +msgstr "" + +#: fs.c:924 fs.c:940 fs.c:956 +msgid "End of file" +msgstr "" + +#: fs.c:1010 +msgid "negative width" +msgstr "" + +#: fs.c:1022 +msgid "non-positive zone width" +msgstr "" + +#: fs.c:1037 fs.c:1054 fs.c:1071 +msgid "not a terminal" +msgstr "" + +#: fs.c:1400 fs.c:1412 +msgid "Direct port access not available" +msgstr "" + +#: fs.c:1406 fs.c:1418 +msgid "Direct memory access not available" +msgstr "" + +#: getopt.c:681 +#, c-format +msgid "%s: option `%s' is ambiguous\n" +msgstr "" + +#: getopt.c:705 +#, c-format +msgid "%s: option `--%s' doesn't allow an argument\n" +msgstr "" + +#: getopt.c:710 +#, c-format +msgid "%s: option `%c%s' doesn't allow an argument\n" +msgstr "" + +#: getopt.c:727 getopt.c:900 +#, c-format +msgid "%s: option `%s' requires an argument\n" +msgstr "" + +#. --option +#: getopt.c:756 +#, c-format +msgid "%s: unrecognized option `--%s'\n" +msgstr "" + +#. +option or -option +#: getopt.c:760 +#, c-format +msgid "%s: unrecognized option `%c%s'\n" +msgstr "" + +#. 1003.2 specifies the format of this message. +#: getopt.c:786 +#, c-format +msgid "%s: illegal option -- %c\n" +msgstr "" + +#: getopt.c:789 +#, c-format +msgid "%s: invalid option -- %c\n" +msgstr "" + +#. 1003.2 specifies the format of this message. +#: getopt.c:819 getopt.c:949 +#, c-format +msgid "%s: option requires an argument -- %c\n" +msgstr "" + +#: getopt.c:866 +#, c-format +msgid "%s: option `-W %s' is ambiguous\n" +msgstr "" + +#: getopt.c:884 +#, c-format +msgid "%s: option `-W %s' doesn't allow an argument\n" +msgstr "" + +#: global.c:197 +msgid "code" +msgstr "" + +#: global.c:258 +msgid "variable number" +msgstr "" + +#: global.c:283 +msgid "`asc' or `code' of empty string" +msgstr "" + +#: global.c:303 global.c:318 global.c:338 global.c:424 global.c:434 +#: global.c:552 global.c:614 global.c:652 global.c:670 global.c:690 +#: global.c:707 +msgid "number" +msgstr "" + +#: global.c:328 global.c:340 global.c:680 global.c:692 +msgid "digits" +msgstr "" + +#: global.c:348 global.c:1279 global.c:1301 +msgid "character code" +msgstr "" + +#: global.c:383 global.c:399 +msgid "argument number" +msgstr "" + +#: global.c:748 global.c:778 +msgid "time" +msgstr "" + +#: global.c:763 global.c:780 statement.c:179 statement.c:1036 statement.c:1208 +#: statement.c:1387 statement.c:1590 statement.c:1793 statement.c:2142 +#: statement.c:2262 statement.c:2477 statement.c:2808 statement.c:2815 +#: statement.c:2887 statement.c:3035 statement.c:3825 statement.c:3947 +#: statement.c:3981 statement.c:4040 +msgid "channel" +msgstr "" + +#: global.c:813 global.c:825 global.c:851 global.c:861 global.c:1033 +#: global.c:1058 global.c:1069 +msgid "start" +msgstr "" + +#: global.c:911 global.c:918 global.c:925 +msgid "Logarithm of negative value" +msgstr "" + +#: global.c:1208 statement.c:2608 +msgid "limit" +msgstr "" + +#: global.c:1249 +msgid "Square root argument" +msgstr "" + +#: global.c:1307 global.c:1319 +msgid "`string$' of empty string" +msgstr "" + +#: main.c:76 +msgid "Usage: bas [-b] [-l file] [-r] [-u] [program [argument ...]]\n" +msgstr "" + +#: main.c:77 main.c:87 +msgid "" +" bas [--backslash-colon] [--lp file] [--restricted] [--uppercase] " +"[program [argument ...]]\n" +msgstr "" + +#: main.c:78 main.c:88 +msgid " bas -h|--help\n" +msgstr "" + +#: main.c:79 main.c:89 +msgid " bas --version\n" +msgstr "" + +#: main.c:81 +msgid "Try `bas -h' or `bas --help' for more information.\n" +msgstr "" + +#: main.c:86 +msgid "Usage: bas [-b] [-l file] [-u] [program [argument ...]]\n" +msgstr "" + +#: main.c:91 +msgid "BASIC interpreter.\n" +msgstr "" + +#: main.c:93 +msgid "-b, --backslash-colon convert backslashs to colons\n" +msgstr "" + +#: main.c:94 +msgid "-l, --lp write LPRINT output to file\n" +msgstr "" + +#: main.c:95 +msgid "-r, --restricted forbid SHELL\n" +msgstr "" + +#: main.c:96 +msgid "-u, --uppercase output all tokens in uppercase\n" +msgstr "" + +#: main.c:97 +msgid "-h, --help display this help and exit\n" +msgstr "" + +#: main.c:98 +msgid " --version output version information and exit\n" +msgstr "" + +#: main.c:100 +msgid "Report bugs to <michael@moria.de>.\n" +msgstr "" + +#: main.c:105 +#, c-format +msgid "bas: Opening `%s' for line printer output failed (%s).\n" +msgstr "" + +#: program.c:295 +#, c-format +msgid " in line %ld at:\n" +msgstr "" + +#: program.c:302 +msgid " at: end of program\n" +msgstr "" + +#: program.c:307 +msgid " at: " +msgstr "" + +#: program.c:309 +msgid "end of line\n" +msgstr "" + +#: program.c:744 +msgid "Function Referenced in line\n" +msgstr "" + +#: program.c:753 +msgid "Variable Referenced in line\n" +msgstr "" + +#: program.c:762 +msgid "Gosub Referenced in line\n" +msgstr "" + +#: program.c:771 +msgid "Goto Referenced in line\n" +msgstr "" + +#: statement.c:136 +msgid "directory" +msgstr "" + +#: statement.c:224 +msgid "foreground colour" +msgstr "" + +#: statement.c:239 +msgid "background colour" +msgstr "" + +#: statement.c:256 +msgid "border colour" +msgstr "" + +#: statement.c:415 value.c:58 +msgid "string" +msgstr "" + +#: statement.c:570 statement.c:1355 statement.c:1483 statement.c:2547 +#: statement.c:2555 statement.c:2818 statement.c:3427 +msgid "file name" +msgstr "" + +#: statement.c:674 +msgid "generating temporary file name failed" +msgstr "" + +#: statement.c:890 +msgid "environment variable" +msgstr "" + +#: statement.c:956 +msgid "return" +msgstr "" + +#: statement.c:1050 statement.c:1056 +msgid "field width" +msgstr "" + +#: statement.c:1187 +msgid "implicit STEP 1:" +msgstr "" + +#: statement.c:1227 +msgid "record number" +msgstr "" + +#: statement.c:1245 +msgid "`put'/`get' data" +msgstr "" + +#: statement.c:1420 statement.c:1828 statement.c:2198 +msgid "end of file" +msgstr "" + +#: statement.c:1556 statement.c:1562 +msgid "row" +msgstr "" + +#: statement.c:1567 statement.c:1573 +msgid "column" +msgstr "" + +#: statement.c:1628 statement.c:1728 statement.c:3855 statement.c:3915 +msgid "condition" +msgstr "" + +#: statement.c:1901 +msgid "Too much input data\n" +msgstr "" + +#: statement.c:1990 +msgid "factor" +msgstr "" + +#. }}} +#: statement.c:2130 +msgid "matrix" +msgstr "" + +#: statement.c:2284 statement.c:3057 +msgid "format string" +msgstr "" + +#: statement.c:2614 +msgid "step" +msgstr "" + +#: statement.c:2695 statement.c:3464 +msgid "selector" +msgstr "" + +#: statement.c:2785 +msgid "mode or file" +msgstr "" + +#: statement.c:2828 statement.c:2840 statement.c:2913 statement.c:2925 +msgid "record length" +msgstr "" + +#: statement.c:2967 +msgid "array subscript base" +msgstr "" + +#: statement.c:3003 statement.c:3876 +msgid "address" +msgstr "" + +#: statement.c:3008 +msgid "output value" +msgstr "" + +#: statement.c:3125 +msgid "count" +msgstr "" + +#: statement.c:3196 +msgid "random number generator seed" +msgstr "" + +#: statement.c:3239 +msgid "source file" +msgstr "" + +#: statement.c:3252 +msgid "destination file" +msgstr "" + +#: statement.c:3691 statement.c:3698 +msgid "pause" +msgstr "" + +#: statement.c:3778 +msgid "Quit without saving? (y/n) " +msgstr "" + +#: statement.c:3785 +msgid "yes" +msgstr "" + +#: statement.c:3881 +msgid "mask" +msgstr "" + +#: statement.c:3887 +msgid "select" +msgstr "" + +#. }}} +#: statement.c:3963 statement.c:4046 +msgid "zone width" +msgstr "" + +#: value.c:59 +msgid "void" +msgstr "" + +#: value.c:1289 +msgid "unpaired \\ in format" +msgstr "" + +#: var.c:100 +msgid "array index" +msgstr "" diff --git a/apps/interpreters/bas/config.guess b/apps/interpreters/bas/config.guess new file mode 100644 index 000000000..b79252d6b --- /dev/null +++ b/apps/interpreters/bas/config.guess @@ -0,0 +1,1558 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2013 Free Software Foundation, Inc. + +timestamp='2013-06-10' + +# This file 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 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see <http://www.gnu.org/licenses/>. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. +# +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD +# +# Please send patches with a ChangeLog entry to config-patches@gnu.org. + + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2013 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ; set_cc_for_build= ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +case "${UNAME_SYSTEM}" in +Linux|GNU|GNU/*) + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + LIBC=gnu + + eval $set_cc_for_build + cat <<-EOF > $dummy.c + #include <features.h> + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #else + LIBC=gnu + #endif + EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd${UNAME_RELEASE} + exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include <stdio.h> /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <sys/systemcfg.h> + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[4567]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <unistd.h> + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; + *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="gnulibc1" ; fi + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi + else + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + cris:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + crisv32:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + frv:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:Linux:*:*) + echo ${UNAME_MACHINE}-pc-linux-${LIBC} + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=${UNAME_MACHINE}el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=${UNAME_MACHINE} + #else + CPU= + #endif + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } + ;; + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-${LIBC} + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; + PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; + *) echo hppa-unknown-linux-${LIBC} ;; + esac + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-${LIBC} + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-${LIBC} + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-${LIBC} + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-${LIBC} + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux-${LIBC} + exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-${LIBC} + exit ;; + x86_64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name` + echo ${UNAME_MACHINE}-pc-isc$UNAME_REL + elif /bin/uname -X 2>/dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <Richard.M.Bartel@ccMail.Census.GOV> + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes <hewes@openmarket.com>. + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + eval $set_cc_for_build + if test "$UNAME_PROCESSOR" = unknown ; then + UNAME_PROCESSOR=powerpc + fi + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + fi + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; +esac + +eval $set_cc_for_build +cat >$dummy.c <<EOF +#ifdef _SEQUENT_ +# include <sys/types.h> +# include <sys/utsname.h> +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include <sys/param.h> + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (__arm) && defined (__acorn) && defined (__unix) + printf ("arm-acorn-riscix\n"); exit (0); +#endif + +#if defined (hp300) && !defined (hpux) + printf ("m68k-hp-bsd\n"); exit (0); +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); + +#endif + +#if defined (vax) +# if !defined (ultrix) +# include <sys/param.h> +# if defined (BSD) +# if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +# else +# if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# endif +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# else + printf ("vax-dec-ultrix\n"); exit (0); +# endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. + +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + +# Convex versions that predate uname can use getsysinfo(1) + +if [ -x /usr/convex/getsysinfo ] +then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd + exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + c34*) + echo c34-convex-bsd + exit ;; + c38*) + echo c38-convex-bsd + exit ;; + c4*) + echo c4-convex-bsd + exit ;; + esac +fi + +cat >&2 <<EOF +$0: unable to guess system type + +This script, last modified $timestamp, has failed to recognize +the operating system you are using. It is advised that you +download the most up to date version of the config scripts from + + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD +and + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + +If the version you run ($0) is already up to date, please +send the following data and any information you think might be +pertinent to <config-patches@gnu.org> in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/apps/interpreters/bas/config.h b/apps/interpreters/bas/config.h new file mode 100644 index 000000000..d0f11b3eb --- /dev/null +++ b/apps/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 */ diff --git a/apps/interpreters/bas/config.h.in b/apps/interpreters/bas/config.h.in new file mode 100644 index 000000000..572326353 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/config.sub b/apps/interpreters/bas/config.sub new file mode 100644 index 000000000..59bb593f1 --- /dev/null +++ b/apps/interpreters/bas/config.sub @@ -0,0 +1,1779 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, +# 2011, 2012 Free Software Foundation, Inc. + +timestamp='2012-04-18' + +# This file is (in principle) common to ALL GNU software. +# The presence of a machine in this file suggests that SOME GNU software +# can handle that machine. It does not imply ALL GNU software can. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see <http://www.gnu.org/licenses/>. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Please send patches to <config-patches@gnu.org>. Submit a context +# diff and a properly formatted GNU ChangeLog entry. +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS + $0 [OPTION] ALIAS + +Canonicalize a configuration name. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.sub ($timestamp) + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). +# Here we must recognize all the valid KERNEL-OS combinations. +maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` +case $maybe_os in + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] + then os=`echo $1 | sed 's/.*-/-/'` + else os=; fi + ;; +esac + +### Let's recognize common machines as not being operating systems so +### that things like config.sub decstation-3100 work. We also +### recognize some manufacturers as not being operating systems, so we +### can provide default operating systems below. +case $os in + -sun*os*) + # Prevent following clause from handling this invalid input. + ;; + -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ + -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ + -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ + -apple | -axis | -knuth | -cray | -microblaze) + os= + basic_machine=$1 + ;; + -bluegene*) + os=-cnk + ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; + -chorusos*) + os=-chorusos + basic_machine=$1 + ;; + -chorusrdb) + os=-chorusrdb + basic_machine=$1 + ;; + -hiux*) + os=-hiuxwe2 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco4) + os=-sco3.2v4 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2v[4-9]*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -isc) + os=-isc2.2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -clix*) + basic_machine=clipper-intergraph + ;; + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; + -lynx*) + os=-lynxos + ;; + -ptx*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` + ;; + -windowsnt*) + os=`echo $os | sed -e 's/windowsnt/winnt/'` + ;; + -psos*) + os=-psos + ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; +esac + +# Decode aliases for certain CPU-COMPANY combinations. +case $basic_machine in + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | aarch64 | aarch64_be \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | be32 | be64 \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | epiphany \ + | fido | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore | mep | metag \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 \ + | ns16k | ns32k \ + | open8 \ + | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ + | pyramid \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ + | we32k \ + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) + basic_machine=$basic_machine-unknown + ;; + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # Object if more than one company name word. + *-*-*) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ + | aarch64-* | aarch64_be-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64octeon-* | mips64octeonel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ + | pyramid-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ + | tron-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ + | we32k-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ + | ymp-* \ + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + basic_machine=m68000-att + ;; + 3b*) + basic_machine=we32k-att + ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + abacus) + basic_machine=abacus-unknown + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; + alliant | fx80) + basic_machine=fx80-alliant + ;; + altos | altos3068) + basic_machine=m68k-altos + ;; + am29k) + basic_machine=a29k-none + os=-bsd + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + amdahl) + basic_machine=580-amdahl + os=-sysv + ;; + amiga | amiga-*) + basic_machine=m68k-unknown + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=-amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=-sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=-sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; + aros) + basic_machine=i386-pc + os=-aros + ;; + aux) + basic_machine=m68k-apple + os=-aux + ;; + balance) + basic_machine=ns32k-sequent + os=-dynix + ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; + convex-c1) + basic_machine=c1-convex + os=-bsd + ;; + convex-c2) + basic_machine=c2-convex + os=-bsd + ;; + convex-c32) + basic_machine=c32-convex + os=-bsd + ;; + convex-c34) + basic_machine=c34-convex + os=-bsd + ;; + convex-c38) + basic_machine=c38-convex + os=-bsd + ;; + cray | j90) + basic_machine=j90-cray + os=-unicos + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; + decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) + basic_machine=mips-dec + ;; + decsystem10* | dec10*) + basic_machine=pdp10-dec + os=-tops10 + ;; + decsystem20* | dec20*) + basic_machine=pdp10-dec + os=-tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + basic_machine=m68k-motorola + ;; + delta88) + basic_machine=m88k-motorola + os=-sysv3 + ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx + ;; + dpx2* | dpx2*-bull) + basic_machine=m68k-bull + os=-sysv3 + ;; + ebmon29k) + basic_machine=a29k-amd + os=-ebmon + ;; + elxsi) + basic_machine=elxsi-elxsi + os=-bsd + ;; + encore | umax | mmax) + basic_machine=ns32k-encore + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; + fx2800) + basic_machine=i860-alliant + ;; + genix) + basic_machine=ns32k-ns + ;; + gmicro) + basic_machine=tron-gmicro + os=-sysv + ;; + go32) + basic_machine=i386-pc + os=-go32 + ;; + h3050r* | hiux*) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=-hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; + harris) + basic_machine=m88k-harris + os=-sysv3 + ;; + hp300-*) + basic_machine=m68k-hp + ;; + hp300bsd) + basic_machine=m68k-hp + os=-bsd + ;; + hp300hpux) + basic_machine=m68k-hp + os=-hpux + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + basic_machine=m68000-hp + ;; + hp9k3[2-9][0-9]) + basic_machine=m68k-hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hppa-next) + os=-nextstep3 + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 + ;; + i*86v4*) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv4 + ;; + i*86v) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv + ;; + i*86sol2) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-solaris2 + ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + iris | iris4d) + basic_machine=mips-sgi + case $os in + -irix*) + ;; + *) + os=-irix4 + ;; + esac + ;; + isi68 | isi) + basic_machine=m68k-isi + os=-sysv + ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + m88k-omron*) + basic_machine=m88k-omron + ;; + magnum | m3230) + basic_machine=mips-mips + os=-sysv + ;; + merlin) + basic_machine=ns32k-utek + os=-sysv + ;; + microblaze) + basic_machine=microblaze-xilinx + ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; + miniframe) + basic_machine=m68000-convergent + ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; + mips3*-*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` + ;; + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i386-pc + os=-msys + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 + ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=-newsos + ;; + news1000) + basic_machine=m68030-sony + os=-newsos + ;; + news-3600 | risc-news) + basic_machine=mips-sony + os=-newsos + ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; + next | m*-next ) + basic_machine=m68k-next + case $os in + -nextstep* ) + ;; + -ns2*) + os=-nextstep2 + ;; + *) + os=-nextstep3 + ;; + esac + ;; + nh3000) + basic_machine=m68k-harris + os=-cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=-cxux + ;; + nindy960) + basic_machine=i960-intel + os=-nindy + ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=-nonstopux + ;; + np1) + basic_machine=np1-gould + ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; + pa-hitachi) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + paragon) + basic_machine=i860-intel + os=-osf + ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + pbd) + basic_machine=sparc-tti + ;; + pbb) + basic_machine=m68k-tti + ;; + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-pc + ;; + pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) + basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumpro-* | p6-* | 6x86-* | athlon-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pn) + basic_machine=pn-gould + ;; + power) basic_machine=power-ibm + ;; + ppc | ppcbe) basic_machine=powerpc-unknown + ;; + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown + ;; + ppcle-* | powerpclittle-*) + basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64) basic_machine=powerpc64-unknown + ;; + ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64le | powerpc64little | ppc64-le | powerpc64-little) + basic_machine=powerpc64le-unknown + ;; + ppc64le-* | powerpc64little-*) + basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ps2) + basic_machine=i386-ibm + ;; + pw32) + basic_machine=i586-unknown + os=-pw32 + ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; + rm[46]00) + basic_machine=mips-siemens + ;; + rtpc | rtpc-*) + basic_machine=romp-ibm + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; + sb1) + basic_machine=mipsisa64sb1-unknown + ;; + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; + sparclite-wrs | simso-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; + sps7) + basic_machine=m68k-bull + os=-sysv2 + ;; + spur) + basic_machine=spur-unknown + ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + sun2) + basic_machine=m68000-sun + ;; + sun2os3) + basic_machine=m68000-sun + os=-sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=-sunos4 + ;; + sun3os3) + basic_machine=m68k-sun + os=-sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=-sunos4 + ;; + sun4os3) + basic_machine=sparc-sun + os=-sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=-sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=-solaris2 + ;; + sun3 | sun3-*) + basic_machine=m68k-sun + ;; + sun4) + basic_machine=sparc-sun + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + ;; + sv1) + basic_machine=sv1-cray + os=-unicos + ;; + symmetry) + basic_machine=i386-sequent + os=-dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu + ;; + tx39) + basic_machine=mipstx39-unknown + ;; + tx39el) + basic_machine=mipstx39el-unknown + ;; + toad1) + basic_machine=pdp10-xkl + os=-tops20 + ;; + tower | tower-32) + basic_machine=m68k-ncr + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + udi29k) + basic_machine=a29k-amd + os=-udi + ;; + ultra3) + basic_machine=a29k-nyu + os=-sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; + vaxv) + basic_machine=vax-dec + os=-sysv + ;; + vms) + basic_machine=vax-dec + os=-vms + ;; + vpp*|vx|vx-*) + basic_machine=f301-fujitsu + ;; + vxworks960) + basic_machine=i960-wrs + os=-vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=-vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=-vxworks + ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; + ymp) + basic_machine=ymp-cray + os=-unicos + ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; + none) + basic_machine=none-none + os=-none + ;; + +# Here we handle the default manufacturer of certain CPU types. It is in +# some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp10) + # there are many clones, so DEC is not a safe bet + basic_machine=pdp10-unknown + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) + basic_machine=cydra-cydrome + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + *-unknown) + # Make sure to match an already-canonicalized machine name. + ;; + *) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $basic_machine in + *-digital*) + basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` + ;; + *-commodore*) + basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x"$os" != x"" ] +then +case $os in + # First match some system type aliases + # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 + ;; + -svr4*) + os=-sysv4 + ;; + -unixware*) + os=-sysv4.2uw + ;; + -gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # First accept the basic system types. + # The portable systems comes first. + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* | -aros* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) + case $basic_machine in + x86-* | i*86-*) + ;; + *) + os=-nto$os + ;; + esac + ;; + -nto-qnx*) + ;; + -nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + -sunos5*) + os=`echo $os | sed -e 's|sunos5|solaris2|'` + ;; + -sunos6*) + os=`echo $os | sed -e 's|sunos6|solaris3|'` + ;; + -opened*) + os=-openedition + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -386bsd) + os=-bsd + ;; + -ctix* | -uts*) + os=-sysv + ;; + -nova*) + os=-rtmk-nova + ;; + -ns2 ) + os=-nextstep2 + ;; + -nsk*) + os=-nsk + ;; + # Preserve the version number of sinix5. + -sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + -sinix*) + os=-sysv4 + ;; + -tpf*) + os=-tpf + ;; + -triton*) + os=-sysv3 + ;; + -oss*) + os=-sysv3 + ;; + -svr4) + os=-sysv4 + ;; + -svr3) + os=-sysv3 + ;; + -sysvr4) + os=-sysv4 + ;; + # This must come after -sysvr4. + -sysv*) + ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; + -xenix) + os=-xenix + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + os=-mint + ;; + -aros*) + os=-aros + ;; + -kaos*) + os=-kaos + ;; + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; + -none) + ;; + *) + # Get rid of the `-' at the beginning of $os. + os=`echo $os | sed 's/[^-]*-//'` + echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 + ;; + pdp11-*) + os=-none + ;; + *-dec | vax-*) + os=-ultrix4.2 + ;; + m68*-apollo) + os=-domain + ;; + i386-sun) + os=-sunos4.0.2 + ;; + m68000-sun) + os=-sunos3 + ;; + m68*-cisco) + os=-aout + ;; + mep-*) + os=-elf + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; + or32-*) + os=-coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=-sysv3 + ;; + sparc-* | *-sun) + os=-sunos4.1.1 + ;; + *-be) + os=-beos + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; + *-hp) + os=-hpux + ;; + *-hitachi) + os=-hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=-sysv + ;; + *-cbm) + os=-amigaos + ;; + *-dg) + os=-dgux + ;; + *-dolphin) + os=-sysv3 + ;; + m68k-ccur) + os=-rtu + ;; + m88k-omron*) + os=-luna + ;; + *-next ) + os=-nextstep + ;; + *-sequent) + os=-ptx + ;; + *-crds) + os=-unos + ;; + *-ns) + os=-genix + ;; + i370-*) + os=-mvs + ;; + *-next) + os=-nextstep3 + ;; + *-gould) + os=-sysv + ;; + *-highlevel) + os=-bsd + ;; + *-encore) + os=-bsd + ;; + *-sgi) + os=-irix + ;; + *-siemens) + os=-sysv4 + ;; + *-masscomp) + os=-rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=-uxpv + ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; + *) + os=-none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +vendor=unknown +case $basic_machine in + *-unknown) + case $os in + -riscix*) + vendor=acorn + ;; + -sunos*) + vendor=sun + ;; + -cnk*|-aix*) + vendor=ibm + ;; + -beos*) + vendor=be + ;; + -hpux*) + vendor=hp + ;; + -mpeix*) + vendor=hp + ;; + -hiux*) + vendor=hitachi + ;; + -unos*) + vendor=crds + ;; + -dgux*) + vendor=dg + ;; + -luna*) + vendor=omron + ;; + -genix*) + vendor=ns + ;; + -mvs* | -opened*) + vendor=ibm + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -vxsim* | -vxworks* | -windiss*) + vendor=wrs + ;; + -aux*) + vendor=apple + ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + vendor=atari + ;; + -vos*) + vendor=stratus + ;; + esac + basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` + ;; +esac + +echo $basic_machine$os +exit + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/apps/interpreters/bas/configure b/apps/interpreters/bas/configure new file mode 100644 index 000000000..0cb7c030d --- /dev/null +++ b/apps/interpreters/bas/configure @@ -0,0 +1,5579 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 </dev/null +exec 6>&1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= +PACKAGE_URL= + +ac_unique_file="bas.c" +# Factoring default headers for most tests. +ac_includes_default="\ +#include <stdio.h> +#ifdef HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#ifdef HAVE_SYS_STAT_H +# include <sys/stat.h> +#endif +#ifdef STDC_HEADERS +# include <stdlib.h> +# include <stddef.h> +#else +# ifdef HAVE_STDLIB_H +# include <stdlib.h> +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include <memory.h> +# endif +# include <string.h> +#endif +#ifdef HAVE_STRINGS_H +# include <strings.h> +#endif +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +USE_NLS +UPDATED +VERSION +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +MSGFMT +VALGRIND +EGREP +GREP +CPP +RANLIB +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_dmalloc +with_efence +with_valgrind +enable_lr0 +enable_largefile +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-lr0 use LR0 parser (default is recursive descending) + --disable-largefile omit support for large files + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-dmalloc=DIR dmalloc include/library installation prefix + --with-efence=DIR efence include/library installation prefix + --with-valgrind run regression tests with valgrind + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + LIBS libraries to pass to the linker, e.g. -l<library> + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if + you have headers in a nonstandard directory <include dir> + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +configure +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case <limits.h> declares $2. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_config_headers="$ac_config_headers config.h" + +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if ${ac_cv_build+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if ${ac_cv_host+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +VERSION=2.4 +UPDATED='October 25, 2014' + +ALL_LINGUAS="de" + +case $host in + *-linux-*) + if test "$prefix" = NONE + then + prefix=/usr + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using prefix $prefix" >&5 +$as_echo "using prefix $prefix" >&6; } + 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) + $as_echo "#define USE_SELECT 1" >>confdefs.h + + ;; + *) + prefix=$ac_default_prefix + ;; +esac + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdio.h> +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +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 + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <ctype.h> +#include <stdlib.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in termcap.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "termcap.h" "ac_cv_header_termcap_h" "$ac_includes_default" +if test "x$ac_cv_header_termcap_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TERMCAP_H 1 +_ACEOF + have_termcap_h=yes +fi + +done + +if test "$have_termcap_h" != yes; then + for ac_header in curses.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "curses.h" "ac_cv_header_curses_h" "$ac_includes_default" +if test "x$ac_cv_header_curses_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_CURSES_H 1 +_ACEOF + have_curses_h=yes +fi + +done + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tputs return type" >&5 +$as_echo_n "checking for tputs return type... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef HAVE_TERMCAP_H +#include <termcap.h> +#else +#include <curses.h> +#endif +static int outc(int c){ return c; } + +int +main () +{ +return tputs((char*)0,0,outc); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: int" >&5 +$as_echo "int" >&6; } +else + $as_echo "#define TPUTS_RETURNS_VOID 1" >>confdefs.h + { $as_echo "$as_me:${as_lineno-$LINENO}: result: void" >&5 +$as_echo "void" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +ac_fn_c_check_func "$LINENO" "fmod" "ac_cv_func_fmod" +if test "x$ac_cv_func_fmod" = xyes; then : + have_fmod=yes +fi + +if test "$have_fmod" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fmod in -lm" >&5 +$as_echo_n "checking for fmod in -lm... " >&6; } +if ${ac_cv_lib_m_fmod+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fmod (); +int +main () +{ +return fmod (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fmod=yes +else + ac_cv_lib_m_fmod=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fmod" >&5 +$as_echo "$ac_cv_lib_m_fmod" >&6; } +if test "x$ac_cv_lib_m_fmod" = xyes; then : + have_fmod=yes; LIBS="-lm $LIBS" +fi + +fi +if test "$have_fmod" != yes +then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no fmod() found, configure failed." >&5 +$as_echo "no fmod() found, configure failed." >&6; } + exit 1 +fi + +for ac_header in tgmath.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "tgmath.h" "ac_cv_header_tgmath_h" "$ac_includes_default" +if test "x$ac_cv_header_tgmath_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TGMATH_H 1 +_ACEOF + have_tgmath_h=yes +fi + +done + +for ac_func in lrint +do : + ac_fn_c_check_func "$LINENO" "lrint" "ac_cv_func_lrint" +if test "x$ac_cv_func_lrint" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LRINT 1 +_ACEOF + +fi +done + +for ac_func in nanosleep +do : + ac_fn_c_check_func "$LINENO" "nanosleep" "ac_cv_func_nanosleep" +if test "x$ac_cv_func_nanosleep" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_NANOSLEEP 1 +_ACEOF + +fi +done + + +for ac_func in tgetent +do : + ac_fn_c_check_func "$LINENO" "tgetent" "ac_cv_func_tgetent" +if test "x$ac_cv_func_tgetent" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TGETENT 1 +_ACEOF + have_tgetent=yes +fi +done + +if test "$have_tgetent" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -lcurses" >&5 +$as_echo_n "checking for tgetent in -lcurses... " >&6; } +if ${ac_cv_lib_curses_tgetent+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lcurses $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgetent (); +int +main () +{ +return tgetent (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_curses_tgetent=yes +else + ac_cv_lib_curses_tgetent=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_curses_tgetent" >&5 +$as_echo "$ac_cv_lib_curses_tgetent" >&6; } +if test "x$ac_cv_lib_curses_tgetent" = xyes; then : + $as_echo "#define HAVE_TGETENT 1" >>confdefs.h + have_tgetent=yes; LIBS="-lcurses $LIBS" +fi + +fi +if test "$have_tgetent" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -ltermcap" >&5 +$as_echo_n "checking for tgetent in -ltermcap... " >&6; } +if ${ac_cv_lib_termcap_tgetent+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltermcap $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgetent (); +int +main () +{ +return tgetent (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_termcap_tgetent=yes +else + ac_cv_lib_termcap_tgetent=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_termcap_tgetent" >&5 +$as_echo "$ac_cv_lib_termcap_tgetent" >&6; } +if test "x$ac_cv_lib_termcap_tgetent" = xyes; then : + $as_echo "#define HAVE_TGETENT 1" >>confdefs.h + have_tgetent=yes; LIBS="-ltermcap $LIBS" +fi + +fi +# The following applies to sick Linux distributions. +if test "$have_tgetent" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgetent in -lncurses" >&5 +$as_echo_n "checking for tgetent in -lncurses... " >&6; } +if ${ac_cv_lib_ncurses_tgetent+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lncurses $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgetent (); +int +main () +{ +return tgetent (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_ncurses_tgetent=yes +else + ac_cv_lib_ncurses_tgetent=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncurses_tgetent" >&5 +$as_echo "$ac_cv_lib_ncurses_tgetent" >&6; } +if test "x$ac_cv_lib_ncurses_tgetent" = xyes; then : + $as_echo "#define HAVE_TGETENT 1" >>confdefs.h + have_tgetent=yes; LIBS="-lncurses $LIBS" +fi + +fi + + +# Check whether --with-dmalloc was given. +if test "${with_dmalloc+set}" = set; then : + withval=$with_dmalloc; CPPFLAGS="$CPPFLAGS -I$with_dmalloc/include" + LDFLAGS="$LDFLAGS -L$with_dmalloc/lib" + LIBS="$LIBS -ldmalloc" + $as_echo "#define USE_DMALLOC 1" >>confdefs.h + + +fi + + + +# Check whether --with-efence was given. +if test "${with_efence+set}" = set; then : + withval=$with_efence; CPPFLAGS="$CPPFLAGS -I$with_efence/include" + LDFLAGS="$LDFLAGS -L$with_efence/lib" + LIBS="$LIBS -lefence" + +fi + + + +# Check whether --with-valgrind was given. +if test "${with_valgrind+set}" = set; then : + withval=$with_valgrind; VALGRIND="valgrind" + + +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use LR0 parser" >&5 +$as_echo_n "checking whether to use LR0 parser... " >&6; } +# Check whether --enable-lr0 was given. +if test "${enable_lr0+set}" = set; then : + enableval=$enable_lr0; + case "$enableval" in + yes) + $as_echo "#define USE_LR0 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + ;; + no) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + ;; + esac +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + +fi + + +USE_NLS=no +# Extract the first word of "msgfmt", so it can be a program name with args. +set dummy msgfmt; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MSGFMT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MSGFMT"; then + ac_cv_prog_MSGFMT="$MSGFMT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MSGFMT="yes" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_MSGFMT" && ac_cv_prog_MSGFMT="no" +fi +fi +MSGFMT=$ac_cv_prog_MSGFMT +if test -n "$MSGFMT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MSGFMT" >&5 +$as_echo "$MSGFMT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +if test "$MSGFMT" = yes +then + for ac_header in libintl.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "libintl.h" "ac_cv_header_libintl_h" "$ac_includes_default" +if test "x$ac_cv_header_libintl_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBINTL_H 1 +_ACEOF + LIBINTL=yes +fi + +done + + if test "$LIBINTL" = yes + then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing gettext" >&5 +$as_echo_n "checking for library containing gettext... " >&6; } +if ${ac_cv_search_gettext+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char gettext (); +int +main () +{ +return gettext (); + ; + return 0; +} +_ACEOF +for ac_lib in '' intl; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_gettext=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_gettext+:} false; then : + break +fi +done +if ${ac_cv_search_gettext+:} false; then : + +else + ac_cv_search_gettext=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_gettext" >&5 +$as_echo "$ac_cv_search_gettext" >&6; } +ac_res=$ac_cv_search_gettext +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + $as_echo "#define HAVE_GETTEXT 1" >>confdefs.h + USE_NLS=yes +fi + + fi +fi + +# Check whether --enable-largefile was given. +if test "${enable_largefile+set}" = set; then : + enableval=$enable_largefile; +fi + +if test "$enable_largefile" != no; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 +$as_echo_n "checking for special C compiler options needed for large files... " >&6; } +if ${ac_cv_sys_largefile_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_sys_largefile_CC=no + if test "$GCC" != yes; then + ac_save_CC=$CC + while :; do + # IRIX 6.2 and later do not support large files by default, + # so use the C compiler's -n32 option if that helps. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + break +fi +rm -f core conftest.err conftest.$ac_objext + CC="$CC -n32" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_largefile_CC=' -n32'; break +fi +rm -f core conftest.err conftest.$ac_objext + break + done + CC=$ac_save_CC + rm -f conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5 +$as_echo "$ac_cv_sys_largefile_CC" >&6; } + if test "$ac_cv_sys_largefile_CC" != no; then + CC=$CC$ac_cv_sys_largefile_CC + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 +$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } +if ${ac_cv_sys_file_offset_bits+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=64; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_file_offset_bits=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5 +$as_echo "$ac_cv_sys_file_offset_bits" >&6; } +case $ac_cv_sys_file_offset_bits in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits +_ACEOF +;; +esac +rm -rf conftest* + if test $ac_cv_sys_file_offset_bits = unknown; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 +$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } +if ${ac_cv_sys_large_files+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGE_FILES 1 +#include <sys/types.h> + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=1; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_large_files=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5 +$as_echo "$ac_cv_sys_large_files" >&6; } +case $ac_cv_sys_large_files in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGE_FILES $ac_cv_sys_large_files +_ACEOF +;; +esac +rm -rf conftest* + fi + + +fi + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + + +cat >>confdefs.h <<_ACEOF +#define VERSION "$VERSION" +_ACEOF + + + + +ac_config_files="$ac_config_files Makefile bas.1 test/runbas" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Report bugs to the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "bas.1") CONFIG_FILES="$CONFIG_FILES bas.1" ;; + "test/runbas") CONFIG_FILES="$CONFIG_FILES test/runbas" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' <conf$$subs.awk | sed ' +/^[^""]/{ + N + s/\n// +} +' >>$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' <confdefs.h | sed ' +s/'"$ac_delim"'/"\\\ +"/g' >>$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi + ;; + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + +chmod 755 test/runbas diff --git a/apps/interpreters/bas/configure.in b/apps/interpreters/bas/configure.in new file mode 100644 index 000000000..7a58a4b6b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/de.po b/apps/interpreters/bas/de.po new file mode 100644 index 000000000..eea1f6de0 --- /dev/null +++ b/apps/interpreters/bas/de.po @@ -0,0 +1,1113 @@ +msgid "" +msgstr "" +"Project-Id-Version: bas 1.2\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2014-10-25 20:16+0200\n" +"PO-Revision-Date: 2002-11-09 18:26+0100\n" +"Last-Translator: Michael Haardt <michael@moria.de>\n" +"Language-Team: Deutsch <michael@moria.de>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#: auto.c:145 +msgid "Called" +msgstr "Aufruf" + +#: auto.c:155 +msgid "Proc Called" +msgstr "Prozeduraufruf" + +#: bas.c:181 +msgid "index" +msgstr "Index" + +#: bas.c:277 +msgid "actual parameter" +msgstr "Aktualparameter" + +#: bas.c:651 +msgid "operand" +msgstr "Operand" + +#: bas.c:847 +msgid "binary operand" +msgstr "binären Operanden" + +#: bas.c:898 +msgid "unary operand" +msgstr "monadischen Operanden" + +#: bas.c:988 +msgid "parenthetic" +msgstr "Klammerausdruck" + +#: bas.c:1133 +msgid "program" +msgstr "Programm" + +#: bas.c:1137 +msgid "`if' branch" +msgstr "`if' Zweig" + +#: bas.c:1138 +msgid "`do' loop" +msgstr "`do' Schleife" + +#: bas.c:1139 +msgid "`do while' or `do until' loop" +msgstr "`do while' oder `do until' Schleife" + +#: bas.c:1140 +msgid "`else' branch" +msgstr "`else' Zweig" + +#: bas.c:1141 +msgid "`for' loop" +msgstr "`for' Schleife" + +#: bas.c:1142 +msgid "`while' loop" +msgstr "`while' Schleife" + +#: bas.c:1143 +msgid "`repeat' loop" +msgstr "`repeat' Schleife" + +#: bas.c:1144 +msgid "`select case' control structure" +msgstr "`select case' Steuerstruktur" + +#: bas.c:1145 +msgid "function or procedure" +msgstr "Funktion oder Prozedur" + +#: bas.c:1180 global.c:179 global.c:208 global.c:955 +msgid "position" +msgstr "Position" + +#: bas.c:1187 bas.c:1189 global.c:180 global.c:196 global.c:209 global.c:242 +#: global.c:841 global.c:863 global.c:886 global.c:1048 global.c:1071 +#: global.c:1185 global.c:1240 global.c:1289 global.c:1299 global.c:1318 +msgid "length" +msgstr "Länge" + +#: bas.c:1197 bas.c:1242 statement.c:1671 +msgid "rhs" +msgstr "rechte Seite" + +#: bas.c:1367 bas.c:1415 +msgid "Error: " +msgstr "Fehler: " + +#: bas.c:1435 bas.c:1440 bas.c:1448 bas.c:1453 statement.c:503 statement.c:511 +msgid "dimension" +msgstr "Dimension" + +#: bas.c:1476 bas.c:1479 statement.c:413 value.c:56 +msgid "integer" +msgstr "Ganzzahl" + +#: bas.c:1480 bas.c:1496 +msgid "converted value" +msgstr "Konvertierter Wert" + +#: bas.c:1492 bas.c:1495 statement.c:414 value.c:57 +msgid "real" +msgstr "Fließkomma" + +#: bas.c:1597 +msgid "bas: Executing `" +msgstr "bas: Ausführung von `" + +#: bas.c:1599 +msgid "' failed (" +msgstr "' nicht möglich (" + +#: bas.c:1601 +msgid ").\n" +msgstr ").\n" + +#: bas.c:1645 +msgid "This is free software with ABSOLUTELY NO WARRANTY.\n" +msgstr "Dies ist freie Software ohne JEGLICHE GEWÄHRLEISTUNG.\n" + +#: bas.c:1663 +msgid "" +"\n" +"Break\n" +msgstr "" +"\n" +"Abbruch\n" + +#: bas.c:1701 error.h:95 +msgid "Use `renum' to number program first" +msgstr "Benutzen sie `renum' um das Programm erst zu nummerieren" + +#: bas.c:1711 +msgid "END program\n" +msgstr "END benutzt\n" + +#: bas.c:1717 +msgid "Invalid line\n" +msgstr "Ungültige Zeile\n" + +#: error.h:15 +msgid "Formal parameter already declared" +msgstr "Formaler Parameter bereits deklariert" + +#: error.h:16 +msgid "Variable already declared as `local'" +msgstr "Variable ist bereits als `local' deklariert" + +#: error.h:17 +#, c-format +msgid "Identifier can not be declared as %s" +msgstr "Bezeichner kann nicht als %s deklariert werden" + +#: error.h:18 +msgid "Ranges must be constructed from single letter identifiers" +msgstr "Bereiche müssen durch einbuchstabige Bezeichner gebildet werden" + +#: error.h:19 +#, c-format +msgid "Missing line number at the beginning of text line %d" +msgstr "Fehlende Zeilennummer zu Beginn der Textzeile %d" + +#: error.h:20 +msgid "Invalid unary operand" +msgstr "Ungültiger monadischer Operand" + +#: error.h:21 +msgid "Invalid binary operand" +msgstr "Ungültiger binärer Operand" + +#: error.h:22 +msgid "Missing `as'" +msgstr "Fehlendes `as'" + +#: error.h:23 +msgid "Missing colon `:'" +msgstr "Fehlender Doppelpunkt `:'" + +#: error.h:24 +msgid "Missing comma `,'" +msgstr "Fehlendes Komma `,'" + +#: error.h:25 +msgid "Missing right parenthesis `)'" +msgstr "Fehlende schließende Klammer `)'" + +#: error.h:26 +msgid "Missing `data' input" +msgstr "Fehlende `data' Eingabe" + +#: error.h:27 +msgid "Missing `dec'/`inc' variable identifier" +msgstr "Fehlender `dec'/`inc' Variablenbezeichner" + +#: error.h:28 +msgid "Missing equal sign `='" +msgstr "Fehlendes Gleichheitszeichen `='" + +#: error.h:29 +#, c-format +msgid "Expected %s expression" +msgstr "Fehlender Ausdruck für %s" + +#: error.h:30 +msgid "Missing `file'" +msgstr "Fehlendes `file'" + +#: error.h:31 +msgid "Missing `goto' or `gosub'" +msgstr "Fehlendes `goto' oder `gosub'" + +#: error.h:32 +msgid "Missing variable identifier" +msgstr "Fehlender Variablenbezeichner" + +#: error.h:33 +msgid "Missing procedure identifier" +msgstr "Fehlender Prozedurbezeichner" + +#: error.h:34 +msgid "Missing function identifier" +msgstr "Fehlender Funktionsbezeichner" + +#: error.h:35 +msgid "Missing array variable identifier" +msgstr "Fehlender Feldvariablenbezeichner" + +#: error.h:36 +msgid "Missing string variable identifier" +msgstr "Fehlender Zeichenkettenvariablenbezeichner" + +#: error.h:37 +msgid "Missing loop variable identifier" +msgstr "Fehlender Schleifenvariablenbezeichner" + +#: error.h:38 +msgid "Missing formal parameter identifier" +msgstr "Fehlender Formalparameterbezeichner" + +#: error.h:39 +msgid "Missing `read' variable identifier" +msgstr "Fehlender `read' Variablenbezeichner" + +#: error.h:40 +msgid "Missing `swap' variable identifier" +msgstr "Fehlender `swap' Variablenbezeichner" + +#: error.h:41 +msgid "Missing matrix variable identifier" +msgstr "Fehlender Matrixvariablenbezeichner" + +#: error.h:42 +msgid "Missing line increment" +msgstr "Fehlendes Zeileninkrement" + +#: error.h:43 +msgid "Missing `len'" +msgstr "Fehlendes `len'" + +#: error.h:44 +msgid "Missing line number" +msgstr "Fehlende Zeilennummer" + +#: error.h:45 +msgid "Missing left parenthesis `('" +msgstr "Fehlende öffnende Klammer `('" + +#: error.h:46 +msgid "Missing semicolon `;'" +msgstr "Fehlender Strichpunkt `;'" + +#: error.h:47 +msgid "Missing semicolon `;' or comma `,'" +msgstr "Fehlender Strichpunkt `;'" + +#: error.h:48 +msgid "Missing star `*'" +msgstr "Fehlender Stern `*'" + +#: error.h:49 +msgid "Missing statement" +msgstr "Fehlende Anweisung" + +#: error.h:50 +msgid "Missing `then'" +msgstr "Fehlendes `then'" + +#: error.h:51 +msgid "Missing `to'" +msgstr "Fehlendes `to'" + +#: error.h:52 +msgid "Nested definition" +msgstr "Verschachtelte Definition" + +#: error.h:53 +msgid "No program" +msgstr "Kein Programm" + +#: error.h:54 +msgid "No such `data' line" +msgstr "Es gibt keine solche `data' Zeile" + +#: error.h:55 +msgid "No such line" +msgstr "Diese Zeile gibt es nicht" + +#: error.h:56 +msgid "Redeclaration as different kind of symbol" +msgstr "Wiederholte Deklaration mit anderem Symboltyp" + +#: error.h:57 +msgid "`case' without `select case'" +msgstr "`case' ohne `select case'" + +#: error.h:58 +msgid "`do' without `loop'" +msgstr "`do' ohne `loop'" + +#: error.h:59 +msgid "`do while' or `do until' without `loop'" +msgstr "`do while' oder `do until' ohne `loop'" + +#: error.h:60 +msgid "`else' without `if'" +msgstr "`else' ohne `if'" + +#: error.h:61 +msgid "`else' without `end if'" +msgstr "`else' ohne `end if'" + +#: error.h:62 +msgid "`end if' without multiline `if' or `else'" +msgstr "`end if' ohne mehrzeiliges `if' oder `else'" + +#: error.h:63 +#, c-format +msgid "`subend', `end sub' or `endproc' without `sub' or `def proc' inside %s" +msgstr "" +"`subend', `end sub' oder `endproc' ohne `sub' oder `def proc' innerhalb von %" +"s" + +#: error.h:64 +#, c-format +msgid "`subexit' without `sub' inside %s" +msgstr "`subexit' ohne `sub' innerhalb %s" + +#: error.h:65 +msgid "`end select' without `select case'" +msgstr "`end select' ohne `select case'" + +#: error.h:66 +msgid "`end function' without `def fn' or `function'" +msgstr "`end function' ohne `def fn' oder `function'" + +#: error.h:67 +msgid "`=' returning from function without `def fn'" +msgstr "`=' beendet Funktion ohne `def fn'" + +#: error.h:68 +msgid "`exit do' without `do'" +msgstr "`exit do' ohne `do'" + +#: error.h:69 +msgid "`exit for' without `for'" +msgstr "`exit for' ohne `for'" + +#: error.h:70 +msgid "`fnend' without `def fn'" +msgstr "`fnend' ohne `def fn'" + +#: error.h:71 +msgid "`exit function' outside function declaration" +msgstr "`exit function' außerhalb einer Funktionsdeklaration" + +#: error.h:72 +msgid "`fnreturn' without `def fn'" +msgstr "`fnreturn' ohne `def fn'" + +#: error.h:73 +msgid "`for' without `next'" +msgstr "`for' ohne `next'" + +#: error.h:74 +msgid "Function/procedure declaration without end" +msgstr "Funktions-/Prozedurdeklaration ohne Ende" + +#: error.h:75 +msgid "`if' without `end if'" +msgstr "`if' ohne `end if'" + +#: error.h:76 +msgid "`local' without `def fn' or `def proc'" +msgstr "`local' ohne `def fn' oder `def proc'" + +#: error.h:77 +msgid "`loop' without `do'" +msgstr "`loop' ohne `do'" + +#: error.h:78 +msgid "`loop until' without `do'" +msgstr "`loop until' ohne `do'" + +#: error.h:79 +#, c-format +msgid "`next' without `for' inside %s" +msgstr "`next' ohne `for' innerhalb %s" + +#: error.h:80 +msgid "`repeat' without `until'" +msgstr "`repeat' ohne `until'" + +#: error.h:81 +msgid "`select case' without `end select'" +msgstr "`select case' ohne `end select'" + +#: error.h:82 +msgid "`until' without `repeat'" +msgstr "`until' ohne `repeat'" + +#: error.h:83 +#, c-format +msgid "`wend' without `while' inside %s" +msgstr "`wend' ohne `while' innerhalb %s" + +#: error.h:84 +msgid "`while' without `wend'" +msgstr "`while' ohne `wend'" + +#: error.h:85 +msgid "Syntax" +msgstr "Syntax" + +#: error.h:86 +msgid "Too few parameters" +msgstr "Zu wenige Parameter" + +#: error.h:87 +msgid "Too many parameters" +msgstr "Zu viele Parameter" + +#: error.h:88 +#, c-format +msgid "Type mismatch (has %s, need %s)" +msgstr "Typfehler (%s ist angegeben, %s wird benötigt)" + +#: error.h:89 +#, c-format +msgid "Type mismatch of argument %d" +msgstr "Typfehler bei Argument %d" + +#: error.h:90 +#, c-format +msgid "%s of argument %d" +msgstr "%s bei Argument %d" + +#: error.h:91 +msgid "Type mismatch (need string variable)" +msgstr "Typfehler (Zeichenkette-Variable wird benötigt)" + +#: error.h:92 +msgid "Type mismatch (need numeric variable)" +msgstr "Typfehler (Numerische Variable wird benötigt)" + +#: error.h:93 +msgid "Type mismatch (need numeric value)" +msgstr "Typfehler (Numerischer Wert wird benötigt)" + +#: error.h:94 +msgid "Undeclared function or variable" +msgstr "Undeklarierte Funktion oder Variable" + +#: error.h:96 +msgid "Line out of scope" +msgstr "Zeile außerhalb des gültigen Bereiches" + +#: error.h:97 +msgid "Procedures do not return values" +msgstr "Prozeduren geben keine Werte zurück" + +#: error.h:98 +msgid "Unreachable statement" +msgstr "Unerreichbarer Befehl" + +#: error.h:99 +msgid "Wrong access mode" +msgstr "Falscher Zugriffsmodus" + +#: error.h:100 +msgid "`next' variable does not match `for' variable" +msgstr "`next' Variable passt nicht zu `for' Variable" + +#: error.h:101 +msgid "No such `image' line" +msgstr "Es gibt keine solche `image' Zeile" + +#: error.h:102 +msgid "Missing `image' format" +msgstr "Fehlendes `image' Format" + +#: error.h:103 +msgid "Missing relational operator" +msgstr "Fehlender Vergleichsoperator" + +#: error.h:107 +msgid "Missing `input' data" +msgstr "Fehlende Daten für `input'" + +#: error.h:108 +msgid "Missing character after underscore `_' in format string" +msgstr "In der Format-Zeichenkette fehlt nach dem Unterstrich `_' ein Zeichen" + +#: error.h:109 +msgid "Not allowed in interactive mode" +msgstr "Im interaktiven Modus nicht erlaubt" + +#: error.h:110 +msgid "Not allowed in program mode" +msgstr "Im Programm-Modus nicht erlaubt" + +#: error.h:111 +msgid "Break" +msgstr "Abbruch" + +#: error.h:112 +#, c-format +msgid "%s is undefined" +msgstr "%s ist nicht definiert" + +#: error.h:113 +#, c-format +msgid "%s is out of range" +msgstr "%s ist außerhalb des zulässigen Bereiches" + +#: error.h:114 +msgid "`resume' without exception" +msgstr "`resume' ohne Exception" + +#: error.h:115 +msgid "`return' without `gosub'" +msgstr "`return' ohne `gosub'" + +#: error.h:116 +#, c-format +msgid "Bad %s conversion" +msgstr "%s-Konvertierung nicht möglich" + +#: error.h:117 +#, c-format +msgid "Input/Output error (%s)" +msgstr "Ein-/Ausgabefehler (%s)" + +#: error.h:118 +#, c-format +msgid "Input/Output error (Creating `%s' failed: %s)" +msgstr "Ein-/Ausgabefehler (Erzeugung von `%s' nicht möglich: %s)" + +#: error.h:119 +#, c-format +msgid "Input/Output error (Closing `%s' failed: %s)" +msgstr "Ein-/Ausgabefehler (Schließen von `%s' nicht möglich: %s)" + +#: error.h:120 +#, c-format +msgid "Input/Output error (Opening `%s' failed: %s)" +msgstr "Ein-/Ausgabefehler (Öffnen von `%s' nicht möglich: %s)" + +#: error.h:121 +#, c-format +msgid "Setting environment variable failed (%s)" +msgstr "Die Umgebungsvariable kann nicht gesetzt werden (%s)." + +#: error.h:122 +msgid "Trying to redimension existing array" +msgstr "Bereits existierende Fehler können nicht redimensioniert werden." + +#: error.h:123 +#, c-format +msgid "Forking child process failed (%s)" +msgstr "Es konnte kein Prozeß erzeugt werden (%s)" + +#: error.h:124 +msgid "Invalid mode" +msgstr "Ungültiger Modus" + +#: error.h:125 +msgid "end of `data'" +msgstr "Ende von `data'" + +#: error.h:126 +msgid "Dimension mismatch" +msgstr "Die Dimensionen stimmen nicht überein" + +#: error.h:127 +#, c-format +msgid "Variable dimension must be 2 (is %d), base must be 0 or 1 (is %d)" +msgstr "" +"Die Variablendimension muß 2 sein (ist %d) und die Basis muss 0 oder 1 sein " +"(ist %d)" + +#: error.h:128 +msgid "Singular matrix" +msgstr "Singuläre Matrix" + +#: error.h:129 +msgid "Syntax error in print format" +msgstr "Syntaktisch fehlerhaftes Druckformat" + +#: error.h:130 +msgid "Out of memory" +msgstr "Nicht genug Speicher" + +#: error.h:131 +msgid "Restricted" +msgstr "" + +#: fs.c:80 +#, c-format +msgid "channel #%d not open" +msgstr "Kanal #%d nicht offen" + +#: fs.c:90 +#, c-format +msgid "channel #%d not opened for writing" +msgstr "Kanal #%d nicht zum Schreiben geöffnet" + +#: fs.c:96 +#, c-format +msgid "channel #%d not opened for reading" +msgstr "Kanal #%d nicht zum Lesen geöffnet" + +#: fs.c:102 +#, c-format +msgid "channel #%d not opened for random access" +msgstr "Kanal #%d nicht für direkten Zugriff geöffnet" + +#: fs.c:108 +#, c-format +msgid "channel #%d not opened for binary access" +msgstr "Kanal #%d nicht für binären Zugriff geöffnet" + +#: fs.c:114 +#, c-format +msgid "channel #%d not opened for random or binary access" +msgstr "Kanal #%d nicht für direkten oder binären Zugriff geöffnet" + +#: fs.c:241 +msgid "environment variable TERM is not set" +msgstr "Umgebungsvariable TERM ist nicht gesetzt" + +#: fs.c:248 +msgid "reading terminal description failed" +msgstr "Einlesen der Terminalbeschreibung nicht möglich" + +#: fs.c:253 +#, c-format +msgid "unknown terminal type %s" +msgstr "Unbekannter Terminaltyp %s" + +#: fs.c:281 +#, c-format +msgid "terminal type %s can not clear the screen" +msgstr "Terminaltyp %s kann den Bildschirm nicht löschen" + +#: fs.c:294 +#, c-format +msgid "terminal type %s can not position the cursor" +msgstr "Terminaltyp %s kann den Cursor nicht positionieren" + +#: fs.c:356 fs.c:362 fs.c:368 +msgid "This installation does not support terminal handling" +msgstr "Diese Installation bietet keine Terminalunterstützung" + +#: fs.c:396 fs.c:477 fs.c:550 fs.c:599 fs.c:632 +msgid "channel already open" +msgstr "Kanal bereits offen" + +#: fs.c:669 fs.c:692 fs.c:736 fs.c:768 fs.c:1338 +msgid "channel not open" +msgstr "Kanal #%d nicht offen" + +#: fs.c:924 fs.c:940 fs.c:956 +msgid "End of file" +msgstr "Dateiende" + +#: fs.c:1010 +msgid "negative width" +msgstr "Negative Breite" + +#: fs.c:1022 +msgid "non-positive zone width" +msgstr "Nichtpositive Zonenbreite" + +#: fs.c:1037 fs.c:1054 fs.c:1071 +msgid "not a terminal" +msgstr "ist kein Terminal" + +#: fs.c:1400 fs.c:1412 +msgid "Direct port access not available" +msgstr "Direkter Portzugriff ist nicht möglich" + +#: fs.c:1406 fs.c:1418 +msgid "Direct memory access not available" +msgstr "Direkter Speicherzugriff ist nicht möglich" + +#: getopt.c:681 +#, c-format +msgid "%s: option `%s' is ambiguous\n" +msgstr "%s: Option `%s' ist mehrdeutig.\n" + +#: getopt.c:705 +#, c-format +msgid "%s: option `--%s' doesn't allow an argument\n" +msgstr "%s: Option `--%s' erlaubt kein Argument.\n" + +#: getopt.c:710 +#, c-format +msgid "%s: option `%c%s' doesn't allow an argument\n" +msgstr "%s: Option `%c%s' erlaubt kein Argument.\n" + +#: getopt.c:727 getopt.c:900 +#, c-format +msgid "%s: option `%s' requires an argument\n" +msgstr "%s: Option `%s' benötigt ein Argument.\n" + +#. --option +#: getopt.c:756 +#, c-format +msgid "%s: unrecognized option `--%s'\n" +msgstr "%s: Unbekannte Option `--%s'\n" + +#. +option or -option +#: getopt.c:760 +#, c-format +msgid "%s: unrecognized option `%c%s'\n" +msgstr "%s: Unbekannte Option `%c%s'\n" + +#. 1003.2 specifies the format of this message. +#: getopt.c:786 +#, c-format +msgid "%s: illegal option -- %c\n" +msgstr "%s: Ungültige Option -- %c\n" + +#: getopt.c:789 +#, c-format +msgid "%s: invalid option -- %c\n" +msgstr "%s: Ungültige Option -- %c\n" + +#. 1003.2 specifies the format of this message. +#: getopt.c:819 getopt.c:949 +#, c-format +msgid "%s: option requires an argument -- %c\n" +msgstr "%s: Option benötigt ein Argument -- %c\n" + +#: getopt.c:866 +#, c-format +msgid "%s: option `-W %s' is ambiguous\n" +msgstr "%s: Option `-W %s' ist mehrdeutig\n" + +#: getopt.c:884 +#, c-format +msgid "%s: option `-W %s' doesn't allow an argument\n" +msgstr "%s: Option `-W %s' erlaubt kein Argument\n" + +#: global.c:197 +msgid "code" +msgstr "Code" + +#: global.c:258 +msgid "variable number" +msgstr "Variablennummer" + +#: global.c:283 +msgid "`asc' or `code' of empty string" +msgstr "`asc' oder `code' von leerer Zeichenkette" + +#: global.c:303 global.c:318 global.c:338 global.c:424 global.c:434 +#: global.c:552 global.c:614 global.c:652 global.c:670 global.c:690 +#: global.c:707 +msgid "number" +msgstr "Zahl" + +#: global.c:328 global.c:340 global.c:680 global.c:692 +msgid "digits" +msgstr "Ziffern" + +#: global.c:348 global.c:1279 global.c:1301 +msgid "character code" +msgstr "Zeichencode" + +#: global.c:383 global.c:399 +msgid "argument number" +msgstr "Argumentnummer" + +#: global.c:748 global.c:778 +msgid "time" +msgstr "Zeit" + +#: global.c:763 global.c:780 statement.c:179 statement.c:1036 statement.c:1208 +#: statement.c:1387 statement.c:1590 statement.c:1793 statement.c:2142 +#: statement.c:2262 statement.c:2477 statement.c:2808 statement.c:2815 +#: statement.c:2887 statement.c:3035 statement.c:3825 statement.c:3947 +#: statement.c:3981 statement.c:4040 +msgid "channel" +msgstr "Kanal" + +#: global.c:813 global.c:825 global.c:851 global.c:861 global.c:1033 +#: global.c:1058 global.c:1069 +msgid "start" +msgstr "Start" + +#: global.c:911 global.c:918 global.c:925 +msgid "Logarithm of negative value" +msgstr "Logarithmus von negativem Wert" + +#: global.c:1208 statement.c:2608 +msgid "limit" +msgstr "Grenze" + +#: global.c:1249 +msgid "Square root argument" +msgstr "Argument der Quadratwurzel" + +#: global.c:1307 global.c:1319 +msgid "`string$' of empty string" +msgstr "`string$' von leerer Zeichenkette" + +#: main.c:76 +#, fuzzy +msgid "Usage: bas [-b] [-l file] [-r] [-u] [program [argument ...]]\n" +msgstr "Aufruf: bas [-b] [-l Datei] [-u] [Programm [Argument ...]]\n" + +#: main.c:77 main.c:87 +#, fuzzy +msgid "" +" bas [--backslash-colon] [--lp file] [--restricted] [--uppercase] " +"[program [argument ...]]\n" +msgstr "" +" bas [--backslash-colon] [--lp Datei] [--uppercase] [Programm " +"[Argument ...]]\n" + +#: main.c:78 main.c:88 +msgid " bas -h|--help\n" +msgstr " bas -h|--help\n" + +#: main.c:79 main.c:89 +msgid " bas --version\n" +msgstr " bas --version\n" + +#: main.c:81 +msgid "Try `bas -h' or `bas --help' for more information.\n" +msgstr "Versuchen Sie `bas -h' oder `bas --help' für weitere Informationen.\n" + +#: main.c:86 +msgid "Usage: bas [-b] [-l file] [-u] [program [argument ...]]\n" +msgstr "Aufruf: bas [-b] [-l Datei] [-u] [Programm [Argument ...]]\n" + +#: main.c:91 +msgid "BASIC interpreter.\n" +msgstr "BASIC Interpreter.\n" + +#: main.c:93 +msgid "-b, --backslash-colon convert backslashs to colons\n" +msgstr "" +"-b, --backslash-colon Konvertiert linksseitige Schrägstriche in\n" +" Doppelpunkte\n" + +#: main.c:94 +msgid "-l, --lp write LPRINT output to file\n" +msgstr "-l, --lp Schreibt LPRINT Ausgaben in die Datei\n" + +#: main.c:95 +msgid "-r, --restricted forbid SHELL\n" +msgstr "" + +#: main.c:96 +msgid "-u, --uppercase output all tokens in uppercase\n" +msgstr "-u, --uppercase Alle Tokens in Großbuchstaben ausgeben\n" + +#: main.c:97 +msgid "-h, --help display this help and exit\n" +msgstr "-h, --help Diese Hilfe anzeigen und beenden\n" + +#: main.c:98 +msgid " --version output version information and exit\n" +msgstr " --version Versionsinformation ausgeben und beenden\n" + +#: main.c:100 +msgid "Report bugs to <michael@moria.de>.\n" +msgstr "Teilen Sie Fehler <michael@moria.de> mit.\n" + +#: main.c:105 +#, c-format +msgid "bas: Opening `%s' for line printer output failed (%s).\n" +msgstr "" +"bas: Die Datei `%s' kann nicht für Druckausgaben geöffnet werden (%s).\n" + +#: program.c:295 +#, c-format +msgid " in line %ld at:\n" +msgstr " in Zeile %ld:\n" + +#: program.c:302 +msgid " at: end of program\n" +msgstr ": Ende des Programms\n" + +#: program.c:307 +msgid " at: " +msgstr ": " + +#: program.c:309 +msgid "end of line\n" +msgstr "Zeilenende\n" + +#: program.c:744 +msgid "Function Referenced in line\n" +msgstr "Funktion Referenziert in Zeile\n" + +#: program.c:753 +msgid "Variable Referenced in line\n" +msgstr "Variable Referenziert in Zeile\n" + +#: program.c:762 +msgid "Gosub Referenced in line\n" +msgstr "Gosub Referenziert in Zeile\n" + +#: program.c:771 +msgid "Goto Referenced in line\n" +msgstr "Goto Referenziert in Zeile\n" + +#: statement.c:136 +msgid "directory" +msgstr "Verzeichnis" + +#: statement.c:224 +msgid "foreground colour" +msgstr "Vordergrundfarbe" + +#: statement.c:239 +msgid "background colour" +msgstr "Hintergrundfarbe" + +#: statement.c:256 +msgid "border colour" +msgstr "Rahmenfarbe" + +#: statement.c:415 value.c:58 +msgid "string" +msgstr "Zeichenkette" + +#: statement.c:570 statement.c:1355 statement.c:1483 statement.c:2547 +#: statement.c:2555 statement.c:2818 statement.c:3427 +msgid "file name" +msgstr "Dateiname" + +#: statement.c:674 +msgid "generating temporary file name failed" +msgstr "Erzeugung eines temporären Dateinamens nicht möglich" + +#: statement.c:890 +msgid "environment variable" +msgstr "Umgebungsvariable" + +#: statement.c:956 +msgid "return" +msgstr "Funktionswert" + +#: statement.c:1050 statement.c:1056 +msgid "field width" +msgstr "Feldbreite" + +#: statement.c:1187 +msgid "implicit STEP 1:" +msgstr "Impliziter Schritt 1:" + +#: statement.c:1227 +msgid "record number" +msgstr "Datensatznummer" + +#: statement.c:1245 +msgid "`put'/`get' data" +msgstr "`put'/`get' Daten" + +#: statement.c:1420 statement.c:1828 statement.c:2198 +msgid "end of file" +msgstr "Dateiende" + +#: statement.c:1556 statement.c:1562 +msgid "row" +msgstr "Zeile" + +#: statement.c:1567 statement.c:1573 +msgid "column" +msgstr "Spalte" + +#: statement.c:1628 statement.c:1728 statement.c:3855 statement.c:3915 +msgid "condition" +msgstr "Bedingung" + +#: statement.c:1901 +msgid "Too much input data\n" +msgstr "Zu viele Eingabedaten\n" + +#: statement.c:1990 +msgid "factor" +msgstr "Faktor" + +#. }}} +#: statement.c:2130 +msgid "matrix" +msgstr "Matrix" + +#: statement.c:2284 statement.c:3057 +msgid "format string" +msgstr "Formatzeichenkette" + +#: statement.c:2614 +msgid "step" +msgstr "Schrittweite" + +#: statement.c:2695 statement.c:3464 +msgid "selector" +msgstr "Auswahl" + +#: statement.c:2785 +msgid "mode or file" +msgstr "Modus oder Datei" + +#: statement.c:2828 statement.c:2840 statement.c:2913 statement.c:2925 +msgid "record length" +msgstr "Satzlänge" + +#: statement.c:2967 +msgid "array subscript base" +msgstr "Feldindexbasis" + +#: statement.c:3003 statement.c:3876 +msgid "address" +msgstr "Adresse" + +#: statement.c:3008 +msgid "output value" +msgstr "Ausgabewert" + +#: statement.c:3125 +msgid "count" +msgstr "Anzahl" + +#: statement.c:3196 +msgid "random number generator seed" +msgstr "Zufallszahlengenerator Start" + +#: statement.c:3239 +msgid "source file" +msgstr "Quelldatei" + +#: statement.c:3252 +msgid "destination file" +msgstr "Zieldatei" + +#: statement.c:3691 statement.c:3698 +msgid "pause" +msgstr "Pause" + +#: statement.c:3778 +msgid "Quit without saving? (y/n) " +msgstr "Beenden ohne zu speichern? (j/n) " + +#: statement.c:3785 +msgid "yes" +msgstr "ja" + +#: statement.c:3881 +msgid "mask" +msgstr "Maske" + +#: statement.c:3887 +msgid "select" +msgstr "Auswahl" + +#. }}} +#: statement.c:3963 statement.c:4046 +msgid "zone width" +msgstr "Zonenbreite" + +#: value.c:59 +msgid "void" +msgstr "leer" + +#: value.c:1289 +msgid "unpaired \\ in format" +msgstr "Unpaariges \\ im Format" + +#: var.c:100 +msgid "array index" +msgstr "Feldindex" + +#~ msgid "line number" +#~ msgstr "Zeilennummer" diff --git a/apps/interpreters/bas/error.h b/apps/interpreters/bas/error.h new file mode 100644 index 000000000..cb796707d --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/fs.c b/apps/interpreters/bas/fs.c new file mode 100644 index 000000000..1e933d441 --- /dev/null +++ b/apps/interpreters/bas/fs.c @@ -0,0 +1,1432 @@ +/* BASIC file system interface. */ +/* #includes */ /*{{{C}}}*//*{{{*/ +#include "config.h" + +#include <sys/time.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <assert.h> +#include <errno.h> +#include <fcntl.h> +#ifdef HAVE_GETTEXT +#include <libintl.h> +#define _(String) gettext(String) +#else +#define _(String) String +#endif +#include <math.h> +#include <signal.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <termios.h> +#include <time.h> +#ifdef HAVE_TERMCAP_H +#include <termcap.h> +#endif +#ifdef HAVE_CURSES_H +#include <curses.h> +#endif +#include <unistd.h> + +#include "fs.h" + +#ifdef USE_DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ +/* #defines */ /*{{{*/ +#define LINEWIDTH 80 +#define COLWIDTH 14 +/*}}}*/ + +static struct FileStream **file; +static int capacity; +static int used; +static struct termios origMode,rawMode; +static const int open_mode[4]={ 0, O_RDONLY, O_WRONLY, O_RDWR }; +static struct sigaction old_sigint, old_sigquit; +static int termchannel; + +const char *FS_errmsg; +static char FS_errmsgbuf[80]; +volatile int FS_intr; + +static int size(int dev) /*{{{*/ +{ + if (dev>=capacity) + { + int i; + struct FileStream **n; + + if ((n=(struct FileStream**)realloc(file,(dev+1)*sizeof(struct FileStream*)))==(struct FileStream**)0) + { + FS_errmsg=strerror(errno); + return -1; + } + file=n; + for (i=capacity; i<=dev; ++i) file[i]=(struct FileStream*)0; + capacity=dev+1; + } + return 0; +} +/*}}}*/ +static int opened(int dev, int mode) /*{{{*/ +{ + int fd=-1; + + if (dev<0 || dev>=capacity || file[dev]==(struct FileStream*)0) + { + snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not open"),dev); + FS_errmsg=FS_errmsgbuf; + return -1; + } + if (mode==-1) return 0; + switch (mode) + { + case 0: + { + fd=file[dev]->outfd; + if (fd==-1) snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not opened for writing"),dev); + break; + } + case 1: + { + fd=file[dev]->infd; + if (fd==-1) snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not opened for reading"),dev); + break; + } + case 2: + { + fd=file[dev]->randomfd; + if (fd==-1) snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not opened for random access"),dev); + break; + } + case 3: + { + fd=file[dev]->binaryfd; + if (fd==-1) snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not opened for binary access"),dev); + break; + } + case 4: + { + fd=(file[dev]->randomfd!=-1?file[dev]->randomfd:file[dev]->binaryfd); + if (fd==-1) snprintf(FS_errmsgbuf,sizeof(FS_errmsgbuf),_("channel #%d not opened for random or binary access"),dev); + break; + } + default: assert(0); + } + if (fd==-1) + { + FS_errmsg=FS_errmsgbuf; + return -1; + } + else return 0; +} +/*}}}*/ +static int refill(int dev) /*{{{*/ +{ + struct FileStream *f; + ssize_t len; + + f=file[dev]; + f->inSize=0; + len=read(f->infd,f->inBuf,sizeof(f->inBuf)); + if (len<=0) + { + f->inCapacity=0; + FS_errmsg=(len==-1?strerror(errno):(const char*)0); + return -1; + } + else + { + f->inCapacity=len; + return 0; + } +} +/*}}}*/ +static int edit(int chn, int onl) /*{{{*/ +{ + struct FileStream *f=file[chn]; + char *buf=f->inBuf; + char ch; + int r; + + for (buf=f->inBuf; buf<(f->inBuf+f->inCapacity); ++buf) + { + if (*buf>='\0' && *buf<' ') + { + FS_putChar(chn,'^'); + FS_putChar(chn,*buf?(*buf+'a'-1):'@'); + } + else FS_putChar(chn,*buf); + } + do + { + FS_flush(chn); + if ((r=read(f->infd,&ch,1))==-1) + { + f->inCapacity=0; + FS_errmsg=strerror(errno); + return -1; + } + else if (r==0 || (f->inCapacity==0 && ch==4)) + { + FS_errmsg=(char*)0; + return -1; + } + if (ch==rawMode.c_cc[VERASE]) + { + if (f->inCapacity) + { + if (f->inBuf[f->inCapacity-1]>='\0' && f->inBuf[f->inCapacity-1]<' ') FS_putChars(chn,"\b\b \b\b"); + else FS_putChars(chn,"\b \b"); + --f->inCapacity; + } + } + else if ((f->inCapacity+1)<sizeof(f->inBuf)) + { + if (ch!='\n') + { + if (ch>='\0' && ch<' ') + { + FS_putChar(chn,'^'); + FS_putChar(chn,ch?(ch+'a'-1):'@'); + } + else FS_putChar(chn,ch); + } + else if (onl) FS_putChar(chn,'\n'); + f->inBuf[f->inCapacity++]=ch; + } + } while (ch!='\n'); + return 0; +} +/*}}}*/ +static int outc(int ch) /*{{{*/ +{ + struct FileStream *f; + + if (opened(termchannel,0)==-1) return -1; + f=file[termchannel]; + if (f->outSize+1>=f->outCapacity && FS_flush(termchannel)==-1) return -1; + f->outBuf[f->outSize++]=ch; + FS_errmsg=(const char*)0; + return ch; +} +/*}}}*/ +#ifdef HAVE_TGETENT +static char *term,entrybuf[2048],*cap; +static char *cl,*cm,*ce,*cr,*md,*me,*AF,*AB; +static int Co,NC; + +static int mytputs(const char *str, int affcnt, int (*out)(int)) /*{{{*/ +{ +#ifdef TPUTS_RETURNS_VOID + tputs(str,affcnt,out); + return 0; +#else + return tputs(str,affcnt,out); +#endif +} +/*}}}*/ +static int initTerminal(int chn) /*{{{*/ +{ + static int init=0; + + if (!init) + { + termchannel=chn; + if ((term=getenv("TERM"))==(char*)0) + { + FS_errmsg=_("environment variable TERM is not set"); + return -1; + } + switch (tgetent(entrybuf,term)) + { + case -1: + { + FS_errmsg=_("reading terminal description failed"); + return -1; + } + case 0: + { + sprintf(FS_errmsgbuf,_("unknown terminal type %s"),term); + FS_errmsg=FS_errmsgbuf; + return -1; + } + case 1: + { + cl=tgetstr("cl",&cap); + cm=tgetstr("cm",&cap); + ce=tgetstr("ce",&cap); + cr=tgetstr("cr",&cap); + md=tgetstr("md",&cap); + me=tgetstr("me",&cap); + AF=tgetstr("AF",&cap); + AB=tgetstr("AB",&cap); + Co=tgetnum("Co"); + if ((NC=tgetnum("NC"))==-1) NC=0; + return 0; + } + } + init=1; + } + return 0; +} +/*}}}*/ +static int cls(int chn) /*{{{*/ +{ + if (cl==(char*)0) + { + sprintf(FS_errmsgbuf,_("terminal type %s can not clear the screen"),term); + FS_errmsg=FS_errmsgbuf; + return -1; + } + if (mytputs(cl,0,outc)==-1) return -1; + return 0; +} +/*}}}*/ +static int locate(int chn, int line, int column) /*{{{*/ +{ + termchannel=chn; + if (cm==(char*)0) + { + sprintf(FS_errmsgbuf,_("terminal type %s can not position the cursor"),term); + FS_errmsg=FS_errmsgbuf; + return -1; + } + if (mytputs(tgoto(cm,column-1,line-1),0,outc)==-1) return -1; + return 0; +} +/*}}}*/ +static int colour(int chn, int foreground, int background) /*{{{*/ +{ + if (AF && AB && Co>=8) + { + static int map[8]={ 0,4,2,6,1,5,3,7 }; + + if (foreground!=-1) + { + if (md && me && !(NC&32)) + { + if (foreground>7 && file[chn]->outforeground<=7) + { + if (mytputs(md,0,outc)==-1) return -1; + /* all attributes are gone now, need to set background again */ + if (background==-1) background=file[chn]->outbackground; + } + else if (foreground<=7 && file[chn]->outforeground>7) + { + if (mytputs(me,0,outc)==-1) return -1; + } + } + if (mytputs(tgoto(AF,0,map[foreground&7]),0,outc)==-1) return -1; + } + if (background!=-1) + { + if (mytputs(tgoto(AB,0,map[background&7]),0,outc)==-1) return -1; + } + } + return 0; +} +/*}}}*/ +static int resetcolour(int chn) /*{{{*/ +{ + if (me) mytputs(me,0,outc); + if (ce) mytputs(ce,0,outc); + return 0; +} +/*}}}*/ +static void carriage_return(int chn) /*{{{*/ +{ + if (cr) mytputs(cr,0,outc); + else outc('\r'); + outc('\n'); +} +/*}}}*/ +#else +static int initTerminal(int chn) /*{{{*/ +{ + termchannel=chn; + return 0; +} +/*}}}*/ +static int cls(int chn) /*{{{*/ +{ + FS_errmsg=_("This installation does not support terminal handling"); + return -1; +} +/*}}}*/ +static int locate(int chn, int line, int column) /*{{{*/ +{ + FS_errmsg=_("This installation does not support terminal handling"); + return -1; +} +/*}}}*/ +static int colour(int chn, int foreground, int background) /*{{{*/ +{ + FS_errmsg=_("This installation does not support terminal handling"); + return -1; +} +/*}}}*/ +static int resetcolour(int chn) /*{{{*/ +{ + return 0; +} +/*}}}*/ +static void carriage_return(int chn) /*{{{*/ +{ + outc('\r'); + outc('\n'); +} +/*}}}*/ +#endif +static void sigintr(int sig) /*{{{*/ +{ + FS_intr=1; + FS_allowIntr(0); +} +/*}}}*/ + +int FS_opendev(int chn, int infd, int outfd) /*{{{*/ +{ + if (size(chn)==-1) return -1; + if (file[chn]!=(struct FileStream*)0) + { + FS_errmsg=_("channel already open"); + return -1; + } + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->dev=1; + if ((file[chn]->tty=(infd==0 ? isatty(infd) && isatty(outfd) : 0))) + { + if (tcgetattr(infd,&origMode)==-1) + { + FS_errmsg=strerror(errno); + free(file[chn]); + file[chn]=(struct FileStream*)0; + return -1; + } + rawMode=origMode; + rawMode.c_lflag&=~(ICANON|ECHO); /* IEXTEN would disable IUCLC, breaking UC only terminals */ + rawMode.c_cc[VMIN]=1; + rawMode.c_cc[VTIME]=0; + rawMode.c_oflag&=~ONLCR; + if (tcsetattr(infd,TCSADRAIN,&rawMode)==-1) + { + FS_errmsg=strerror(errno); + free(file[chn]); + file[chn]=(struct FileStream*)0; + return -1; + } + initTerminal(chn); + } + file[chn]->recLength=1; + file[chn]->infd=infd; + file[chn]->inSize=0; + file[chn]->inCapacity=0; + file[chn]->outfd=outfd; + file[chn]->outPos=0; + file[chn]->outLineWidth=LINEWIDTH; + file[chn]->outColWidth=COLWIDTH; + file[chn]->outCapacity=sizeof(file[chn]->outBuf); + file[chn]->outSize=0; + file[chn]->outforeground=-1; + file[chn]->outbackground=-1; + file[chn]->randomfd=-1; + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return 0; +} +/*}}}*/ +int FS_openin(const char *name) /*{{{*/ +{ + int chn,fd; + + if ((fd=open(name,O_RDONLY))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + for (chn=0; chn<capacity; ++chn) if (file[chn]==(struct FileStream*)0) break; + if (size(chn)==-1) return -1; + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=1; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=fd; + file[chn]->inSize=0; + file[chn]->inCapacity=0; + file[chn]->outfd=-1; + file[chn]->randomfd=-1; + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_openinChn(int chn, const char *name, int mode) /*{{{*/ +{ + int fd; + mode_t fl; + + if (size(chn)==-1) return -1; + if (file[chn]!=(struct FileStream*)0) + { + FS_errmsg=_("channel already open"); + return -1; + } + fl=open_mode[mode]; + /* Serial devices on Linux should be opened non-blocking, otherwise the */ + /* open() may block already. Named pipes can not be opened non-blocking */ + /* in write-only mode, so first try non-blocking, then blocking. */ + if ((fd=open(name,fl|O_NONBLOCK))==-1) + { + if (errno!=ENXIO || (fd=open(name,fl))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + } + else if (fcntl(fd,F_SETFL,(long)fl)==-1) + { + FS_errmsg=strerror(errno); + close(fd); + return -1; + } + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=1; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=fd; + file[chn]->inSize=0; + file[chn]->inCapacity=0; + file[chn]->outfd=-1; + file[chn]->randomfd=-1; + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_openout(const char *name) /*{{{*/ +{ + int chn,fd; + + if ((fd=open(name,O_WRONLY|O_TRUNC|O_CREAT,0666))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + for (chn=0; chn<capacity; ++chn) if (file[chn]==(struct FileStream*)0) break; + if (size(chn)==-1) return -1; + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=1; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=-1; + file[chn]->outfd=fd; + file[chn]->outPos=0; + file[chn]->outLineWidth=LINEWIDTH; + file[chn]->outColWidth=COLWIDTH; + file[chn]->outSize=0; + file[chn]->outCapacity=sizeof(file[chn]->outBuf); + file[chn]->randomfd=-1; + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_openoutChn(int chn, const char *name, int mode, int append) /*{{{*/ +{ + int fd; + mode_t fl; + + if (size(chn)==-1) return -1; + if (file[chn]!=(struct FileStream*)0) + { + FS_errmsg=_("channel already open"); + return -1; + } + fl=open_mode[mode]|(append?O_APPEND:0); + /* Serial devices on Linux should be opened non-blocking, otherwise the */ + /* open() may block already. Named pipes can not be opened non-blocking */ + /* in write-only mode, so first try non-blocking, then blocking. */ + if ((fd=open(name,fl|O_CREAT|(append?0:O_TRUNC)|O_NONBLOCK,0666))==-1) + { + if (errno!=ENXIO || (fd=open(name,fl|O_CREAT|(append?0:O_TRUNC),0666))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + } + else if (fcntl(fd,F_SETFL,(long)fl)==-1) + { + FS_errmsg=strerror(errno); + close(fd); + return -1; + } + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=1; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=-1; + file[chn]->outfd=fd; + file[chn]->outPos=0; + file[chn]->outLineWidth=LINEWIDTH; + file[chn]->outColWidth=COLWIDTH; + file[chn]->outSize=0; + file[chn]->outCapacity=sizeof(file[chn]->outBuf); + file[chn]->randomfd=-1; + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_openrandomChn(int chn, const char *name, int mode, int recLength) /*{{{*/ +{ + int fd; + + assert(chn>=0); + assert(name!=(const char*)0); + assert(recLength>0); + if (size(chn)==-1) return -1; + if (file[chn]!=(struct FileStream*)0) + { + FS_errmsg=_("channel already open"); + return -1; + } + if ((fd=open(name,open_mode[mode]|O_CREAT,0666))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=recLength; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=-1; + file[chn]->outfd=-1; + file[chn]->randomfd=fd; + file[chn]->recBuf=malloc(recLength); + memset(file[chn]->recBuf,0,recLength); + StringField_new(&file[chn]->field); + file[chn]->binaryfd=-1; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_openbinaryChn(int chn, const char *name, int mode) /*{{{*/ +{ + int fd; + + assert(chn>=0); + assert(name!=(const char*)0); + if (size(chn)==-1) return -1; + if (file[chn]!=(struct FileStream*)0) + { + FS_errmsg=_("channel already open"); + return -1; + } + if ((fd=open(name,open_mode[mode]|O_CREAT,0666))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + file[chn]=malloc(sizeof(struct FileStream)); + file[chn]->recLength=1; + file[chn]->dev=0; + file[chn]->tty=0; + file[chn]->infd=-1; + file[chn]->outfd=-1; + file[chn]->randomfd=-1; + file[chn]->binaryfd=fd; + FS_errmsg=(const char*)0; + ++used; + return chn; +} +/*}}}*/ +int FS_freechn(void) /*{{{*/ +{ + int i; + + for (i=0; i<capacity && file[i]; ++i); + if (size(i)==-1) return -1; + return i; +} +/*}}}*/ +int FS_flush(int dev) /*{{{*/ +{ + ssize_t written; + size_t offset; + + if (file[dev]==(struct FileStream*)0) + { + FS_errmsg=_("channel not open"); + return -1; + } + offset=0; + while (offset<file[dev]->outSize) + { + written=write(file[dev]->outfd,file[dev]->outBuf+offset,file[dev]->outSize-offset); + if (written==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + else offset+=written; + } + file[dev]->outSize=0; + FS_errmsg=(const char*)0; + return 0; +} +/*}}}*/ +int FS_close(int dev) /*{{{*/ +{ + if (file[dev]==(struct FileStream*)0) + { + FS_errmsg=_("channel not open"); + return -1; + } + if (file[dev]->outfd>=0) + { + if (file[dev]->tty && (file[dev]->outforeground!=-1 || file[dev]->outbackground!=-1)) resetcolour(dev); + FS_flush(dev); + close(file[dev]->outfd); + } + if (file[dev]->randomfd>=0) + { + StringField_destroy(&file[dev]->field); + free(file[dev]->recBuf); + close(file[dev]->randomfd); + } + if (file[dev]->binaryfd>=0) + { + close(file[dev]->binaryfd); + } + if (file[dev]->tty) tcsetattr(file[dev]->infd,TCSADRAIN,&origMode); + if (file[dev]->infd>=0) close(file[dev]->infd); + free(file[dev]); + file[dev]=(struct FileStream*)0; + FS_errmsg=(const char*)0; + if (--used==0) + { + free(file); + capacity=0; + } + return 0; +} +/*}}}*/ +int FS_istty(int chn) /*{{{*/ +{ + return (file[chn] && file[chn]->tty); +} +/*}}}*/ +int FS_lock(int chn, off_t offset, off_t length, int mode, int w) /*{{{*/ +{ + int fd; + struct flock recordLock; + + if (file[chn]==(struct FileStream*)0) + { + FS_errmsg=_("channel not open"); + return -1; + } + if ((fd=file[chn]->infd)==-1) + if ((fd=file[chn]->outfd)==-1) + if ((fd=file[chn]->randomfd)==-1) + if ((fd=file[chn]->binaryfd)==-1) assert(0); + recordLock.l_whence=SEEK_SET; + recordLock.l_start=offset; + recordLock.l_len=length; + switch (mode) + { + case FS_LOCK_SHARED: recordLock.l_type=F_RDLCK; break; + case FS_LOCK_EXCLUSIVE: recordLock.l_type=F_WRLCK; break; + case FS_LOCK_NONE: recordLock.l_type=F_UNLCK; break; + default: assert(0); + } + if (fcntl(fd,w ? F_SETLKW : F_SETLK,&recordLock)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +int FS_truncate(int chn) /*{{{*/ +{ + int fd; + off_t o; + + if (file[chn]==(struct FileStream*)0) + { + FS_errmsg=_("channel not open"); + return -1; + } + if ((fd=file[chn]->infd)==-1) + if ((fd=file[chn]->outfd)==-1) + if ((fd=file[chn]->randomfd)==-1) + if ((fd=file[chn]->binaryfd)==-1) assert(0); + if ((o=lseek(fd,SEEK_CUR,0))==(off_t)-1 || ftruncate(fd,o+1)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +void FS_shellmode(int dev) /*{{{*/ +{ + struct sigaction interrupt; + + if (file[dev]->tty) tcsetattr(file[dev]->infd,TCSADRAIN,&origMode); + interrupt.sa_flags=0; + sigemptyset(&interrupt.sa_mask); + interrupt.sa_handler=SIG_IGN; + sigaction(SIGINT,&interrupt,&old_sigint); + sigaction(SIGQUIT,&interrupt,&old_sigquit); +} +/*}}}*/ +void FS_fsmode(int chn) /*{{{*/ +{ + if (file[chn]->tty) tcsetattr(file[chn]->infd,TCSADRAIN,&rawMode); + sigaction(SIGINT,&old_sigint,(struct sigaction *)0); + sigaction(SIGQUIT,&old_sigquit,(struct sigaction *)0); +} +/*}}}*/ +void FS_xonxoff(int chn, int on) /*{{{*/ +{ + if (file[chn]->tty) + { + if (on) rawMode.c_iflag|=(IXON|IXOFF); + else rawMode.c_iflag&=~(IXON|IXOFF); + tcsetattr(file[chn]->infd,TCSADRAIN,&rawMode); + } +} +/*}}}*/ +int FS_put(int chn) /*{{{*/ +{ + ssize_t offset,written; + + if (opened(chn,2)==-1) return -1; + offset=0; + while (offset<file[chn]->recLength) + { + written=write(file[chn]->randomfd,file[chn]->recBuf+offset,file[chn]->recLength-offset); + if (written==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + else offset+=written; + } + FS_errmsg=(const char*)0; + return 0; +} +/*}}}*/ +int FS_putChar(int dev, char ch) /*{{{*/ +{ + struct FileStream *f; + + if (opened(dev,0)==-1) return -1; + f=file[dev]; + if (ch=='\n') f->outPos=0; + if (ch=='\b' && f->outPos) --f->outPos; + if (f->outSize+2>=f->outCapacity && FS_flush(dev)==-1) return -1; + if (f->outLineWidth && f->outPos==f->outLineWidth) + { + if (FS_istty(dev)) carriage_return(dev); + else f->outBuf[f->outSize++]='\n'; + f->outPos=0; + } + if (FS_istty(dev) && ch=='\n') carriage_return(dev); + else f->outBuf[f->outSize++]=ch; + if (ch!='\n' && ch!='\b') ++f->outPos; + FS_errmsg=(const char*)0; + return 0; +} +/*}}}*/ +int FS_putChars(int dev, const char *chars) /*{{{*/ +{ + while (*chars) if (FS_putChar(dev,*chars++)==-1) return -1; + return 0; +} +/*}}}*/ +int FS_putString(int dev, const struct String *s) /*{{{*/ +{ + size_t len=s->length; + const char *c=s->character; + + while (len) if (FS_putChar(dev,*c++)==-1) return -1; else --len; + return 0; +} +/*}}}*/ +int FS_putItem(int dev, const struct String *s) /*{{{*/ +{ + struct FileStream *f; + + if (opened(dev,0)==-1) return -1; + f=file[dev]; + if (f->outPos && f->outPos+s->length>f->outLineWidth) FS_nextline(dev); + return FS_putString(dev, s); +} +/*}}}*/ +int FS_putbinaryString(int chn, const struct String *s) /*{{{*/ +{ + if (opened(chn,3)==-1) return -1; + if (s->length && write(file[chn]->binaryfd,s->character,s->length)!=s->length) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +int FS_putbinaryInteger(int chn, long int x) /*{{{*/ +{ + char s[sizeof(long int)]; + int i; + + if (opened(chn,3)==-1) return -1; + for (i=0; i<sizeof(x); ++i,x>>=8) s[i]=(x&0xff); + if (write(file[chn]->binaryfd,s,sizeof(s))!=sizeof(s)) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +int FS_putbinaryReal(int chn, double x) /*{{{*/ +{ + if (opened(chn,3)==-1) return -1; + if (write(file[chn]->binaryfd,&x,sizeof(x))!=sizeof(x)) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +int FS_getbinaryString(int chn, struct String *s) /*{{{*/ +{ + ssize_t len; + + if (opened(chn,3)==-1) return -1; + if (s->length && (len=read(file[chn]->binaryfd,s->character,s->length))!=s->length) + { + if (len==-1) FS_errmsg=strerror(errno); + else FS_errmsg=_("End of file"); + return -1; + } + return 0; +} +/*}}}*/ +int FS_getbinaryInteger(int chn, long int *x) /*{{{*/ +{ + char s[sizeof(long int)]; + int i; + ssize_t len; + + if (opened(chn,3)==-1) return -1; + if ((len=read(file[chn]->binaryfd,s,sizeof(s)))!=sizeof(s)) + { + if (len==-1) FS_errmsg=strerror(errno); + else FS_errmsg=_("End of file"); + return -1; + } + *x=(s[sizeof(x)-1]<0) ? -1 : 0; + for (i=sizeof(s)-1; i>=0; --i) *x=(*x<<8)|(s[i]&0xff); + return 0; +} +/*}}}*/ +int FS_getbinaryReal(int chn, double *x) /*{{{*/ +{ + ssize_t len; + + if (opened(chn,3)==-1) return -1; + if ((len=read(file[chn]->binaryfd,x,sizeof(*x)))!=sizeof(*x)) + { + if (len==-1) FS_errmsg=strerror(errno); + else FS_errmsg=_("End of file"); + return -1; + } + return 0; +} +/*}}}*/ +int FS_nextcol(int dev) /*{{{*/ +{ + struct FileStream *f; + + if (opened(dev,0)==-1) return -1; + f=file[dev]; + if + ( + f->outPos%f->outColWidth + && f->outLineWidth + && ((f->outPos/f->outColWidth+2)*f->outColWidth)>f->outLineWidth + ) + { + return FS_putChar(dev,'\n'); + } + if (!(f->outPos%f->outColWidth) && FS_putChar(dev,' ')==-1) return -1; + while (f->outPos%f->outColWidth) if (FS_putChar(dev,' ')==-1) return -1; + return 0; +} +/*}}}*/ +int FS_nextline(int dev) /*{{{*/ +{ + struct FileStream *f; + + if (opened(dev,0)==-1) return -1; + f=file[dev]; + if + ( + f->outPos + && FS_putChar(dev,'\n')==-1 + ) return -1; + return 0; +} +/*}}}*/ +int FS_tab(int dev, int position) /*{{{*/ +{ + struct FileStream *f=file[dev]; + + if (f->outLineWidth && position>=f->outLineWidth) position=f->outLineWidth-1; + while (f->outPos<(position-1)) if (FS_putChar(dev,' ')==-1) return -1; + return 0; +} +/*}}}*/ +int FS_width(int dev, int width) /*{{{*/ +{ + if (opened(dev,0)==-1) return -1; + if (width<0) + { + FS_errmsg=_("negative width"); + return -1; + } + file[dev]->outLineWidth=width; + return 0; +} +/*}}}*/ +int FS_zone(int dev, int zone) /*{{{*/ +{ + if (opened(dev,0)==-1) return -1; + if (zone<=0) + { + FS_errmsg=_("non-positive zone width"); + return -1; + } + file[dev]->outColWidth=zone; + return 0; +} +/*}}}*/ +int FS_cls(int chn) /*{{{*/ +{ + struct FileStream *f; + + if (opened(chn,0)==-1) return -1; + f=file[chn]; + if (!f->tty) + { + FS_errmsg=_("not a terminal"); + return -1; + } + if (cls(chn)==-1) return -1; + if (FS_flush(chn)==-1) return -1; + f->outPos=0; + return 0; +} +/*}}}*/ +int FS_locate(int chn, int line, int column) /*{{{*/ +{ + struct FileStream *f; + + if (opened(chn,0)==-1) return -1; + f=file[chn]; + if (!f->tty) + { + FS_errmsg=_("not a terminal"); + return -1; + } + if (locate(chn,line,column)==-1) return -1; + if (FS_flush(chn)==-1) return -1; + f->outPos=column-1; + return 0; +} +/*}}}*/ +int FS_colour(int chn, int foreground, int background) /*{{{*/ +{ + struct FileStream *f; + + if (opened(chn,0)==-1) return -1; + f=file[chn]; + if (!f->tty) + { + FS_errmsg=_("not a terminal"); + return -1; + } + if (colour(chn,foreground,background)==-1) return -1; + f->outforeground=foreground; + f->outbackground=background; + return 0; +} +/*}}}*/ +int FS_getChar(int dev) /*{{{*/ +{ + struct FileStream *f; + + if (opened(dev,1)==-1) return -1; + f=file[dev]; + if (f->inSize==f->inCapacity && refill(dev)==-1) return -1; + FS_errmsg=(const char*)0; + if (f->inSize+1==f->inCapacity) + { + char ch=f->inBuf[f->inSize]; + + f->inSize=f->inCapacity=0; + return ch; + } + else return f->inBuf[f->inSize++]; +} +/*}}}*/ +int FS_get(int chn) /*{{{*/ +{ + ssize_t offset,rd; + + if (opened(chn,2)==-1) return -1; + offset=0; + while (offset<file[chn]->recLength) + { + rd=read(file[chn]->randomfd,file[chn]->recBuf+offset,file[chn]->recLength-offset); + if (rd==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + else offset+=rd; + } + FS_errmsg=(const char*)0; + return 0; +} +/*}}}*/ +int FS_inkeyChar(int dev, int ms) /*{{{*/ +{ + struct FileStream *f; + char c; + ssize_t len; +#ifdef USE_SELECT + fd_set just_infd; + struct timeval timeout; +#else + struct termios timedread; +#endif + + if (opened(dev,1)==-1) return -1; + f=file[dev]; + if (f->inSize<f->inCapacity) return f->inBuf[f->inSize++]; + +#ifdef USE_SELECT + FD_ZERO(&just_infd); + FD_SET(f->infd,&just_infd); + timeout.tv_sec=ms/1000; + timeout.tv_usec=(ms%1000)*1000; + switch (select(f->infd+1,&just_infd,(fd_set*)0,(fd_set*)0,&timeout)) + { + case 1: + { + FS_errmsg=(const char*)0; + len=read(f->infd,&c,1); + return (len==1?c:-1); + } + case 0: + { + FS_errmsg=(const char*)0; + return -1; + } + case -1: + { + FS_errmsg=strerror(errno); + return -1; + } + default: assert(0); + } + return 0; +#else + timedread=rawMode; + timedread.c_cc[VMIN]=0; + timedread.c_cc[VTIME]=(ms?ms:100)/100; + if (tcsetattr(f->infd,TCSADRAIN,&timedread)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + FS_errmsg=(const char*)0; + len=read(f->infd,&c,1); + tcsetattr(f->infd,TCSADRAIN,&rawMode); + if (len==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return (len==1?c:-1); +#endif +} +/*}}}*/ +void FS_sleep(double s) /*{{{*/ +{ +#ifdef HAVE_NANOSLEEP + struct timespec p; + + p.tv_sec=floor(s); + p.tv_nsec=1000000000*(s-floor(s)); + + nanosleep(&p,(struct timespec*)0); +#else + sleep((int)s); +#endif +} +/*}}}*/ +int FS_eof(int chn) /*{{{*/ +{ + struct FileStream *f; + + if (opened(chn,1)==-1) return -1; + f=file[chn]; + if (f->inSize==f->inCapacity && refill(chn)==-1) return 1; + return 0; +} +/*}}}*/ +long int FS_loc(int chn) /*{{{*/ +{ + int fd; + off_t cur,offset=0; + + if (opened(chn,-1)==-1) return -1; + if (file[chn]->infd!=-1) { fd=file[chn]->infd; offset=-file[chn]->inCapacity+file[chn]->inSize; } + else if (file[chn]->outfd!=-1) { fd=file[chn]->outfd; offset=file[chn]->outSize; } + else if (file[chn]->randomfd!=-1) fd=file[chn]->randomfd; + else fd=file[chn]->binaryfd; + assert(fd!=-1); + if ((cur=lseek(fd,0,SEEK_CUR))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return (cur+offset)/file[chn]->recLength; +} +/*}}}*/ +long int FS_lof(int chn) /*{{{*/ +{ + struct stat buf; + int fd; + + if (opened(chn,-1)==-1) return -1; + if (file[chn]->infd!=-1) fd=file[chn]->infd; + else if (file[chn]->outfd!=-1) fd=file[chn]->outfd; + else if (file[chn]->randomfd!=-1) fd=file[chn]->randomfd; + else fd=file[chn]->binaryfd; + assert(fd!=-1); + if (fstat(fd,&buf)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return buf.st_size/file[chn]->recLength; +} +/*}}}*/ +long int FS_recLength(int chn) /*{{{*/ +{ + if (opened(chn,2)==-1) return -1; + return file[chn]->recLength; +} +/*}}}*/ +void FS_field(int chn, struct String *s, long int position, long int length) /*{{{*/ +{ + assert(file[chn]); + String_joinField(s,&file[chn]->field,file[chn]->recBuf+position,length); +} +/*}}}*/ +int FS_seek(int chn, long int record) /*{{{*/ +{ + if (opened(chn,2)!=-1) + { + if (lseek(file[chn]->randomfd,(off_t)record*file[chn]->recLength,SEEK_SET)!=-1) return 0; + FS_errmsg=strerror(errno); + } + else if (opened(chn,4)!=-1) + { + if (lseek(file[chn]->binaryfd,(off_t)record,SEEK_SET)!=-1) return 0; + FS_errmsg=strerror(errno); + } + return -1; +} +/*}}}*/ +int FS_appendToString(int chn, struct String *s, int onl) /*{{{*/ +{ + size_t new; + char *n; + struct FileStream *f=file[chn]; + int c; + + if (f->tty && f->inSize==f->inCapacity) + { + if (edit(chn,onl)==-1) return (FS_errmsg ? -1 : 0); + } + do + { + n=f->inBuf+f->inSize; + while (1) + { + if (n==f->inBuf+f->inCapacity) break; + c=*n++; + if (c=='\n') break; + } + new=n-(f->inBuf+f->inSize); + if (new) + { + size_t offset=s->length; + + if (String_size(s,offset+new)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + memcpy(s->character+offset,f->inBuf+f->inSize,new); + f->inSize+=new; + if (*(n-1)=='\n') + { + if (f->inSize==f->inCapacity) f->inSize=f->inCapacity=0; + if (s->length>=2 && s->character[s->length-2]=='\r') + { + s->character[s->length-2]='\n'; + --s->length; + } + return 0; + } + } + if ((c=FS_getChar(chn))>=0) String_appendChar(s,c); + if (c=='\n') + { + if (s->length>=2 && s->character[s->length-2]=='\r') + { + s->character[s->length-2]='\n'; + --s->length; + } + return 0; + } + } while (c!=-1); + return (FS_errmsg ? -1 : 0); +} +/*}}}*/ +void FS_closefiles(void) /*{{{*/ +{ + int i; + + for (i=0; i<capacity; ++i) if (file[i] && !file[i]->dev) FS_close(i); +} +/*}}}*/ +int FS_charpos(int chn) /*{{{*/ +{ + if (file[chn]==(struct FileStream*)0) + { + FS_errmsg=_("channel not open"); + return -1; + } + return (file[chn]->outPos); +} +/*}}}*/ +int FS_copy(const char *from, const char *to) /*{{{*/ +{ + int infd,outfd; + char buf[4096]; + ssize_t inlen,outlen=-1; + + if ((infd=open(from,O_RDONLY))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + if ((outfd=open(to,O_WRONLY|O_CREAT|O_TRUNC,0666))==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + while ((inlen=read(infd,&buf,sizeof(buf)))>0) + { + ssize_t off=0; + + while (inlen && (outlen=write(outfd,&buf+off,inlen))>0) + { + off+=outlen; + inlen-=outlen; + } + if (outlen==-1) + { + FS_errmsg=strerror(errno); + close(infd); + close(outfd); + return -1; + } + } + if (inlen==-1) + { + FS_errmsg=strerror(errno); + close(infd); + close(outfd); + return -1; + } + if (close(infd)==-1) + { + FS_errmsg=strerror(errno); + close(outfd); + return -1; + } + if (close(outfd)==-1) + { + FS_errmsg=strerror(errno); + return -1; + } + return 0; +} +/*}}}*/ +int FS_portInput(int address) /*{{{*/ +{ + FS_errmsg=_("Direct port access not available"); + return -1; +} +/*}}}*/ +int FS_memInput(int address) /*{{{*/ +{ + FS_errmsg=_("Direct memory access not available"); + return -1; +} +/*}}}*/ +int FS_portOutput(int address, int value) /*{{{*/ +{ + FS_errmsg=_("Direct port access not available"); + return -1; +} +/*}}}*/ +int FS_memOutput(int address, int value) /*{{{*/ +{ + FS_errmsg=_("Direct memory access not available"); + return -1; +} +/*}}}*/ +void FS_allowIntr(int on) /*{{{*/ +{ + struct sigaction breakact; + + breakact.sa_handler=on ? sigintr : SIG_IGN; + sigemptyset(&breakact.sa_mask); + sigaddset(&breakact.sa_mask,SIGINT); + breakact.sa_flags=0; + sigaction(SIGINT,&breakact,(struct sigaction *)0); +} +/*}}}*/ diff --git a/apps/interpreters/bas/fs.h b/apps/interpreters/bas/fs.h new file mode 100644 index 000000000..dfe8e6b18 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/getopt.c b/apps/interpreters/bas/getopt.c new file mode 100644 index 000000000..5dd861852 --- /dev/null +++ b/apps/interpreters/bas/getopt.c @@ -0,0 +1,1052 @@ +/* Getopt for GNU. + NOTE: getopt is now part of the C library, so if you don't know what + "Keep this file name-space clean" means, talk to bug-glibc@gnu.org + before changing it! + + Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94, 95, 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. */ + +/* This tells Alpha OSF/1 not to define a getopt prototype in <stdio.h>. + Ditto for AIX 3.2 and <stdlib.h>. */ +#ifndef _NO_PROTO +#define _NO_PROTO +#endif + +#include "config.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> +#include <string.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__ +/* Don't include stdlib.h for non-GNU C libraries because some of them + contain conflicting prototypes for getopt. */ +#include <stdlib.h> +#include <unistd.h> +#endif /* GNU C library. */ + +#ifdef VMS +#include <unixlib.h> +#if HAVE_STRING_H - 0 +#include <string.h> +#endif +#endif + +#if defined (WINDOWS32) && !defined (__CYGWIN32__) +/* It's not Unix, really. See? Capital letters. */ +#include <windows.h> +#define getpid() GetCurrentProcessId() +#endif + +#ifndef _ +/* This is for other GNU distributions with internationalized messages. + When compiling libc, the _ macro is predefined. */ +#ifdef HAVE_LIBINTL_H +# include <libintl.h> +# define _(msgid) gettext (msgid) +#else +# define _(msgid) (msgid) +#endif +#endif + +/* This version of `getopt' appears to the caller like standard Unix `getopt' + but it behaves differently for the user, since it allows the user + to intersperse the options with the other arguments. + + As `getopt' works, it permutes the elements of ARGV so that, + when it is done, all the options precede everything else. Thus + all application programs are extended to handle flexible argument order. + + Setting the environment variable POSIXLY_CORRECT disables permutation. + Then the behavior is completely standard. + + GNU application programs can use a third alternative mode in which + they can distinguish the relative order of options and other arguments. */ + +#include "getopt.h" + +/* 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. */ + +char *optarg = NULL; + +/* 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. */ + +/* 1003.2 says this must be 1 before any call. */ +int optind = 1; + +/* Formerly, initialization of getopt depended on optind==0, which + causes problems with re-calling getopt as programs generally don't + know that. */ + +int __getopt_initialized = 0; + +/* The next char to be scanned in the option-element + in which the last option character we returned was found. + This allows us to pick up the scan where we left off. + + If this is zero, or a null string, it means resume the scan + by advancing to the next ARGV-element. */ + +static char *nextchar; + +/* Callers store zero here to inhibit the error message + for unrecognized options. */ + +int opterr = 1; + +/* Set to an option character which was unrecognized. + This must be initialized on some systems to avoid linking in the + system's own getopt implementation. */ + +int optopt = '?'; + +/* Describe how to deal with options that follow non-option ARGV-elements. + + If the caller did not specify anything, + the default is REQUIRE_ORDER if the environment variable + POSIXLY_CORRECT is defined, PERMUTE otherwise. + + REQUIRE_ORDER means don't recognize them as options; + stop option processing when the first non-option is seen. + This is what Unix does. + This mode of operation is selected by either setting the environment + variable POSIXLY_CORRECT, or using `+' as the first character + of the list of option characters. + + PERMUTE is the default. We permute the contents of ARGV as we scan, + so that eventually all the non-options are at the end. This allows options + to be given in any order, even with programs that were not written to + expect this. + + RETURN_IN_ORDER is an option available to programs that were written + to expect options and other ARGV-elements in any order and that care about + the ordering of the two. We describe each non-option ARGV-element + as if it were the argument of an option with character code 1. + Using `-' as the first character of the list of option characters + selects this mode of operation. + + The special argument `--' forces an end of option-scanning regardless + of the value of `ordering'. In the case of RETURN_IN_ORDER, only + `--' can cause `getopt' to return -1 with `optind' != ARGC. */ + +static enum +{ + REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER +} ordering; + +/* Value of POSIXLY_CORRECT environment variable. */ +static char *posixly_correct; + +#ifdef __GNU_LIBRARY__ +/* We want to avoid inclusion of string.h with non-GNU libraries + because there are many ways it can cause trouble. + On some systems, it contains special magic macros that don't work + in GCC. */ +#include <string.h> +#define my_index strchr +#else + +/* Avoid depending on library functions or files + whose names are inconsistent. */ + +char *getenv (); + +static char * +my_index (str, chr) + const char *str; + int chr; +{ + while (*str) + { + if (*str == chr) + return (char *) str; + str++; + } + return 0; +} + +/* If using GCC, we can safely declare strlen this way. + If not using GCC, it is ok not to declare it. */ +#ifdef __GNUC__ +/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h. + That was relevant to code that was here before. */ +#if !defined (__STDC__) || !__STDC__ +/* gcc with -traditional declares the built-in strlen to return int, + and has done so at least since version 2.4.5. -- rms. */ +extern int strlen (const char *); +#endif /* not __STDC__ */ +#endif /* __GNUC__ */ + +#endif /* not __GNU_LIBRARY__ */ + +/* Handle permutation of arguments. */ + +/* Describe the part of ARGV that contains non-options that have + been skipped. `first_nonopt' is the index in ARGV of the first of them; + `last_nonopt' is the index after the last of them. */ + +static int first_nonopt; +static int last_nonopt; + +#ifdef _LIBC +/* Bash 2.0 gives us an environment variable containing flags + indicating ARGV elements that should not be considered arguments. */ + +/* Defined in getopt_init.c */ +extern char *__getopt_nonoption_flags; + +static int nonoption_flags_max_len; +static int nonoption_flags_len; + +static int original_argc; +static char *const *original_argv; + +extern pid_t __libc_pid; + +/* Make sure the environment variable bash 2.0 puts in the environment + is valid for the getopt call we must make sure that the ARGV passed + to getopt is that one passed to the process. */ +static void +__attribute__ ((unused)) +store_args_and_env (int argc, char *const *argv) +{ + /* XXX This is no good solution. We should rather copy the args so + that we can compare them later. But we must not use malloc(3). */ + original_argc = argc; + original_argv = argv; +} +text_set_element (__libc_subinit, store_args_and_env); + +# define SWAP_FLAGS(ch1, ch2) \ + if (nonoption_flags_len > 0) \ + { \ + char __tmp = __getopt_nonoption_flags[ch1]; \ + __getopt_nonoption_flags[ch1] = __getopt_nonoption_flags[ch2]; \ + __getopt_nonoption_flags[ch2] = __tmp; \ + } +#else /* !_LIBC */ +# define SWAP_FLAGS(ch1, ch2) +#endif /* _LIBC */ + +/* Exchange two adjacent subsequences of ARGV. + One subsequence is elements [first_nonopt,last_nonopt) + which contains all the non-options that have been skipped so far. + The other is elements [last_nonopt,optind), which contains all + the options processed since those non-options were skipped. + + `first_nonopt' and `last_nonopt' are relocated so that they describe + the new indices of the non-options in ARGV after they are moved. */ + +#if defined (__STDC__) && __STDC__ +static void exchange (char **); +#endif + +static void +exchange (argv) + char **argv; +{ + int bottom = first_nonopt; + int middle = last_nonopt; + int top = optind; + char *tem; + + /* Exchange the shorter segment with the far end of the longer segment. + That puts the shorter segment into the right place. + It leaves the longer segment in the right place overall, + but it consists of two parts that need to be swapped next. */ + +#ifdef _LIBC + /* First make sure the handling of the `__getopt_nonoption_flags' + string can work normally. Our top argument must be in the range + of the string. */ + if (nonoption_flags_len > 0 && top >= nonoption_flags_max_len) + { + /* We must extend the array. The user plays games with us and + presents new arguments. */ + char *new_str = malloc (top + 1); + if (new_str == NULL) + nonoption_flags_len = nonoption_flags_max_len = 0; + else + { + memcpy (new_str, __getopt_nonoption_flags, nonoption_flags_max_len); + memset (&new_str[nonoption_flags_max_len], '\0', + top + 1 - nonoption_flags_max_len); + nonoption_flags_max_len = top + 1; + __getopt_nonoption_flags = new_str; + } + } +#endif + + while (top > middle && middle > bottom) + { + if (top - middle > middle - bottom) + { + /* Bottom segment is the short one. */ + int len = middle - bottom; + register int i; + + /* Swap it with the top part of the top segment. */ + for (i = 0; i < len; i++) + { + tem = argv[bottom + i]; + argv[bottom + i] = argv[top - (middle - bottom) + i]; + argv[top - (middle - bottom) + i] = tem; + SWAP_FLAGS (bottom + i, top - (middle - bottom) + i); + } + /* Exclude the moved bottom segment from further swapping. */ + top -= len; + } + else + { + /* Top segment is the short one. */ + int len = top - middle; + register int i; + + /* Swap it with the bottom part of the bottom segment. */ + for (i = 0; i < len; i++) + { + tem = argv[bottom + i]; + argv[bottom + i] = argv[middle + i]; + argv[middle + i] = tem; + SWAP_FLAGS (bottom + i, middle + i); + } + /* Exclude the moved top segment from further swapping. */ + bottom += len; + } + } + + /* Update records for the slots the non-options now occupy. */ + + first_nonopt += (optind - last_nonopt); + last_nonopt = optind; +} + +/* Initialize the internal data when the first call is made. */ + +#if defined (__STDC__) && __STDC__ +static const char *_getopt_initialize (int, char *const *, const char *); +#endif +static const char * +_getopt_initialize (argc, argv, optstring) + int argc; + char *const *argv; + const char *optstring; +{ + /* Start processing options with ARGV-element 1 (since ARGV-element 0 + is the program name); the sequence of previously skipped + non-option ARGV-elements is empty. */ + + first_nonopt = last_nonopt = optind; + + nextchar = NULL; + + posixly_correct = getenv ("POSIXLY_CORRECT"); + + /* Determine how to handle the ordering of options and nonoptions. */ + + if (optstring[0] == '-') + { + ordering = RETURN_IN_ORDER; + ++optstring; + } + else if (optstring[0] == '+') + { + ordering = REQUIRE_ORDER; + ++optstring; + } + else if (posixly_correct != NULL) + ordering = REQUIRE_ORDER; + else + ordering = PERMUTE; + +#ifdef _LIBC + if (posixly_correct == NULL + && argc == original_argc && argv == original_argv) + { + if (nonoption_flags_max_len == 0) + { + if (__getopt_nonoption_flags == NULL + || __getopt_nonoption_flags[0] == '\0') + nonoption_flags_max_len = -1; + else + { + const char *orig_str = __getopt_nonoption_flags; + int len = nonoption_flags_max_len = strlen (orig_str); + if (nonoption_flags_max_len < argc) + nonoption_flags_max_len = argc; + __getopt_nonoption_flags = + (char *) malloc (nonoption_flags_max_len); + if (__getopt_nonoption_flags == NULL) + nonoption_flags_max_len = -1; + else + { + memcpy (__getopt_nonoption_flags, orig_str, len); + memset (&__getopt_nonoption_flags[len], '\0', + nonoption_flags_max_len - len); + } + } + } + nonoption_flags_len = nonoption_flags_max_len; + } + else + nonoption_flags_len = 0; +#endif + + return optstring; +} + +/* Scan elements of ARGV (whose length is ARGC) for option characters + given in OPTSTRING. + + If an element of ARGV starts with '-', and is not exactly "-" or "--", + then it is an option element. The characters of this element + (aside from the initial '-') are option characters. If `getopt' + is called repeatedly, it returns successively each of the option characters + from each of the option elements. + + If `getopt' finds another option character, it returns that character, + updating `optind' and `nextchar' so that the next call to `getopt' can + resume the scan with the following option character or ARGV-element. + + If there are no more option characters, `getopt' returns -1. + Then `optind' is the index in ARGV of the first ARGV-element + that is not an option. (The ARGV-elements have been permuted + so that those that are not options now come last.) + + OPTSTRING is a string containing the legitimate option characters. + If an option character is seen that is not listed in OPTSTRING, + return '?' after printing an error message. If you set `opterr' to + zero, the error message is suppressed but we still return '?'. + + If a char in OPTSTRING is followed by a colon, that means it wants an arg, + so the following text in the same ARGV-element, or the text of the following + ARGV-element, is returned in `optarg'. Two colons mean an option that + wants an optional arg; if there is text in the current ARGV-element, + it is returned in `optarg', otherwise `optarg' is set to zero. + + If OPTSTRING starts with `-' or `+', it requests different methods of + handling the non-option ARGV-elements. + See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above. + + Long-named options begin with `--' instead of `-'. + Their names may be abbreviated as long as the abbreviation is unique + or is an exact match for some defined option. If they have an + argument, it follows the option name in the same ARGV-element, separated + from the option name by a `=', or else the in next ARGV-element. + When `getopt' finds a long-named option, it returns 0 if that option's + `flag' field is nonzero, the value of the option's `val' field + if the `flag' field is zero. + + The elements of ARGV aren't really const, because we permute them. + But we pretend they're const in the prototype to be compatible + with other systems. + + LONGOPTS is a vector of `struct option' terminated by an + element containing a name which is zero. + + LONGIND returns the index in LONGOPT of the long-named option found. + It is only valid when a long-named option has been found by the most + recent call. + + If LONG_ONLY is nonzero, '-' as well as '--' can introduce + long-named options. */ + +int +_getopt_internal (argc, argv, optstring, longopts, longind, long_only) + int argc; + char *const *argv; + const char *optstring; + const struct option *longopts; + int *longind; + int long_only; +{ + optarg = NULL; + + if (optind == 0 || !__getopt_initialized) + { + if (optind == 0) + optind = 1; /* Don't scan ARGV[0], the program name. */ + optstring = _getopt_initialize (argc, argv, optstring); + __getopt_initialized = 1; + } + + /* Test whether ARGV[optind] points to a non-option argument. + Either it does not have option syntax, or there is an environment flag + from the shell indicating it is not an option. The later information + is only used when the used in the GNU libc. */ +#ifdef _LIBC +#define NONOPTION_P (argv[optind][0] != '-' || argv[optind][1] == '\0' \ + || (optind < nonoption_flags_len \ + && __getopt_nonoption_flags[optind] == '1')) +#else +#define NONOPTION_P (argv[optind][0] != '-' || argv[optind][1] == '\0') +#endif + + if (nextchar == NULL || *nextchar == '\0') + { + /* Advance to the next ARGV-element. */ + + /* Give FIRST_NONOPT & LAST_NONOPT rational values if OPTIND has been + moved back by the user (who may also have changed the arguments). */ + if (last_nonopt > optind) + last_nonopt = optind; + if (first_nonopt > optind) + first_nonopt = optind; + + if (ordering == PERMUTE) + { + /* If we have just processed some options following some non-options, + exchange them so that the options come first. */ + + if (first_nonopt != last_nonopt && last_nonopt != optind) + exchange ((char **) argv); + else if (last_nonopt != optind) + first_nonopt = optind; + + /* Skip any additional non-options + and extend the range of non-options previously skipped. */ + + while (optind < argc && NONOPTION_P) + optind++; + last_nonopt = optind; + } + + /* The special ARGV-element `--' means premature end of options. + Skip it like a null option, + then exchange with previous non-options as if it were an option, + then skip everything else like a non-option. */ + + if (optind != argc && !strcmp (argv[optind], "--")) + { + optind++; + + if (first_nonopt != last_nonopt && last_nonopt != optind) + exchange ((char **) argv); + else if (first_nonopt == last_nonopt) + first_nonopt = optind; + last_nonopt = argc; + + optind = argc; + } + + /* If we have done all the ARGV-elements, stop the scan + and back over any non-options that we skipped and permuted. */ + + if (optind == argc) + { + /* Set the next-arg-index to point at the non-options + that we previously skipped, so the caller will digest them. */ + if (first_nonopt != last_nonopt) + optind = first_nonopt; + return -1; + } + + /* If we have come to a non-option and did not permute it, + either stop the scan or describe it to the caller and pass it by. */ + + if (NONOPTION_P) + { + if (ordering == REQUIRE_ORDER) + return -1; + optarg = argv[optind++]; + return 1; + } + + /* We have found another option-ARGV-element. + Skip the initial punctuation. */ + + nextchar = (argv[optind] + 1 + + (longopts != NULL && argv[optind][1] == '-')); + } + + /* Decode the current option-ARGV-element. */ + + /* Check whether the ARGV-element is a long option. + + If long_only and the ARGV-element has the form "-f", where f is + a valid short option, don't consider it an abbreviated form of + a long option that starts with f. Otherwise there would be no + way to give the -f short option. + + On the other hand, if there's a long option "fubar" and + the ARGV-element is "-fu", do consider that an abbreviation of + the long option, just like "--fu", and not "-f" with arg "u". + + This distinction seems to be the most useful approach. */ + + if (longopts != NULL + && (argv[optind][1] == '-' + || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1]))))) + { + char *nameend; + const struct option *p; + const struct option *pfound = NULL; + int exact = 0; + int ambig = 0; + int indfound = -1; + int option_index; + + for (nameend = nextchar; *nameend && *nameend != '='; nameend++) + /* Do nothing. */ ; + + /* Test all long options for either exact match + or abbreviated matches. */ + for (p = longopts, option_index = 0; p->name; p++, option_index++) + if (!strncmp (p->name, nextchar, nameend - nextchar)) + { + if ((unsigned int) (nameend - nextchar) + == (unsigned int) strlen (p->name)) + { + /* Exact match found. */ + pfound = p; + indfound = option_index; + exact = 1; + break; + } + else if (pfound == NULL) + { + /* First nonexact match found. */ + pfound = p; + indfound = option_index; + } + else + /* Second or later nonexact match found. */ + ambig = 1; + } + + if (ambig && !exact) + { + if (opterr) + fprintf (stderr, _("%s: option `%s' is ambiguous\n"), + argv[0], argv[optind]); + nextchar += strlen (nextchar); + optind++; + optopt = 0; + return '?'; + } + + if (pfound != NULL) + { + option_index = indfound; + optind++; + if (*nameend) + { + /* Don't test has_arg with >, because some C compilers don't + allow it to be used on enums. */ + if (pfound->has_arg) + optarg = nameend + 1; + else + { + if (opterr) + if (argv[optind - 1][1] == '-') + /* --option */ + fprintf (stderr, + _("%s: option `--%s' doesn't allow an argument\n"), + argv[0], pfound->name); + else + /* +option or -option */ + fprintf (stderr, + _("%s: option `%c%s' doesn't allow an argument\n"), + argv[0], argv[optind - 1][0], pfound->name); + + nextchar += strlen (nextchar); + + optopt = pfound->val; + return '?'; + } + } + else if (pfound->has_arg == 1) + { + if (optind < argc) + optarg = argv[optind++]; + else + { + if (opterr) + fprintf (stderr, + _("%s: option `%s' requires an argument\n"), + argv[0], argv[optind - 1]); + nextchar += strlen (nextchar); + optopt = pfound->val; + return optstring[0] == ':' ? ':' : '?'; + } + } + nextchar += strlen (nextchar); + if (longind != NULL) + *longind = option_index; + if (pfound->flag) + { + *(pfound->flag) = pfound->val; + return 0; + } + return pfound->val; + } + + /* Can't find it as a long option. If this is not getopt_long_only, + or the option starts with '--' or is not a valid short + option, then it's an error. + Otherwise interpret it as a short option. */ + if (!long_only || argv[optind][1] == '-' + || my_index (optstring, *nextchar) == NULL) + { + if (opterr) + { + if (argv[optind][1] == '-') + /* --option */ + fprintf (stderr, _("%s: unrecognized option `--%s'\n"), + argv[0], nextchar); + else + /* +option or -option */ + fprintf (stderr, _("%s: unrecognized option `%c%s'\n"), + argv[0], argv[optind][0], nextchar); + } + nextchar = (char *) ""; + optind++; + optopt = 0; + return '?'; + } + } + + /* Look at and handle the next short option-character. */ + + { + char c = *nextchar++; + char *temp = my_index (optstring, c); + + /* Increment `optind' when we start to process its last character. */ + if (*nextchar == '\0') + ++optind; + + if (temp == NULL || c == ':') + { + if (opterr) + { + if (posixly_correct) + /* 1003.2 specifies the format of this message. */ + fprintf (stderr, _("%s: illegal option -- %c\n"), + argv[0], c); + else + fprintf (stderr, _("%s: invalid option -- %c\n"), + argv[0], c); + } + optopt = c; + return '?'; + } + /* Convenience. Treat POSIX -W foo same as long option --foo */ + if (temp[0] == 'W' && temp[1] == ';') + { + char *nameend; + const struct option *p; + const struct option *pfound = NULL; + int exact = 0; + int ambig = 0; + int indfound = 0; + int option_index; + + /* This is an option that requires an argument. */ + if (*nextchar != '\0') + { + optarg = nextchar; + /* If we end this ARGV-element by taking the rest as an arg, + we must advance to the next element now. */ + optind++; + } + else if (optind == argc) + { + if (opterr) + { + /* 1003.2 specifies the format of this message. */ + fprintf (stderr, _("%s: option requires an argument -- %c\n"), + argv[0], c); + } + optopt = c; + if (optstring[0] == ':') + c = ':'; + else + c = '?'; + return c; + } + else + /* We already incremented `optind' once; + increment it again when taking next ARGV-elt as argument. */ + optarg = argv[optind++]; + + /* optarg is now the argument, see if it's in the + table of longopts. */ + + for (nextchar = nameend = optarg; *nameend && *nameend != '='; nameend++) + /* Do nothing. */ ; + + /* Test all long options for either exact match + or abbreviated matches. */ + for (p = longopts, option_index = 0; p->name; p++, option_index++) + if (!strncmp (p->name, nextchar, nameend - nextchar)) + { + if ((unsigned int) (nameend - nextchar) == strlen (p->name)) + { + /* Exact match found. */ + pfound = p; + indfound = option_index; + exact = 1; + break; + } + else if (pfound == NULL) + { + /* First nonexact match found. */ + pfound = p; + indfound = option_index; + } + else + /* Second or later nonexact match found. */ + ambig = 1; + } + if (ambig && !exact) + { + if (opterr) + fprintf (stderr, _("%s: option `-W %s' is ambiguous\n"), + argv[0], argv[optind]); + nextchar += strlen (nextchar); + optind++; + return '?'; + } + if (pfound != NULL) + { + option_index = indfound; + if (*nameend) + { + /* Don't test has_arg with >, because some C compilers don't + allow it to be used on enums. */ + if (pfound->has_arg) + optarg = nameend + 1; + else + { + if (opterr) + fprintf (stderr, _("\ +%s: option `-W %s' doesn't allow an argument\n"), + argv[0], pfound->name); + + nextchar += strlen (nextchar); + return '?'; + } + } + else if (pfound->has_arg == 1) + { + if (optind < argc) + optarg = argv[optind++]; + else + { + if (opterr) + fprintf (stderr, + _("%s: option `%s' requires an argument\n"), + argv[0], argv[optind - 1]); + nextchar += strlen (nextchar); + return optstring[0] == ':' ? ':' : '?'; + } + } + nextchar += strlen (nextchar); + if (longind != NULL) + *longind = option_index; + if (pfound->flag) + { + *(pfound->flag) = pfound->val; + return 0; + } + return pfound->val; + } + nextchar = NULL; + return 'W'; /* Let the application handle it. */ + } + if (temp[1] == ':') + { + if (temp[2] == ':') + { + /* This is an option that accepts an argument optionally. */ + if (*nextchar != '\0') + { + optarg = nextchar; + optind++; + } + else + optarg = NULL; + nextchar = NULL; + } + else + { + /* This is an option that requires an argument. */ + if (*nextchar != '\0') + { + optarg = nextchar; + /* If we end this ARGV-element by taking the rest as an arg, + we must advance to the next element now. */ + optind++; + } + else if (optind == argc) + { + if (opterr) + { + /* 1003.2 specifies the format of this message. */ + fprintf (stderr, + _("%s: option requires an argument -- %c\n"), + argv[0], c); + } + optopt = c; + if (optstring[0] == ':') + c = ':'; + else + c = '?'; + } + else + /* We already incremented `optind' once; + increment it again when taking next ARGV-elt as argument. */ + optarg = argv[optind++]; + nextchar = NULL; + } + } + return c; + } +} + +int +getopt (argc, argv, optstring) + int argc; + char *const *argv; + const char *optstring; +{ + return _getopt_internal (argc, argv, optstring, + (const struct option *) 0, + (int *) 0, + 0); +} + +#endif /* Not ELIDE_CODE. */ + +#ifdef TEST + +/* Compile with -DTEST to make an executable for use in testing + the above definition of `getopt'. */ + +int +main (argc, argv) + int argc; + char **argv; +{ + int c; + int digit_optind = 0; + + while (1) + { + int this_option_optind = optind ? optind : 1; + + c = getopt (argc, argv, "abc:d:0123456789"); + if (c == -1) + break; + + switch (c) + { + 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 '?': + 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 */ diff --git a/apps/interpreters/bas/getopt.h b/apps/interpreters/bas/getopt.h new file mode 100644 index 000000000..f994e5869 --- /dev/null +++ b/apps/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 */ diff --git a/apps/interpreters/bas/getopt1.c b/apps/interpreters/bas/getopt1.c new file mode 100644 index 000000000..a91c4238a --- /dev/null +++ b/apps/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 */ diff --git a/apps/interpreters/bas/global.c b/apps/interpreters/bas/global.c new file mode 100644 index 000000000..8206b5f94 --- /dev/null +++ b/apps/interpreters/bas/global.c @@ -0,0 +1,1787 @@ +/* Global variables and functions. */ +/* #includes */ /*{{{C}}}*//*{{{*/ +#include "config.h" + +#include <sys/times.h> +#include <assert.h> +#include <ctype.h> +#include <dirent.h> +#include <errno.h> +#ifdef HAVE_GETTEXT +#include <libintl.h> +#define _(String) gettext(String) +#else +#define _(String) String +#endif +#include <math.h> +#include <stdarg.h> +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <time.h> +#include <unistd.h> + +#include "auto.h" +#include "bas.h" +#include "error.h" +#include "fs.h" +#include "global.h" +#include "var.h" + +#ifdef USE_DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ +/* #defines */ /*{{{*/ +#ifndef M_PI +#define M_PI 3.14159265358979323846 +#endif +/*}}}*/ + +extern char **environ; + +static int wildcardmatch(const char *a, const char *pattern) /*{{{*/ +{ + while (*pattern) + { + switch (*pattern) + { + case '*': + { + ++pattern; + while (*a) if (wildcardmatch(a,pattern)) return 1; else ++a; + break; + } + case '?': + { + if (*a) { ++a; ++pattern; } else return 0; + break; + } + default: if (*a==*pattern) { ++a; ++pattern; } else return 0; + } + } + return (*pattern=='\0' && *a=='\0'); +} +/*}}}*/ + +static long int intValue(struct Auto *stack, int l) /*{{{*/ +{ + struct Value value; + struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value); + assert(arg->type==V_INTEGER); + return arg->u.integer; +} +/*}}}*/ +static double realValue(struct Auto *stack, int l) /*{{{*/ +{ + struct Value value; + struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value); + assert(arg->type==V_REAL); + return arg->u.real; +} +/*}}}*/ +static struct String *stringValue(struct Auto *stack, int l) /*{{{*/ +{ + struct Value value; + struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value); + assert(arg->type==V_STRING); + return &(arg->u.string); +} +/*}}}*/ + +static struct Value *bin(struct Value *v, unsigned long int value, long int digits) /*{{{*/ +{ + char buf[sizeof(long int)*8+1]; + char *s; + + Value_new_STRING(v); + s=buf+sizeof(buf); + *--s='\0'; + if (digits==0) digits=1; + while (digits || value) + { + *--s=value&1?'1':'0'; + if (digits) --digits; + value>>=1; + } + String_appendChars(&v->u.string,s); + return v; +} +/*}}}*/ +static struct Value *hex(struct Value *v, long int value, long int digits) /*{{{*/ +{ + char buf[sizeof(long int)*2+1]; + + sprintf(buf,"%0*lx",(int)digits,value); + Value_new_STRING(v); + String_appendChars(&v->u.string,buf); + return v; +} +/*}}}*/ +static struct Value *find(struct Value *v, struct String *pattern, long int occurence) /*{{{*/ +{ + struct String dirname,basename; + char *slash; + DIR *dir; + struct dirent *ent; + int currentdir; + int found=0; + + Value_new_STRING(v); + String_new(&dirname); + String_new(&basename); + String_appendString(&dirname,pattern); + while (dirname.length>0 && dirname.character[dirname.length-1]=='/') String_delete(&dirname,dirname.length-1,1); + if ((slash=strrchr(dirname.character,'/'))==(char*)0) + { + String_appendString(&basename,&dirname); + String_delete(&dirname,0,dirname.length); + String_appendChar(&dirname,'.'); + currentdir=1; + } + else + { + String_appendChars(&basename,slash+1); + String_delete(&dirname,slash-dirname.character,dirname.length-(slash-dirname.character)); + currentdir=0; + } + if ((dir=opendir(dirname.character))!=(DIR*)0) + { + while ((ent=readdir(dir))!=(struct dirent*)0) + { + if (wildcardmatch(ent->d_name,basename.character)) + { + if (found==occurence) + { + if (currentdir) String_appendChars(&v->u.string,ent->d_name); + else String_appendPrintf(&v->u.string,"%s/%s",dirname.character,ent->d_name); + break; + } + ++found; + } + } + closedir(dir); + } + String_destroy(&dirname); + String_destroy(&basename); + return v; +} +/*}}}*/ +static struct Value *instr(struct Value *v, long int start, long int len, struct String *haystack, struct String *needle) /*{{{*/ +{ + const char *haystackChars=haystack->character; + size_t haystackLength=haystack->length; + const char *needleChars=needle->character; + size_t needleLength=needle->length; + int found; + + --start; + if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position")); + if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0); + haystackChars+=start; haystackLength-=start; + if (haystackLength>len) haystackLength=len; + found=1+start; + while (needleLength<=haystackLength) + { + if (memcmp(haystackChars,needleChars,needleLength)==0) return Value_new_INTEGER(v,found); + ++haystackChars; --haystackLength; + ++found; + } + return Value_new_INTEGER(v,0); +} +/*}}}*/ +static struct Value *string(struct Value *v, long int len, int c) /*{{{*/ +{ + if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + if (c<0 || c>255) return Value_new_ERROR(v,OUTOFRANGE,_("code")); + + Value_new_STRING(v); + String_size(&v->u.string,len); + if (len) memset(v->u.string.character,c,len); + return v; +} +/*}}}*/ +static struct Value *mid(struct Value *v, struct String *s, long int position, long int length) /*{{{*/ +{ + --position; + if (position<0) return Value_new_ERROR(v,OUTOFRANGE,_("position")); + if (length<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + if (((size_t)position)+length>s->length) + { + length=s->length-position; + if (length<0) length=0; + } + Value_new_STRING(v); + String_size(&v->u.string,length); + if (length>0) memcpy(v->u.string.character,s->character+position,length); + return v; +} +/*}}}*/ +static struct Value *inkey(struct Value *v, long int timeout, long int chn) /*{{{*/ +{ + int c; + + if ((c=FS_inkeyChar(chn,timeout*10))==-1) + { + if (FS_errmsg) return Value_new_ERROR(v,IOERROR,FS_errmsg); + else return Value_new_STRING(v); + } + else + { + Value_new_STRING(v); + String_appendChar(&v->u.string,c); + return v; + } +} +/*}}}*/ +static struct Value *input(struct Value *v, long int len, long int chn) /*{{{*/ +{ + int ch=-1; + + if (len<=0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + Value_new_STRING(v); + while (len-- && (ch=FS_getChar(chn))!=-1) String_appendChar(&v->u.string,ch); + if (ch==-1) + { + Value_destroy(v); + return Value_new_ERROR(v,IOERROR,FS_errmsg); + } + return v; +} +/*}}}*/ +static struct Value *env(struct Value *v, long int n) /*{{{*/ +{ + int i; + + --n; + if (n<0) return Value_new_ERROR(v,OUTOFRANGE,_("variable number")); + for (i=0; i<n && environ[i]; ++i); + Value_new_STRING(v); + if (i==n && environ[i]) String_appendChars(&v->u.string,environ[i]); + return v; +} +/*}}}*/ +static struct Value *rnd(struct Value *v, long int x) /*{{{*/ +{ + if (x<0) srand(-x); + if (x==0 || x==1) Value_new_REAL(v,rand()/(double)RAND_MAX); + else Value_new_REAL(v,rand()%x+1); + return v; +} +/*}}}*/ + +static struct Value *fn_abs(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,fabs(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_asc(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + + if (s->length==0) return Value_new_ERROR(v,UNDEFINED,_("`asc' or `code' of empty string")); + return Value_new_INTEGER(v,s->character[0]&0xff); +} +/*}}}*/ +static struct Value *fn_atn(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,atan(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_bini(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return bin(v,intValue(stack,0),0); +} +/*}}}*/ +static struct Value *fn_bind(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return bin(v,n,0); +} +/*}}}*/ +static struct Value *fn_binii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return bin(v,intValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_bindi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return bin(v,n,intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_binid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int digits; + + digits=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits")); + return bin(v,intValue(stack,0),digits); +} +/*}}}*/ +static struct Value *fn_bindd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n,digits; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + digits=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits")); + return bin(v,n,digits); +} +/*}}}*/ +static struct Value *fn_chr(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int chr=intValue(stack,0); + + if (chr<0 || chr>255) return Value_new_ERROR(v,OUTOFRANGE,_("character code")); + Value_new_STRING(v); + String_size(&v->u.string,1); + v->u.string.character[0]=chr; + return v; +} +/*}}}*/ +static struct Value *fn_cint(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,ceil(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_cos(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,cos(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_command(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int i; + + Value_new_STRING(v); + for (i=0; i<bas_argc; ++i) + { + if (i) String_appendChar(&v->u.string,' '); + String_appendChars(&v->u.string,bas_argv[i]); + } + return v; +} +/*}}}*/ +static struct Value *fn_commandi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int a; + + a=intValue(stack,0); + if (a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number")); + Value_new_STRING(v); + if (a==0) + { + if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0); + } + else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]); + return v; +} +/*}}}*/ +static struct Value *fn_commandd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int a; + + a=Value_toi(realValue(stack,0),&overflow); + if (overflow || a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number")); + Value_new_STRING(v); + if (a==0) + { + if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0); + } + else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]); + return v; +} +/*}}}*/ +static struct Value *fn_cvi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + long int n=(s->length && s->character[s->length-1]<0) ? -1 : 0; + int i; + + for (i=s->length-1; i>=0; --i) n=(n<<8)|(s->character[i]&0xff); + return Value_new_INTEGER(v,n); +} +/*}}}*/ +static struct Value *fn_cvs(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + float n; + + if (s->length!=sizeof(float)) return Value_new_ERROR(v,BADCONVERSION,_("number")); + memcpy(&n,s->character,sizeof(float)); + return Value_new_REAL(v,(double)n); +} +/*}}}*/ +static struct Value *fn_cvd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + double n; + + if (s->length!=sizeof(double)) return Value_new_ERROR(v,BADCONVERSION,_("number")); + memcpy(&n,s->character,sizeof(double)); + return Value_new_REAL(v,n); +} +/*}}}*/ +static struct Value *fn_date(struct Value *v, struct Auto *stack) /*{{{*/ +{ + time_t t; + struct tm *now; + + Value_new_STRING(v); + String_size(&v->u.string,10); + time(&t); + now=localtime(&t); + sprintf(v->u.string.character,"%02d-%02d-%04d",now->tm_mon+1,now->tm_mday,now->tm_year+1900); + return v; +} +/*}}}*/ +static struct Value *fn_dec(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct Value value,*arg; + size_t using; + + Value_new_STRING(v); + arg=Var_value(Auto_local(stack,0),0,(int*)0,&value); + using=0; + Value_toStringUsing(arg,&v->u.string,stringValue(stack,1),&using); + return v; +} +/*}}}*/ +static struct Value *fn_deg(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,realValue(stack,0)*(180.0/M_PI)); +} +/*}}}*/ +static struct Value *fn_det(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,stack->lastdet.type==V_NIL?0.0:(stack->lastdet.type==V_REAL?stack->lastdet.u.real:stack->lastdet.u.integer)); +} +/*}}}*/ +static struct Value *fn_edit(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int code; + char *begin,*end,*rd,*wr; + char quote; + + code=intValue(stack,1); + Value_new_STRING(v); + String_appendString(&v->u.string,stringValue(stack,0)); + begin=rd=wr=v->u.string.character; + end=rd+v->u.string.length; + + /* 8 - Discard Leading Spaces and Tabs */ + if (code & 8) while (rd<end && (*rd==' ' || *rd=='\t')) ++rd; + + while (rd<end) + { + /* 1 - Discard parity bit */ + if (code&1) *rd=*rd&0x7f; + + /* 2 - Discard all spaces and tabs */ + if ((code&2) && (*rd==' ' || *rd=='\t')) { ++rd; continue; } + + /* 4 - Discard all carriage returns, line feeds, form feeds, deletes, escapes, and nulls */ + if ((code&4) && (*rd=='\r' || *rd=='\n' || *rd=='\f' || *rd==127 || *rd==27 || *rd=='\0')) { ++rd; continue; } + + /* 16 - Convert Multiple Spaces and Tabs to one space */ + if ((code&16) && ((*rd==' ') || (*rd=='\t'))) + { + *wr++=' '; + while (rd<end && (*rd==' ' || *rd=='\t')) ++rd; + continue; + } + + /* 32 - Convert lower to upper case */ + if ((code&32) && islower((int)*rd)) { *wr++=toupper((int)*rd++); continue; } + + /* 64 - Convert brackets to parentheses */ + if (code&64) + { + if (*rd=='[') { *wr++='('; ++rd; continue; } + else if (*rd==']') { *wr++=')'; ++rd; continue; } + } + + /* 256 - Suppress all editing for characters within quotation marks */ + if ((code&256) && (*rd=='"' || *rd=='\'')) + { + quote=*rd; + *wr++=*rd++; + while (rd<end && *rd!=quote) *wr++=*rd++; + if (rd<end) { *wr++=*rd++; quote='\0'; } + continue; + } + + *wr++=*rd++; + } + + /* 128 - Discard Trailing Spaces and Tabs */ + if ((code & 128) && wr>begin) + { + while (wr>begin && (*(wr-1)=='\0' || *(wr-1)=='\t')) --wr; + } + + String_size(&v->u.string,wr-begin); + return v; +} +/*}}}*/ +static struct Value *fn_environi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return env(v,intValue(stack,0)); +} +/*}}}*/ +static struct Value *fn_environd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return env(v,n); +} +/*}}}*/ +static struct Value *fn_environs(struct Value *v, struct Auto *stack) /*{{{*/ +{ + char *var; + + Value_new_STRING(v); + if ((var=stringValue(stack,0)->character)) + { + char *val=getenv(var); + + if (val) String_appendChars(&v->u.string,val); + } + return v; +} +/*}}}*/ +static struct Value *fn_eof(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int e=FS_eof(intValue(stack,0)); + + if (e==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg); + return Value_new_INTEGER(v,e?-1:0); +} +/*}}}*/ +static struct Value *fn_erl(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,stack->erl); +} +/*}}}*/ +static struct Value *fn_err(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,stack->err.type==V_NIL?0:stack->err.u.error.code); +} +/*}}}*/ +static struct Value *fn_exp(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,exp(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_false(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,0); +} +/*}}}*/ +static struct Value *fn_find(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return find(v,stringValue(stack,0),0); +} +/*}}}*/ +static struct Value *fn_findi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return find(v,stringValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_findd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n; + + n=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return find(v,stringValue(stack,0),n); +} +/*}}}*/ +static struct Value *fn_fix(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x=realValue(stack,0); + return Value_new_REAL(v,x<0.0?ceil(x):floor(x)); +} +/*}}}*/ +static struct Value *fn_frac(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x=realValue(stack,0); + return Value_new_REAL(v,x<0.0 ? x-ceil(x) : x-floor(x)); +} +/*}}}*/ +static struct Value *fn_freefile(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,FS_freechn()); +} +/*}}}*/ +static struct Value *fn_hexi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + char buf[sizeof(long int)*2+1]; + + sprintf(buf,"%lx",intValue(stack,0)); + Value_new_STRING(v); + String_appendChars(&v->u.string,buf); + return v; +} +/*}}}*/ +static struct Value *fn_hexd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + char buf[sizeof(long int)*2+1]; + int overflow; + long int n; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + sprintf(buf,"%lx",n); + Value_new_STRING(v); + String_appendChars(&v->u.string,buf); + return v; +} +/*}}}*/ +static struct Value *fn_hexii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return hex(v,intValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_hexdi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return hex(v,n,intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_hexid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int digits; + + digits=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits")); + return hex(v,intValue(stack,0),digits); +} +/*}}}*/ +static struct Value *fn_hexdd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int n,digits; + + n=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + digits=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits")); + return hex(v,n,digits); +} +/*}}}*/ +static struct Value *fn_int(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,floor(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_intp(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int l; + + errno=0; + l=lrint(floor(realValue(stack,0))); + if (errno==EDOM) return Value_new_ERROR(v,OUTOFRANGE,_("number")); + return Value_new_INTEGER(v,l); +} +/*}}}*/ +static struct Value *fn_inp(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int r=FS_portInput(intValue(stack,0)); + + if (r==-1) + { + return Value_new_ERROR(v,IOERROR,FS_errmsg); + } + else return Value_new_INTEGER(v,r); +} +/*}}}*/ +static struct Value *fn_input1(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return input(v,intValue(stack,0),STDCHANNEL); +} +/*}}}*/ +static struct Value *fn_input2(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return input(v,intValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_inkey(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return inkey(v,0,STDCHANNEL); +} +/*}}}*/ +static struct Value *fn_inkeyi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return inkey(v,intValue(stack,0),STDCHANNEL); +} +/*}}}*/ +static struct Value *fn_inkeyd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int t; + + t=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time")); + return inkey(v,t,STDCHANNEL); +} +/*}}}*/ +static struct Value *fn_inkeyii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return inkey(v,intValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_inkeyid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int chn; + + chn=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel")); + return inkey(v,intValue(stack,0),chn); +} +/*}}}*/ +static struct Value *fn_inkeydi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return inkey(v,realValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int t,chn; + + t=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time")); + chn=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel")); + + return inkey(v,t,chn); +} +/*}}}*/ +static struct Value *fn_instr2(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *haystack=stringValue(stack,0); + + return instr(v,1,haystack->length,haystack,stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *haystack=stringValue(stack,1); + + return instr(v,intValue(stack,0),haystack->length,haystack,stringValue(stack,2)); +} +/*}}}*/ +static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *haystack=stringValue(stack,0); + + return instr(v,intValue(stack,2),haystack->length,haystack,stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr3dss(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start; + struct String *haystack; + + start=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + haystack=stringValue(stack,1); + return instr(v,start,haystack->length,haystack,stringValue(stack,2)); +} +/*}}}*/ +static struct Value *fn_instr3ssd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start; + struct String *haystack; + + start=Value_toi(realValue(stack,2),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + haystack=stringValue(stack,0); + return instr(v,start,haystack->length,haystack,stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr4ii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return instr(v,intValue(stack,2),intValue(stack,3),stringValue(stack,0),stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr4id(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int len; + + len=Value_toi(realValue(stack,3),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + return instr(v,intValue(stack,2),len,stringValue(stack,0),stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr4di(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start; + + start=Value_toi(realValue(stack,2),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + return instr(v,start,intValue(stack,3),stringValue(stack,0),stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_instr4dd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start,len; + + start=Value_toi(realValue(stack,2),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + len=Value_toi(realValue(stack,3),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + return instr(v,start,len,stringValue(stack,0),stringValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_lcase(struct Value *v, struct Auto *stack) /*{{{*/ +{ + Value_new_STRING(v); + String_appendString(&v->u.string,stringValue(stack,0)); + String_lcase(&v->u.string); + return v; +} +/*}}}*/ +static struct Value *fn_len(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,stringValue(stack,0)->length); +} +/*}}}*/ +static struct Value *fn_left(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + long int len=intValue(stack,1); + int left=((size_t)len)<s->length ? len : s->length; + + if (left<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + Value_new_STRING(v); + String_size(&v->u.string,left); + if (left) memcpy(v->u.string.character,s->character,left); + return v; +} +/*}}}*/ +static struct Value *fn_loc(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int l=FS_loc(intValue(stack,0)); + + if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg); + return Value_new_INTEGER(v,l); +} +/*}}}*/ +static struct Value *fn_lof(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int l=FS_lof(intValue(stack,0)); + + if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg); + return Value_new_INTEGER(v,l); +} +/*}}}*/ +static struct Value *fn_log(struct Value *v, struct Auto *stack) /*{{{*/ +{ + if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value")); + else Value_new_REAL(v,log(realValue(stack,0))); + return v; +} +/*}}}*/ +static struct Value *fn_log10(struct Value *v, struct Auto *stack) /*{{{*/ +{ + if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value")); + else Value_new_REAL(v,log10(realValue(stack,0))); + return v; +} +/*}}}*/ +static struct Value *fn_log2(struct Value *v, struct Auto *stack) /*{{{*/ +{ + if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value")); + else Value_new_REAL(v,log2(realValue(stack,0))); + return v; +} +/*}}}*/ +static struct Value *fn_ltrim(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + int len=s->length; + int spaces; + + for (spaces=0; spaces<len && s->character[spaces]==' '; ++spaces); + Value_new_STRING(v); + String_size(&v->u.string,len-spaces); + if (len-spaces) memcpy(v->u.string.character,s->character+spaces,len-spaces); + return v; +} +/*}}}*/ +static struct Value *fn_match(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *needle=stringValue(stack,0); + const char *needleChars=needle->character; + const char *needleEnd=needle->character+needle->length; + struct String *haystack=stringValue(stack,1); + const char *haystackChars=haystack->character; + size_t haystackLength=haystack->length; + long int start=intValue(stack,2); + long int found; + const char *n,*h; + + if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position")); + if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0); + haystackChars+=start; haystackLength-=start; + found=1+start; + while (haystackLength) + { + for (n=needleChars,h=haystackChars; n<needleEnd && h<(haystackChars+haystackLength); ++n,++h) + { + if (*n=='\\') + { + if (++n<needleEnd && *n!=*h) break; + } + else if (*n=='!') + { + if (!isalpha((int)*h)) break; + } + else if (*n=='#') + { + if (!isdigit((int)*h)) break; + } + else if (*n!='?' && *n!=*h) break; + } + if (n==needleEnd) return Value_new_INTEGER(v,found); + ++haystackChars; --haystackLength; + ++found; + } + return Value_new_INTEGER(v,0); +} +/*}}}*/ +static struct Value *fn_maxii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int x,y; + + x=intValue(stack,0); + y=intValue(stack,1); + return Value_new_INTEGER(v,x>y?x:y); +} +/*}}}*/ +static struct Value *fn_maxdi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x; + long int y; + + x=realValue(stack,0); + y=intValue(stack,1); + return Value_new_REAL(v,x>y?x:y); +} +/*}}}*/ +static struct Value *fn_maxid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int x; + double y; + + x=intValue(stack,0); + y=realValue(stack,1); + return Value_new_REAL(v,x>y?x:y); +} +/*}}}*/ +static struct Value *fn_maxdd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x,y; + + x=realValue(stack,0); + y=realValue(stack,1); + return Value_new_REAL(v,x>y?x:y); +} +/*}}}*/ +static struct Value *fn_mid2i(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return mid(v,stringValue(stack,0),intValue(stack,1),stringValue(stack,0)->length); +} +/*}}}*/ +static struct Value *fn_mid2d(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start; + + start=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + return mid(v,stringValue(stack,0),start,stringValue(stack,0)->length); +} +/*}}}*/ +static struct Value *fn_mid3ii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return mid(v,stringValue(stack,0),intValue(stack,1),intValue(stack,2)); +} +/*}}}*/ +static struct Value *fn_mid3id(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int len; + + len=Value_toi(realValue(stack,2),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + return mid(v,stringValue(stack,0),intValue(stack,1),len); +} +/*}}}*/ +static struct Value *fn_mid3di(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start; + + start=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + + return mid(v,stringValue(stack,0),start,intValue(stack,2)); +} +/*}}}*/ +static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int start,len; + + start=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start")); + len=Value_toi(realValue(stack,2),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + return mid(v,stringValue(stack,0),start,len); +} +/*}}}*/ +static struct Value *fn_minii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int x,y; + + x=intValue(stack,0); + y=intValue(stack,1); + return Value_new_INTEGER(v,x<y?x:y); +} +/*}}}*/ +static struct Value *fn_mindi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x; + long int y; + + x=realValue(stack,0); + y=intValue(stack,1); + return Value_new_REAL(v,x<y?x:y); +} +/*}}}*/ +static struct Value *fn_minid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int x; + double y; + + x=intValue(stack,0); + y=realValue(stack,1); + return Value_new_REAL(v,x<y?x:y); +} +/*}}}*/ +static struct Value *fn_mindd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x,y; + + x=realValue(stack,0); + y=realValue(stack,1); + return Value_new_REAL(v,x<y?x:y); +} +/*}}}*/ +static struct Value *fn_mki(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int x=intValue(stack,0); + size_t i; + + Value_new_STRING(v); + String_size(&v->u.string,sizeof(long int)); + for (i=0; i<sizeof(long int); ++i,x>>=8) v->u.string.character[i]=(x&0xff); + return v; +} +/*}}}*/ +static struct Value *fn_mks(struct Value *v, struct Auto *stack) /*{{{*/ +{ + float x=realValue(stack,0); + + Value_new_STRING(v); + String_size(&v->u.string,sizeof(float)); + memcpy(v->u.string.character,&x,sizeof(float)); + return v; +} +/*}}}*/ +static struct Value *fn_mkd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x=realValue(stack,0); + + Value_new_STRING(v); + String_size(&v->u.string,sizeof(double)); + memcpy(v->u.string.character,&x,sizeof(double)); + return v; +} +/*}}}*/ +static struct Value *fn_oct(struct Value *v, struct Auto *stack) /*{{{*/ +{ + char buf[sizeof(long int)*3+1]; + + sprintf(buf,"%lo",intValue(stack,0)); + Value_new_STRING(v); + String_appendChars(&v->u.string,buf); + return v; +} +/*}}}*/ +static struct Value *fn_pi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,M_PI); +} +/*}}}*/ +static struct Value *fn_peek(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int r=FS_memInput(intValue(stack,0)); + + if (r==-1) + { + return Value_new_ERROR(v,IOERROR,FS_errmsg); + } + else return Value_new_INTEGER(v,r); +} +/*}}}*/ +static struct Value *fn_pos(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,FS_charpos(STDCHANNEL)+1); +} +/*}}}*/ +static struct Value *fn_rad(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,(realValue(stack,0)*M_PI)/180.0); +} +/*}}}*/ +static struct Value *fn_right(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + int len=s->length; + int right=intValue(stack,1)<len ? intValue(stack,1) : len; + if (right<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + Value_new_STRING(v); + String_size(&v->u.string,right); + if (right) memcpy(v->u.string.character,s->character+len-right,right); + return v; +} +/*}}}*/ +static struct Value *fn_rnd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return rnd(v,0); +} +/*}}}*/ +static struct Value *fn_rndi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return rnd(v,intValue(stack,0)); +} +/*}}}*/ +static struct Value *fn_rndd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int limit; + + limit=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("limit")); + return rnd(v,limit); +} +/*}}}*/ +static struct Value *fn_rtrim(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + int len=s->length; + int lastSpace; + + for (lastSpace=len; lastSpace>0 && s->character[lastSpace-1]==' '; --lastSpace); + Value_new_STRING(v); + String_size(&v->u.string,lastSpace); + if (lastSpace) memcpy(v->u.string.character,s->character,lastSpace); + return v; +} +/*}}}*/ +static struct Value *fn_sgn(struct Value *v, struct Auto *stack) /*{{{*/ +{ + double x=realValue(stack,0); + return Value_new_INTEGER(v,x<0.0 ? -1 : (x==0.0 ? 0 : 1)); +} +/*}}}*/ +static struct Value *fn_sin(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,sin(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_space(struct Value *v, struct Auto *stack) /*{{{*/ +{ + long int len=intValue(stack,0); + + if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + Value_new_STRING(v); + String_size(&v->u.string,len); + if (len) memset(v->u.string.character,' ',len); + return v; +} +/*}}}*/ +static struct Value *fn_sqr(struct Value *v, struct Auto *stack) /*{{{*/ +{ + if (realValue(stack,0)<0.0) Value_new_ERROR(v,OUTOFRANGE,_("Square root argument")); + else Value_new_REAL(v,sqrt(realValue(stack,0))); + return v; +} +/*}}}*/ +static struct Value *fn_str(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct Value value,*arg; + struct String s; + + arg=Var_value(Auto_local(stack,0),0,(int*)0,&value); + assert(arg->type!=V_ERROR); + String_new(&s); + Value_toString(arg,&s,' ',-1,0,0,0,0,-1,0,0); + v->type=V_STRING; + v->u.string=s; + return v; +} +/*}}}*/ +static struct Value *fn_stringii(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return string(v,intValue(stack,0),intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_stringid(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int chr; + + chr=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code")); + return string(v,intValue(stack,0),chr); +} +/*}}}*/ +static struct Value *fn_stringdi(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int len; + + len=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + return string(v,len,intValue(stack,1)); +} +/*}}}*/ +static struct Value *fn_stringdd(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int len,chr; + + len=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + chr=Value_toi(realValue(stack,1),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code")); + return string(v,len,chr); +} +/*}}}*/ +static struct Value *fn_stringis(struct Value *v, struct Auto *stack) /*{{{*/ +{ + if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string")); + + return string(v,intValue(stack,0),stringValue(stack,1)->character[0]); +} +/*}}}*/ +static struct Value *fn_stringds(struct Value *v, struct Auto *stack) /*{{{*/ +{ + int overflow; + long int len; + + len=Value_toi(realValue(stack,0),&overflow); + if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length")); + if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string")); + return string(v,len,stringValue(stack,1)->character[0]); +} +/*}}}*/ +static struct Value *fn_strip(struct Value *v, struct Auto *stack) /*{{{*/ +{ + size_t i; + + Value_new_STRING(v); + String_appendString(&v->u.string,stringValue(stack,0)); + for (i=0; i<v->u.string.length; ++i) v->u.string.character[i]&=0x7f; + return v; +} +/*}}}*/ +static struct Value *fn_tan(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_REAL(v,tan(realValue(stack,0))); +} +/*}}}*/ +static struct Value *fn_timei(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,(unsigned long)(times((struct tms*)0)/(sysconf(_SC_CLK_TCK)/100.0))); +} +/*}}}*/ +static struct Value *fn_times(struct Value *v, struct Auto *stack) /*{{{*/ +{ + time_t t; + struct tm *now; + + Value_new_STRING(v); + String_size(&v->u.string,8); + time(&t); + now=localtime(&t); + sprintf(v->u.string.character,"%02d:%02d:%02d",now->tm_hour,now->tm_min,now->tm_sec); + return v; +} +/*}}}*/ +static struct Value *fn_timer(struct Value *v, struct Auto *stack) /*{{{*/ +{ + time_t t; + struct tm *l; + + time(&t); + l=localtime(&t); + return Value_new_REAL(v,l->tm_hour*3600+l->tm_min*60+l->tm_sec); +} +/*}}}*/ +static struct Value *fn_tl(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + + Value_new_STRING(v); + if (s->length) + { + int tail=s->length-1; + + String_size(&v->u.string,tail); + if (s->length) memcpy(v->u.string.character,s->character+1,tail); + } + return v; +} +/*}}}*/ +static struct Value *fn_true(struct Value *v, struct Auto *stack) /*{{{*/ +{ + return Value_new_INTEGER(v,-1); +} +/*}}}*/ +static struct Value *fn_ucase(struct Value *v, struct Auto *stack) /*{{{*/ +{ + Value_new_STRING(v); + String_appendString(&v->u.string,stringValue(stack,0)); + String_ucase(&v->u.string); + return v; +} +/*}}}*/ +static struct Value *fn_val(struct Value *v, struct Auto *stack) /*{{{*/ +{ + struct String *s=stringValue(stack,0); + char *end; + long int i; + int overflow; + + if (s->character==(char*)0) return Value_new_REAL(v,0.0); + i=Value_vali(s->character,&end,&overflow); + if (*end=='\0') return Value_new_INTEGER(v,i); + else return Value_new_REAL(v,Value_vald(s->character,(char**)0,&overflow)); +} +/*}}}*/ + +static unsigned int hash(const char *s) /*{{{*/ +{ + unsigned int h=0; + + while (*s) + { + h=h*256+tolower(*s); + ++s; + } + return h%GLOBAL_HASHSIZE; +} +/*}}}*/ +static void builtin(struct Global *this, const char *ident, enum ValueType type, struct Value *(* func)(struct Value *value, struct Auto *stack), int argLength, ...) /*{{{*/ +{ + struct Symbol **r; + struct Symbol *s,**sptr; + int i; + va_list ap; + + for + ( + r=&this->table[hash(ident)]; + *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident); + r=&((*r)->next) + ); + if (*r==(struct Symbol*)0) + { + *r=malloc(sizeof(struct Symbol)); + (*r)->name=strcpy(malloc(strlen(ident)+1),ident); + (*r)->next=(struct Symbol*)0; + s=(*r); + } + else + { + for (sptr=&((*r)->u.sub.u.bltin.next); *sptr; sptr=&((*sptr)->u.sub.u.bltin.next)); + *sptr=s=malloc(sizeof(struct Symbol)); + } + s->u.sub.u.bltin.next=(struct Symbol*)0; + s->type=BUILTINFUNCTION; + s->u.sub.argLength=argLength; + s->u.sub.argTypes=argLength ? malloc(sizeof(enum ValueType)*argLength) : (enum ValueType*)0; + s->u.sub.retType=type; + va_start(ap,argLength); + for (i=0; i<argLength; ++i) + { + s->u.sub.argTypes[i]=va_arg(ap,enum ValueType); + } + va_end(ap); + s->u.sub.u.bltin.call=func; +} +/*}}}*/ + +struct Global *Global_new(struct Global *this) /*{{{*/ +{ + builtin(this,"abs", V_REAL, fn_abs, 1,V_REAL); + builtin(this,"asc", V_INTEGER,fn_asc, 1,V_STRING); + builtin(this,"atn", V_REAL, fn_atn, 1,V_REAL); + builtin(this,"bin$", V_STRING, fn_bini, 1,V_INTEGER); + builtin(this,"bin$", V_STRING, fn_bind, 1,V_REAL); + builtin(this,"bin$", V_STRING, fn_binii, 2,V_INTEGER,V_INTEGER); + builtin(this,"bin$", V_STRING, fn_bindi, 2,V_REAL,V_INTEGER); + builtin(this,"bin$", V_STRING, fn_binid, 2,V_INTEGER,V_REAL); + builtin(this,"bin$", V_STRING, fn_bindd, 2,V_REAL,V_REAL); + builtin(this,"chr$", V_STRING, fn_chr, 1,V_INTEGER); + builtin(this,"cint", V_REAL, fn_cint, 1,V_REAL); + builtin(this,"code", V_INTEGER,fn_asc, 1,V_STRING); + builtin(this,"command$",V_STRING, fn_command, 0); + builtin(this,"command$",V_STRING, fn_commandi, 1,V_INTEGER); + builtin(this,"command$",V_STRING, fn_commandd, 1,V_REAL); + builtin(this,"cos", V_REAL, fn_cos, 1,V_REAL); + builtin(this,"cvi", V_INTEGER,fn_cvi, 1,V_STRING); + builtin(this,"cvs", V_REAL, fn_cvs, 1,V_STRING); + builtin(this,"cvd", V_REAL, fn_cvd, 1,V_STRING); + builtin(this,"date$", V_STRING, fn_date, 0); + builtin(this,"dec$", V_STRING, fn_dec, 2,V_REAL,V_STRING); + builtin(this,"dec$", V_STRING, fn_dec, 2,V_INTEGER,V_STRING); + builtin(this,"dec$", V_STRING, fn_dec, 2,V_STRING,V_STRING); + builtin(this,"deg", V_REAL, fn_deg, 1,V_REAL); + builtin(this,"det", V_REAL, fn_det, 0); + builtin(this,"edit$", V_STRING, fn_edit, 2,V_STRING,V_INTEGER); + builtin(this,"environ$",V_STRING, fn_environi, 1,V_INTEGER); + builtin(this,"environ$",V_STRING, fn_environd, 1,V_REAL); + builtin(this,"environ$",V_STRING, fn_environs, 1,V_STRING); + builtin(this,"eof", V_INTEGER,fn_eof, 1,V_INTEGER); + builtin(this,"erl", V_INTEGER,fn_erl, 0); + builtin(this,"err", V_INTEGER,fn_err, 0); + builtin(this,"exp", V_REAL, fn_exp, 1,V_REAL); + builtin(this,"false", V_INTEGER,fn_false, 0); + builtin(this,"find$", V_STRING, fn_find, 1,V_STRING); + builtin(this,"find$", V_STRING, fn_findi, 2,V_STRING,V_INTEGER); + builtin(this,"find$", V_STRING, fn_findd, 2,V_STRING,V_REAL); + builtin(this,"fix", V_REAL, fn_fix, 1,V_REAL); + builtin(this,"frac", V_REAL, fn_frac, 1,V_REAL); + builtin(this,"freefile",V_INTEGER,fn_freefile, 0); + builtin(this,"fp", V_REAL, fn_frac, 1,V_REAL); + builtin(this,"hex$", V_STRING, fn_hexi, 1,V_INTEGER); + builtin(this,"hex$", V_STRING, fn_hexd, 1,V_REAL); + builtin(this,"hex$", V_STRING, fn_hexii, 2,V_INTEGER,V_INTEGER); + builtin(this,"hex$", V_STRING, fn_hexdi, 2,V_REAL,V_INTEGER); + builtin(this,"hex$", V_STRING, fn_hexid, 2,V_INTEGER,V_REAL); + builtin(this,"hex$", V_STRING, fn_hexdd, 2,V_REAL,V_REAL); + builtin(this,"inkey$", V_STRING, fn_inkey, 0); + builtin(this,"inkey$", V_STRING, fn_inkeyi, 1,V_INTEGER); + builtin(this,"inkey$", V_STRING, fn_inkeyd, 1,V_REAL); + builtin(this,"inkey$", V_STRING, fn_inkeyii, 2,V_INTEGER,V_INTEGER); + builtin(this,"inkey$", V_STRING, fn_inkeyid, 2,V_INTEGER,V_REAL); + builtin(this,"inkey$", V_STRING, fn_inkeydi, 2,V_REAL,V_INTEGER); + builtin(this,"inkey$", V_STRING, fn_inkeydd, 2,V_REAL,V_REAL); + builtin(this,"inp", V_INTEGER,fn_inp, 1,V_INTEGER); + builtin(this,"input$", V_STRING, fn_input1, 1,V_INTEGER); + builtin(this,"input$", V_STRING, fn_input2, 2,V_INTEGER,V_INTEGER); + builtin(this,"instr", V_INTEGER,fn_instr2, 2,V_STRING,V_STRING); + builtin(this,"instr", V_INTEGER,fn_instr3iss, 3,V_INTEGER,V_STRING,V_STRING); + builtin(this,"instr", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER); + builtin(this,"instr", V_INTEGER,fn_instr3dss, 3,V_REAL,V_STRING,V_STRING); + builtin(this,"instr", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL); + builtin(this,"instr", V_INTEGER,fn_instr4ii, 4,V_STRING,V_STRING,V_INTEGER,V_INTEGER); + builtin(this,"instr", V_INTEGER,fn_instr4id, 4,V_STRING,V_STRING,V_INTEGER,V_REAL); + builtin(this,"instr", V_INTEGER,fn_instr4di, 4,V_STRING,V_STRING,V_REAL,V_INTEGER); + builtin(this,"instr", V_INTEGER,fn_instr4dd, 4,V_STRING,V_STRING,V_REAL,V_REAL); + builtin(this,"int", V_REAL, fn_int, 1,V_REAL); + builtin(this,"int%", V_INTEGER,fn_intp, 1,V_REAL); + builtin(this,"ip", V_REAL, fn_fix, 1,V_REAL); + builtin(this,"lcase$", V_STRING, fn_lcase, 1,V_STRING); + builtin(this,"lower$", V_STRING, fn_lcase, 1,V_STRING); + builtin(this,"left$", V_STRING, fn_left, 2,V_STRING,V_INTEGER); + builtin(this,"len", V_INTEGER,fn_len, 1,V_STRING); + builtin(this,"loc", V_INTEGER,fn_loc, 1,V_INTEGER); + builtin(this,"lof", V_INTEGER,fn_lof, 1,V_INTEGER); + builtin(this,"log", V_REAL, fn_log, 1,V_REAL); + builtin(this,"log10", V_REAL, fn_log10, 1,V_REAL); + builtin(this,"log2", V_REAL, fn_log2, 1,V_REAL); + builtin(this,"ltrim$", V_STRING, fn_ltrim, 1,V_STRING); + builtin(this,"match", V_INTEGER,fn_match, 3,V_STRING,V_STRING,V_INTEGER); + builtin(this,"max", V_INTEGER,fn_maxii, 2,V_INTEGER,V_INTEGER); + builtin(this,"max", V_REAL, fn_maxdi, 2,V_REAL,V_INTEGER); + builtin(this,"max", V_REAL, fn_maxid, 2,V_INTEGER,V_REAL); + builtin(this,"max", V_REAL, fn_maxdd, 2,V_REAL,V_REAL); + builtin(this,"mid$", V_STRING, fn_mid2i, 2,V_STRING,V_INTEGER); + builtin(this,"mid$", V_STRING, fn_mid2d, 2,V_STRING,V_REAL); + builtin(this,"mid$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER); + builtin(this,"mid$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL); + builtin(this,"mid$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER); + builtin(this,"mid$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL); + builtin(this,"min", V_INTEGER,fn_minii, 2,V_INTEGER,V_INTEGER); + builtin(this,"min", V_REAL, fn_mindi, 2,V_REAL,V_INTEGER); + builtin(this,"min", V_REAL, fn_minid, 2,V_INTEGER,V_REAL); + builtin(this,"min", V_REAL, fn_mindd, 2,V_REAL,V_REAL); + builtin(this,"mki$", V_STRING, fn_mki, 1,V_INTEGER); + builtin(this,"mks$", V_STRING, fn_mks, 1,V_REAL); + builtin(this,"mkd$", V_STRING, fn_mkd, 1,V_REAL); + builtin(this,"oct$", V_STRING, fn_oct, 1,V_INTEGER); + builtin(this,"peek", V_INTEGER,fn_peek, 1,V_INTEGER); + builtin(this,"pi", V_REAL, fn_pi, 0); + builtin(this,"pos", V_INTEGER,fn_pos, 1,V_INTEGER); + builtin(this,"pos", V_INTEGER,fn_pos, 1,V_REAL); + builtin(this,"pos", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER); + builtin(this,"pos", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL); + builtin(this,"rad", V_REAL, fn_rad, 1,V_REAL); + builtin(this,"right$", V_STRING, fn_right, 2,V_STRING,V_INTEGER); + builtin(this,"rnd", V_INTEGER,fn_rnd, 0); + builtin(this,"rnd", V_INTEGER,fn_rndd, 1,V_REAL); + builtin(this,"rnd", V_INTEGER,fn_rndi, 1,V_INTEGER); + builtin(this,"rtrim$", V_STRING, fn_rtrim, 1,V_STRING); + builtin(this,"seg$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER); + builtin(this,"seg$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL); + builtin(this,"seg$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER); + builtin(this,"seg$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL); + builtin(this,"sgn", V_INTEGER,fn_sgn, 1,V_REAL); + builtin(this,"sin", V_REAL, fn_sin, 1,V_REAL); + builtin(this,"space$", V_STRING, fn_space, 1,V_INTEGER); + builtin(this,"sqr", V_REAL, fn_sqr, 1,V_REAL); + builtin(this,"str$", V_STRING, fn_str, 1,V_REAL); + builtin(this,"str$", V_STRING, fn_str, 1,V_INTEGER); + builtin(this,"string$", V_STRING, fn_stringii, 2,V_INTEGER,V_INTEGER); + builtin(this,"string$", V_STRING, fn_stringid, 2,V_INTEGER,V_REAL); + builtin(this,"string$", V_STRING, fn_stringdi, 2,V_REAL,V_INTEGER); + builtin(this,"string$", V_STRING, fn_stringdd, 2,V_REAL,V_REAL); + builtin(this,"string$", V_STRING, fn_stringis, 2,V_INTEGER,V_STRING); + builtin(this,"string$", V_STRING, fn_stringds, 2,V_REAL,V_STRING); + builtin(this,"strip$", V_STRING, fn_strip, 1,V_STRING); + builtin(this,"tan", V_REAL, fn_tan, 1,V_REAL); + builtin(this,"time", V_INTEGER,fn_timei, 0); + builtin(this,"time$", V_STRING, fn_times, 0); + builtin(this,"timer", V_REAL, fn_timer, 0); + builtin(this,"tl$", V_STRING, fn_tl, 1,V_STRING); + builtin(this,"true", V_INTEGER,fn_true, 0); + builtin(this,"ucase$", V_STRING, fn_ucase, 1,V_STRING); + builtin(this,"upper$", V_STRING, fn_ucase, 1,V_STRING); + builtin(this,"val", V_REAL, fn_val, 1,V_STRING); + return this; +} +/*}}}*/ +int Global_find(struct Global *this, struct Identifier *ident, int oparen) /*{{{*/ +{ + struct Symbol **r; + + for + ( + r=&this->table[hash(ident->name)]; + *r!=(struct Symbol*)0 && ((((*r)->type==GLOBALVAR && oparen) || ((*r)->type==GLOBALARRAY && !oparen)) || cistrcmp((*r)->name,ident->name)); + r=&((*r)->next) + ); + if (*r==(struct Symbol*)0) return 0; + ident->sym=(*r); + return 1; +} +/*}}}*/ +int Global_variable(struct Global *this, struct Identifier *ident, enum ValueType type, enum SymbolType symbolType, int redeclare) /*{{{*/ +{ + struct Symbol **r; + + for + ( + r=&this->table[hash(ident->name)]; + *r!=(struct Symbol*)0 && ((*r)->type!=symbolType || cistrcmp((*r)->name,ident->name)); + r=&((*r)->next) + ); + if (*r==(struct Symbol*)0) + { + *r=malloc(sizeof(struct Symbol)); + (*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name); + (*r)->next=(struct Symbol*)0; + (*r)->type=symbolType; + Var_new(&((*r)->u.var),type,0,(unsigned int*)0,0); + } + else if (redeclare) Var_retype(&((*r)->u.var),type); + switch ((*r)->type) + { + case GLOBALVAR: + case GLOBALARRAY: + { + ident->sym=(*r); + break; + } + case BUILTINFUNCTION: + { + return 0; + } + case USERFUNCTION: + { + return 0; + } + default: assert(0); + } + return 1; +} +/*}}}*/ +int Global_function(struct Global *this, struct Identifier *ident, enum ValueType type, struct Pc *deffn, struct Pc *begin, int argLength, enum ValueType *argTypes) /*{{{*/ +{ + struct Symbol **r; + + for + ( + r=&this->table[hash(ident->name)]; + *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name); + r=&((*r)->next) + ); + if (*r!=(struct Symbol*)0) return 0; + *r=malloc(sizeof(struct Symbol)); + (*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name); + (*r)->next=(struct Symbol*)0; + (*r)->type=USERFUNCTION; + (*r)->u.sub.u.def.scope.start=*deffn; + (*r)->u.sub.u.def.scope.begin=*begin; + (*r)->u.sub.argLength=argLength; + (*r)->u.sub.argTypes=argTypes; + (*r)->u.sub.retType=type; + (*r)->u.sub.u.def.localLength=0; + (*r)->u.sub.u.def.localTypes=(enum ValueType*)0; + ident->sym=(*r); + return 1; +} +/*}}}*/ +void Global_endfunction(struct Global *this, struct Identifier *ident, struct Pc *end) /*{{{*/ +{ + struct Symbol **r; + + for + ( + r=&this->table[hash(ident->name)]; + *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name); + r=&((*r)->next) + ); + assert(*r!=(struct Symbol*)0); + (*r)->u.sub.u.def.scope.end=*end; +} +/*}}}*/ +void Global_clear(struct Global *this) /*{{{*/ +{ + int i; + + for (i=0; i<GLOBAL_HASHSIZE; ++i) + { + struct Symbol *v; + + for (v=this->table[i]; v; v=v->next) + { + if (v->type==GLOBALVAR || v->type==GLOBALARRAY) Var_clear(&(v->u.var)); + } + } +} +/*}}}*/ +void Global_clearFunctions(struct Global *this) /*{{{*/ +{ + int i; + + for (i=0; i<GLOBAL_HASHSIZE; ++i) + { + struct Symbol **v=&this->table[i],*w; + struct Symbol *sym; + + while (*v) + { + sym=*v; + w=sym->next; + if (sym->type==USERFUNCTION) + { + if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes); + if (sym->u.sub.argTypes) free(sym->u.sub.argTypes); + free(sym->name); + free(sym); + *v=w; + } + else v=&sym->next; + } + } +} +/*}}}*/ +void Global_destroy(struct Global *this) /*{{{*/ +{ + int i; + + for (i=0; i<GLOBAL_HASHSIZE; ++i) + { + struct Symbol *v=this->table[i],*w; + struct Symbol *sym; + + while (v) + { + sym=v; + w=v->next; + switch (sym->type) + { + case GLOBALVAR: + case GLOBALARRAY: Var_destroy(&(sym->u.var)); break; + case USERFUNCTION: + { + if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes); + if (sym->u.sub.argTypes) free(sym->u.sub.argTypes); + break; + } + case BUILTINFUNCTION: + { + if (sym->u.sub.argTypes) free(sym->u.sub.argTypes); + if (sym->u.sub.u.bltin.next) + { + sym=sym->u.sub.u.bltin.next; + while (sym) + { + struct Symbol *n; + + if (sym->u.sub.argTypes) free(sym->u.sub.argTypes); + n=sym->u.sub.u.bltin.next; + free(sym); + sym=n; + } + } + break; + } + default: assert(0); + } + free(v->name); + free(v); + v=w; + } + this->table[i]=(struct Symbol*)0; + } +} +/*}}}*/ diff --git a/apps/interpreters/bas/global.h b/apps/interpreters/bas/global.h new file mode 100644 index 000000000..0fd211c05 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/install-sh b/apps/interpreters/bas/install-sh new file mode 100644 index 000000000..377bb8687 --- /dev/null +++ b/apps/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: diff --git a/apps/interpreters/bas/main.c b/apps/interpreters/bas/main.c new file mode 100644 index 000000000..9c8176cd8 --- /dev/null +++ b/apps/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); +} +/*}}}*/ diff --git a/apps/interpreters/bas/program.c b/apps/interpreters/bas/program.c new file mode 100644 index 000000000..a0e046a95 --- /dev/null +++ b/apps/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; + } +} +/*}}}*/ diff --git a/apps/interpreters/bas/program.h b/apps/interpreters/bas/program.h new file mode 100644 index 000000000..5b6646d99 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/programtypes.h b/apps/interpreters/bas/programtypes.h new file mode 100644 index 000000000..fd673c901 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/statement.c b/apps/interpreters/bas/statement.c new file mode 100644 index 000000000..608797d6d --- /dev/null +++ b/apps/interpreters/bas/statement.c @@ -0,0 +1,4052 @@ +/* #includes */ /*{{{C}}}*//*{{{*/ +#include "config.h" + +#ifdef HAVE_GETTEXT +#include <libintl.h> +#define _(String) gettext(String) +#else +#define _(String) String +#endif + +#include "statement.h" + +#ifdef USE_DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ + +struct Value *stmt_CALL(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGPROCIDENT); + if (pass==DECLARE) + { + if (func(value)->type==V_ERROR) return value; + else Value_destroy(value); + } + else + { + if (pass==COMPILE) + { + if + ( + Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + if (pc.token->u.identifier->sym->type!=USERFUNCTION && pc.token->u.identifier->sym->type!=BUILTINFUNCTION) return Value_new_ERROR(value,TYPEMISMATCH1,"variable","function"); + func(value); + if (Value_retype(value,V_VOID)->type==V_ERROR) return value; + Value_destroy(value); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_CASE(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + if (pass==DECLARE || pass==COMPILE) + { + struct Pc *selectcase,*nextcasevalue; + + if ((selectcase=findLabel(L_SELECTCASE))==(struct Pc*)0) return Value_new_ERROR(value,STRAYCASE); + for (nextcasevalue=&selectcase->token->u.selectcase->nextcasevalue; nextcasevalue->line!=-1; nextcasevalue=&nextcasevalue->token->u.casevalue->nextcasevalue); + *nextcasevalue=pc; + if (pass==COMPILE) pc.token->u.casevalue->endselect=selectcase->token->u.selectcase->endselect; + pc.token->u.casevalue->nextcasevalue.line=-1; + ++pc.token; + switch (statementpc.token->type) + { + case T_CASEELSE: break; + case T_CASEVALUE: + { + struct Pc exprpc; + + do + { + if (pc.token->type==T_IS) /*{{{*/ + { + ++pc.token; + switch (pc.token->type) + { + case T_LT: + case T_LE: + case T_EQ: + case T_GE: + case T_GT: + case T_NE: break; + default: return Value_new_ERROR(value,MISSINGRELOP); + } + ++pc.token; + exprpc=pc; + if (eval(value,"`is'")->type==V_ERROR) return value; + if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR) + { + pc=exprpc; + return value; + } + Value_destroy(value); + } + /*}}}*/ + else /* value or range */ /*{{{*/ + { + exprpc=pc; + if (eval(value,"`case'")->type==V_ERROR) return value; + if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR) + { + pc=exprpc; + return value; + } + Value_destroy(value); + if (pc.token->type==T_TO) /*{{{*/ + { + ++pc.token; + exprpc=pc; + if (eval(value,"`case'")->type==V_ERROR) return value; + if (Value_retype(value,selectcase->token->u.selectcase->type)->type==V_ERROR) + { + pc=exprpc; + return value; + } + Value_destroy(value); + } + /*}}}*/ + } + /*}}}*/ + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } while (1); + break; + } + default: assert(0); + } + } + else pc=pc.token->u.casevalue->endselect; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_CHDIR_MKDIR(struct Value *value) /*{{{*/ +{ + int res=-1,err=-1; + struct Pc dirpc; + struct Pc statementpc=pc; + + ++pc.token; + dirpc=pc; + if (eval(value,_("directory"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pass==INTERPRET) + { + switch (statementpc.token->type) + { + case T_CHDIR: res=chdir(value->u.string.character); break; + case T_MKDIR: res=mkdir(value->u.string.character,0777); break; + default: assert(0); + } + err=errno; + } + Value_destroy(value); + if (pass==INTERPRET && res==-1) + { + pc=dirpc; + return Value_new_ERROR(value,IOERROR,strerror(err)); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_CLEAR(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + Global_clear(&globals); + FS_closefiles(); + } + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_CLOSE(struct Value *value) /*{{{*/ +{ + int hasargs=0; + struct Pc chnpc; + + ++pc.token; + while (1) + { + chnpc=pc; + if (pc.token->type==T_CHANNEL) { hasargs=1; ++pc.token; } + if (eval(value,(const char*)0)==(struct Value*)0) + { + if (hasargs) return Value_new_ERROR(value,MISSINGEXPR,_("channel")); + else break; + } + hasargs=1; + if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + if (pass==INTERPRET && FS_close(value->u.integer)==-1) + { + Value_destroy(value); + pc=chnpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (!hasargs && pass==INTERPRET) FS_closefiles(); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_CLS(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + ++pc.token; + if (pass==INTERPRET && FS_cls(STDCHANNEL)==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_COLOR(struct Value *value) /*{{{*/ +{ + int foreground=-1,background=-1; + struct Pc statementpc=pc; + + ++pc.token; + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + foreground=value->u.integer; + if (foreground<0 || foreground>15) + { + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,OUTOFRANGE,_("foreground colour")); + } + } + Value_destroy(value); + if (pc.token->type==T_COMMA) + { + ++pc.token; + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + background=value->u.integer; + if (background<0 || background>15) + { + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,OUTOFRANGE,_("background colour")); + } + } + Value_destroy(value); + if (pc.token->type==T_COMMA) + { + ++pc.token; + if (eval(value,(const char*)0)) + { + int bordercolour=-1; + + if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + bordercolour=value->u.integer; + if (bordercolour<0 || bordercolour>15) + { + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,OUTOFRANGE,_("border colour")); + } + } + Value_destroy(value); + } + } + if (pass==INTERPRET) FS_colour(STDCHANNEL,foreground,background); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DATA(struct Value *value) /*{{{*/ +{ + if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE); + if (pass==DECLARE) + { + *lastdata=pc; + (lastdata=&(pc.token->u.nextdata))->line=-1; + } + ++pc.token; + while (1) + { + if (pc.token->type!=T_STRING && pc.token->type!=T_DATAINPUT) return Value_new_ERROR(value,MISSINGDATAINPUT); + ++pc.token; + if (pc.token->type!=T_COMMA) break; + else ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) + { + struct Pc statementpc=pc; + struct Identifier *fn; + int proc; + int args=0; + + if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE); + proc=(pc.token->type==T_DEFPROC || pc.token->type==T_SUB); + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) + { + if (proc) return Value_new_ERROR(value,MISSINGPROCIDENT); + else return Value_new_ERROR(value,MISSINGFUNCIDENT); + } + fn=pc.token->u.identifier; + if (proc) fn->defaultType=V_VOID; + ++pc.token; + if (findLabel(L_FUNC)) + { + pc=statementpc; + return Value_new_ERROR(value,NESTEDDEFINITION); + } + Auto_variable(&stack,fn); + if (pc.token->type==T_OP) /* arguments */ /*{{{*/ + { + ++pc.token; + while (1) + { + if (pc.token->type!=T_IDENTIFIER) + { + Auto_funcEnd(&stack); + return Value_new_ERROR(value,MISSINGFORMIDENT); + } + if (Auto_variable(&stack,pc.token->u.identifier)==0) + { + Auto_funcEnd(&stack); + return Value_new_ERROR(value,ALREADYDECLARED); + } + ++args; + ++pc.token; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pc.token->type!=T_CP) + { + Auto_funcEnd(&stack); + return Value_new_ERROR(value,MISSINGCP); + } + ++pc.token; + } + /*}}}*/ + if (pass==DECLARE) + { + enum ValueType *t=args ? malloc(args*sizeof(enum ValueType)) : (enum ValueType*)0; + int i; + + for (i=0; i<args; ++i) t[i]=Auto_argType(&stack,i); + if (Global_function(&globals,fn,fn->defaultType,&pc,&statementpc,args,t)==0) + { + free(t); + Auto_funcEnd(&stack); + pc=statementpc; + return Value_new_ERROR(value,REDECLARATION); + } + Program_addScope(&program,&fn->sym->u.sub.u.def.scope); + } + pushLabel(L_FUNC,&statementpc); + if (pc.token->type==T_EQ) return stmt_EQ_FNRETURN_FNEND(value); + } + else pc=(pc.token+1)->u.identifier->sym->u.sub.u.def.scope.end; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DEC_INC(struct Value *value) /*{{{*/ +{ + int step; + + step=(pc.token->type==T_DEC ? -1 : 1); + ++pc.token; + while (1) + { + struct Value *l,stepValue; + struct Pc lvaluepc; + + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGDECINCIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if ((l=lvalue(value))->type==V_ERROR) return value; + if (l->type==V_INTEGER) VALUE_NEW_INTEGER(&stepValue,step); + else if (l->type==V_REAL) VALUE_NEW_REAL(&stepValue,(double)step); + else + { + pc=lvaluepc; + return Value_new_ERROR(value,TYPEMISMATCH5); + } + if (pass==INTERPRET) Value_add(l,&stepValue,1); + Value_destroy(&stepValue); + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value) /*{{{*/ +{ + enum ValueType dsttype=V_NIL; + + switch (pc.token->type) + { + case T_DEFINT: dsttype=V_INTEGER; break; + case T_DEFDBL: dsttype=V_REAL; break; + case T_DEFSTR: dsttype=V_STRING; break; + default: assert(0); + } + ++pc.token; + while (1) + { + struct Identifier *ident; + + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (pc.token->u.identifier->defaultType!=V_REAL) switch (dsttype) + { + case V_INTEGER: return Value_new_ERROR(value,BADIDENTIFIER,_("integer")); + case V_REAL: return Value_new_ERROR(value,BADIDENTIFIER,_("real")); + case V_STRING: return Value_new_ERROR(value,BADIDENTIFIER,_("string")); + default: assert(0); + } + ident=pc.token->u.identifier; + ++pc.token; + if (pc.token->type==T_MINUS) + { + struct Identifier i; + + if (strlen(ident->name)!=1) return Value_new_ERROR(value,BADRANGE); + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (strlen(pc.token->u.identifier->name)!=1) return Value_new_ERROR(value,BADRANGE); + for (i.name[0]=tolower(ident->name[0]),i.name[1]='\0'; i.name[0]<=tolower(pc.token->u.identifier->name[0]); ++i.name[0]) + { + Global_variable(&globals,&i,dsttype,GLOBALVAR,1); + } + ++pc.token; + } + else Global_variable(&globals,ident,dsttype,GLOBALVAR,1); + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DELETE(struct Value *value) /*{{{*/ +{ + struct Pc from,to; + int f=0,t=0; + + if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==INTERPRET && Program_goLine(&program,pc.token->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + f=1; + ++pc.token; + } + if (pc.token->type==T_MINUS || pc.token->type==T_COMMA) + { + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==INTERPRET && Program_goLine(&program,pc.token->u.integer,&to)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + t=1; + ++pc.token; + } + } + else if (f==1) + { + to=from; + t=1; + } + if (!f && !t) return Value_new_ERROR(value,MISSINGLINENUMBER); + if (pass==INTERPRET) + { + Program_delete(&program,f?&from:(struct Pc*)0,t?&to:(struct Pc*)0); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DIM(struct Value *value) /*{{{*/ +{ + ++pc.token; + while (1) + { + unsigned int capacity=0,*geometry=(unsigned int*)0; + struct Var *var; + struct Pc dimpc; + unsigned int dim; + enum ValueType vartype; + + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + if (pass==INTERPRET && var->dim) return Value_new_ERROR(value,REDIM); + vartype=var->type; + ++pc.token; + if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP); + ++pc.token; + dim=0; + while (1) + { + dimpc=pc; + if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) + { + if (capacity) free(geometry); + return value; + } + if (pass==INTERPRET && value->u.integer<optionbase) /* error */ /*{{{*/ + { + Value_destroy(value); + Value_new_ERROR(value,OUTOFRANGE,_("dimension")); + } + /*}}}*/ + if (value->type==V_ERROR) /* abort */ /*{{{*/ + { + if (capacity) free(geometry); + pc=dimpc; + return value; + } + /*}}}*/ + if (pass==INTERPRET) + { + if (dim==capacity) /* enlarge geometry */ /*{{{*/ + { + unsigned int *more; + + more=realloc(geometry,sizeof(unsigned int)*(capacity?(capacity*=2):(capacity=3))); + geometry=more; + } + /*}}}*/ + geometry[dim]=value->u.integer-optionbase+1; + ++dim; + } + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pc.token->type!=T_CP) /* abort */ /*{{{*/ + { + if (capacity) free(geometry); + return Value_new_ERROR(value,MISSINGCP); + } + /*}}}*/ + ++pc.token; + if (pass==INTERPRET) + { + struct Var newarray; + + assert(capacity); + if (Var_new(&newarray,vartype,dim,geometry,optionbase)==(struct Var*)0) + { + free(geometry); + return Value_new_ERROR(value,OUTOFMEMORY); + } + Var_destroy(var); + *var=newarray; + free(geometry); + } + if (pc.token->type==T_COMMA) ++pc.token; /* advance to next var */ + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DISPLAY(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + ++pc.token; + if (eval(value,_("file name"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR)) return value; + if (pass==INTERPRET && cat(value->u.string.character)==-1) + { + char *msg=strerror(errno); + + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,IOERROR,msg); + } + else Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DO(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) pushLabel(L_DO,&pc); + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_DOcondition(struct Value *value) /*{{{*/ +{ + struct Pc dowhilepc=pc; + int negate=(pc.token->type==T_DOUNTIL); + + if (pass==DECLARE || pass==COMPILE) pushLabel(L_DOcondition,&pc); + ++pc.token; + if (eval(value,"condition")->type==V_ERROR) return value; + if (pass==INTERPRET) + { + int condition; + + condition=Value_isNull(value); + if (negate) condition=!condition; + if (condition) pc=dowhilepc.token->u.exitdo; + Value_destroy(value); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_EDIT(struct Value *value) /*{{{*/ +{ + long int line; + struct Pc statementpc=pc; + + ++pc.token; + if (pc.token->type==T_INTEGER) + { + struct Pc where; + + if (program.numbered) + { + if (Program_goLine(&program,pc.token->u.integer,&where)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + line=where.line+1; + } + else + { + if (!Program_end(&program,&where)) return Value_new_ERROR(value,NOPROGRAM); + line=pc.token->u.integer; + if (line<1 || line>(where.line+1)) return Value_new_ERROR(value,NOSUCHLINE); + } + ++pc.token; + } + else line=1; + if (pass==INTERPRET) + { + /* variables */ /*{{{*/ + char *name; + int chn; + struct Program newProgram; + const char *visual,*basename,*shell; + struct String cmd; + static struct + { + const char *editor,*flag; + } + gotoLine[]= + { + { "Xemacs", "+%ld " }, + { "cemacs", "+%ld " }, + { "emacs", "+%ld " }, + { "emori", "-l%ld " }, + { "fe", "-l%ld " }, + { "jed", "+%ld " }, + { "jmacs", "+%ld " }, + { "joe", "+%ld " }, + { "modeori", "-l%ld " }, + { "origami", "-l%ld " }, + { "vi", "-c%ld " }, + { "vim", "+%ld " }, + { "xemacs", "+%ld " } + }; + unsigned int i; + pid_t pid; + /*}}}*/ + + if (!DIRECTMODE) + { + pc=statementpc; + return Value_new_ERROR(value,NOTINPROGRAMMODE); + } + if ((name=mytmpnam())==(char*)0) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,_("generating temporary file name failed")); + } + if ((chn=FS_openout(name))==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERRORCREATE,name,FS_errmsg); + } + FS_width(chn,0); + if (Program_list(&program,chn,0,(struct Pc*)0,(struct Pc*)0,value)) + { + pc=statementpc; + return value; + } + if (FS_close(chn)==-1) + { + pc=statementpc; + unlink(name); + return Value_new_ERROR(value,IOERRORCLOSE,name,FS_errmsg); + } + if ((visual=getenv("VISUAL"))==(char*)0 && (visual=getenv("EDITOR"))==(char*)0) visual="vi"; + basename=strrchr(visual,'/'); + if (basename==(char*)0) basename=visual; + if ((shell=getenv("SHELL"))==(char*)0) shell="/bin/sh"; + String_new(&cmd); + String_appendChars(&cmd,visual); + String_appendChar(&cmd,' '); + for (i=0; i<sizeof(gotoLine)/sizeof(gotoLine[0]); ++i) + { + if (strcmp(basename,gotoLine[i].editor)==0) + { + String_appendPrintf(&cmd,gotoLine[i].flag,line); + break; + } + } + String_appendChars(&cmd,name); + FS_shellmode(STDCHANNEL); + switch (pid=vfork()) + { + case -1: + { + unlink(name); + FS_fsmode(STDCHANNEL); + return Value_new_ERROR(value,FORKFAILED,strerror(errno)); + } + case 0: + { + execl(shell,shell,"-c",cmd.character,(const char*)0); + exit(127); + } + default: + { + pid_t r; + + while ((r=wait((int*)0))!=-1 && r!=pid); + } + } + FS_fsmode(STDCHANNEL); + String_destroy(&cmd); + if ((chn=FS_openin(name))==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROROPEN,name,FS_errmsg); + } + Program_new(&newProgram); + if (Program_merge(&newProgram,chn,value)) + { + FS_close(chn); + unlink(name); + pc=statementpc; + return value; + } + FS_close(chn); + Program_setname(&newProgram,program.name.character); + Program_destroy(&program); + program=newProgram; + unlink(name); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + pc=pc.token->u.endifpc; + } + if (pass==DECLARE || pass==COMPILE) + { + struct Pc elsepc=pc; + struct Pc *ifinstr; + int elseifelse=(pc.token->type==T_ELSEIFELSE); + + if ((ifinstr=popLabel(L_IF))==(struct Pc*)0) return Value_new_ERROR(value,STRAYELSE1); + if (ifinstr->token->type==T_ELSEIFIF) (ifinstr->token-1)->u.elsepc=pc; + ++pc.token; + ifinstr->token->u.elsepc=pc; + assert(ifinstr->token->type==T_ELSEIFIF || ifinstr->token->type==T_IF); + if (elseifelse) return &more_statements; + else pushLabel(L_ELSE,&elsepc); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_END(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + pc=pc.token->u.endpc; + bas_end=1; + } + if (pass==DECLARE || pass==COMPILE) + { + if (Program_end(&program,&pc.token->u.endpc)) ++pc.token; + else + { + struct Token *eol; + + for (eol=pc.token; eol->type!=T_EOL; ++eol); + + pc.token->u.endpc=pc; + pc.token->u.endpc.token=eol; + ++pc.token; + } +#if 0 + else return Value_new_ERROR(value,NOPROGRAM); +#endif + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ENDIF(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) + { + struct Pc endifpc=pc; + struct Pc *ifpc; + struct Pc *elsepc; + + if ((ifpc=popLabel(L_IF))) + { + ifpc->token->u.elsepc=endifpc; + if (ifpc->token->type==T_ELSEIFIF) (ifpc->token-1)->u.elsepc=pc; + } + else if ((elsepc=popLabel(L_ELSE))) elsepc->token->u.endifpc=endifpc; + else return Value_new_ERROR(value,STRAYENDIF); + } + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ENDFN(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + struct Pc eqpc=pc; + + if (pass==DECLARE || pass==COMPILE) + { + if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDFN); + if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDFN); + } + ++pc.token; + if (pass==INTERPRET) return Value_clone(value,Var_value(Auto_local(&stack,0),0,(int*)0,(struct Value*)0)); + else + { + if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc); + Auto_funcEnd(&stack); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ENDPROC_SUBEND(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + + if (pass==DECLARE || pass==COMPILE) + { + if ((curfn=popLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType!=V_VOID) + { + if (curfn!=(struct Pc*)0) pushLabel(L_FUNC,curfn); + return Value_new_ERROR(value,STRAYSUBEND,topLabelDescription()); + } + } + ++pc.token; + if (pass==INTERPRET) return Value_new_VOID(value); + else + { + if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc); + Auto_funcEnd(&stack); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ENDSELECT(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + ++pc.token; + if (pass==DECLARE || pass==COMPILE) + { + struct Pc *selectcasepc; + + if ((selectcasepc=popLabel(L_SELECTCASE))) selectcasepc->token->u.selectcase->endselect=pc; + else + { + pc=statementpc; + return Value_new_ERROR(value,STRAYENDSELECT); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ENVIRON(struct Value *value) /*{{{*/ +{ + struct Pc epc=pc; + + ++pc.token; + if (eval(value,_("environment variable"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pass==INTERPRET && value->u.string.character) + { + if (putenv(value->u.string.character)==-1) + { + Value_destroy(value); + pc=epc; + return Value_new_ERROR(value,ENVIRONFAILED,strerror(errno)); + } + } + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_FNEXIT(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + + if (pass==DECLARE || pass==COMPILE) + { + if ((curfn=findLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType==V_VOID) + { + return Value_new_ERROR(value,STRAYFNEXIT); + } + } + ++pc.token; + if (pass==INTERPRET) return Value_clone(value,Var_value(Auto_local(&stack,0),0,(int*)0,(struct Value*)0)); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_COLON_EOL(struct Value *value) /*{{{*/ +{ + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_QUOTE_REM(struct Value *value) /*{{{*/ +{ + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + struct Pc eqpc=pc; + enum TokenType t=pc.token->type; + + if (pass==DECLARE || pass==COMPILE) + { + if (t==T_EQ) + { + if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDEQ); + if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDEQ); + } + else if (t==T_FNEND) + { + if ((curfn=popLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYENDFN); + if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYENDFN); + } + else + { + if ((curfn=findLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYFNRETURN); + if ((eqpc.token->u.type=(curfn->token+1)->u.identifier->defaultType)==V_VOID) return Value_new_ERROR(value,STRAYFNRETURN); + } + } + ++pc.token; + if (eval(value,_("return"))->type==V_ERROR || Value_retype(value,eqpc.token->u.type)->type==V_ERROR) + { + if (pass!=INTERPRET) Auto_funcEnd(&stack); + pc=eqpc; + return value; + } + if (pass==INTERPRET) return value; + else + { + Value_destroy(value); + if (t==T_EQ || t==T_FNEND) + { + if (pass==DECLARE) Global_endfunction(&globals,(curfn->token+1)->u.identifier,&pc); + Auto_funcEnd(&stack); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ERASE(struct Value *value) /*{{{*/ +{ + ++pc.token; + while (1) + { + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if (pass==INTERPRET) + { + Var_destroy(&pc.token->u.identifier->sym->u.var); + } + ++pc.token; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_EXITDO(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) pc=pc.token->u.exitdo; + else + { + if (pass==COMPILE) + { + struct Pc *exitdo; + + if ((exitdo=findLabel(L_DO))==(struct Pc*)0 && (exitdo=findLabel(L_DOcondition))==(struct Pc*)0) return Value_new_ERROR(value,STRAYEXITDO); + pc.token->u.exitdo=exitdo->token->u.exitdo; + } + ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_EXITFOR(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) pc=pc.token->u.exitfor; + else + { + if (pass==COMPILE) + { + struct Pc *exitfor; + + if ((exitfor=findLabel(L_FOR))==(struct Pc*)0) return Value_new_ERROR(value,STRAYEXITFOR); + pc.token->u.exitfor=exitfor->token->u.exitfor; + } + ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_FIELD(struct Value *value) /*{{{*/ +{ + long int chn,offset,recLength=-1; + + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && (recLength=FS_recLength(chn))==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + offset=0; + while (1) + { + struct Pc curpc; + struct Value *l; + long int width; + + curpc=pc; + if (eval(value,_("field width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + width=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && offset+width>recLength) + { + pc=curpc; + return Value_new_ERROR(value,OUTOFRANGE,_("field width")); + } + if (pc.token->type!=T_AS) return Value_new_ERROR(value,MISSINGAS); + ++pc.token; + curpc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if ((l=lvalue(value))->type==V_ERROR) return value; + if (pass!=DECLARE && l->type!=V_STRING) + { + pc=curpc; + return Value_new_ERROR(value,TYPEMISMATCH4); + } + if (pass==INTERPRET) FS_field(chn,&l->u.string,offset,width); + offset+=width; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_FOR(struct Value *value) /*{{{*/ +{ + struct Pc forpc=pc; + struct Pc varpc; + struct Pc limitpc; + struct Value limit,stepValue; + + ++pc.token; + varpc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGLOOPIDENT); + if (assign(value)->type==V_ERROR) return value; + if (pass==INTERPRET) + { + ++pc.token; + if (eval(&limit,(const char*)0)->type==V_ERROR) + { + *value=limit; + return value; + } + Value_retype(&limit,value->type); + assert(limit.type!=V_ERROR); + if (pc.token->type==T_STEP) /* STEP x */ /*{{{*/ + { + struct Pc stepPc; + + ++pc.token; + stepPc=pc; + if (eval(&stepValue,"`step'")->type==V_ERROR) + { + Value_destroy(value); + *value=stepValue; + pc=stepPc; + return value; + } + Value_retype(&stepValue,value->type); + assert(stepValue.type!=V_ERROR); + } + /*}}}*/ + else /* implicit numeric STEP */ /*{{{*/ + { + if (value->type==V_INTEGER) VALUE_NEW_INTEGER(&stepValue,1); + else VALUE_NEW_REAL(&stepValue,1.0); + } + /*}}}*/ + if (Value_exitFor(value,&limit,&stepValue)) pc=forpc.token->u.exitfor; + Value_destroy(&limit); + Value_destroy(&stepValue); + Value_destroy(value); + } + else + { + pushLabel(L_FOR,&forpc); + pushLabel(L_FOR_VAR,&varpc); + if (pc.token->type!=T_TO) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGTO); + } + ++pc.token; + pushLabel(L_FOR_LIMIT,&pc); + limitpc=pc; + if (eval(&limit,(const char*)0)==(struct Value*)0) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGEXPR,"`to'"); + } + if (limit.type==V_ERROR) + { + Value_destroy(value); + *value=limit; + return value; + } + if (pass!=DECLARE) + { + struct Symbol *sym=varpc.token->u.identifier->sym; + + if (VALUE_RETYPE(&limit,sym->type==GLOBALVAR || sym->type==GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,sym))->type==V_ERROR) + { + Value_destroy(value); + *value=limit; + pc=limitpc; + return value; + } + } + Value_destroy(&limit); + if (pc.token->type==T_STEP) /* STEP x */ /*{{{*/ + { + struct Pc stepPc; + + ++pc.token; + stepPc=pc; + if (eval(&stepValue,"`step'")->type==V_ERROR || (pass!=DECLARE && Value_retype(&stepValue,value->type)->type==V_ERROR)) + { + Value_destroy(value); + *value=stepValue; + pc=stepPc; + return value; + } + } + /*}}}*/ + else /* implicit numeric STEP */ /*{{{*/ + { + VALUE_NEW_INTEGER(&stepValue,1); + if (pass!=DECLARE && VALUE_RETYPE(&stepValue,value->type)->type==V_ERROR) + { + Value_destroy(value); + *value=stepValue; + Value_errorPrefix(value,_("implicit STEP 1:")); + return value; + } + } + /*}}}*/ + pushLabel(L_FOR_BODY,&pc); + Value_destroy(&stepValue); + Value_destroy(value); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_GET_PUT(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + int put=pc.token->type==T_PUT; + long int chn; + struct Pc errpc; + + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) + { + ++pc.token; + errpc=pc; + if (eval(value,(const char*)0)) /* process record number/position */ /*{{{*/ + { + int rec; + + if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + rec=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET) + { + if (rec<1) + { + pc=errpc; + return Value_new_ERROR(value,OUTOFRANGE,_("record number")); + } + if (FS_seek((int)chn,rec-1)==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + } + /*}}}*/ + } + if (pc.token->type==T_COMMA) /* BINARY mode get/put */ /*{{{*/ + { + int res=-1; + + ++pc.token; + if (put) + { + if (eval(value,_("`put'/`get' data"))->type==V_ERROR) return value; + if (pass==INTERPRET) + { + switch (value->type) + { + case V_INTEGER: res=FS_putbinaryInteger(chn,value->u.integer); break; + case V_REAL: res=FS_putbinaryReal(chn,value->u.real); break; + case V_STRING: res=FS_putbinaryString(chn,&value->u.string); break; + default: assert(0); + } + } + Value_destroy(value); + } + else + { + struct Value *l; + + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGPROCIDENT); + if (pass==DECLARE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0 + ) + { + return Value_new_ERROR(value,REDECLARATION); + } + } + if ((l=lvalue(value))->type==V_ERROR) return value; + if (pass==INTERPRET) + { + switch (l->type) + { + case V_INTEGER: res=FS_getbinaryInteger(chn,&l->u.integer); break; + case V_REAL: res=FS_getbinaryReal(chn,&l->u.real); break; + case V_STRING: res=FS_getbinaryString(chn,&l->u.string); break; + default: assert(0); + } + } + } + if (pass==INTERPRET && res==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + /*}}}*/ + else if (pass==INTERPRET && ((put ? FS_put : FS_get)(chn))==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_GOSUB(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + if (!program.runnable && compileProgram(value,!DIRECTMODE)->type==V_ERROR) return value; + pc.token+=2; + Auto_pushGosubRet(&stack,&pc); + pc=(pc.token-2)->u.gosubpc; + Program_trace(&program,&pc,0,1); + } + if (pass==DECLARE || pass==COMPILE) + { + struct Token *gosubpc=pc.token; + + ++pc.token; + if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER); + if (Program_goLine(&program,pc.token->u.integer,&gosubpc->u.gosubpc)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + if (pass==COMPILE && Program_scopeCheck(&program,&gosubpc->u.gosubpc,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE); + ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RESUME_GOTO(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + if (!program.runnable && compileProgram(value,!DIRECTMODE)->type==V_ERROR) return value; + if (pc.token->type==T_RESUME) + { + if (!stack.resumeable) return Value_new_ERROR(value,STRAYRESUME); + stack.resumeable=0; + } + pc=pc.token->u.gotopc; + Program_trace(&program,&pc,0,1); + } + else if (pass==DECLARE || pass==COMPILE) + { + struct Token *gotopc=pc.token; + + ++pc.token; + if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER); + if (Program_goLine(&program,pc.token->u.integer,&gotopc->u.gotopc)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + if (pass==COMPILE && Program_scopeCheck(&program,&gotopc->u.gotopc,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE); + ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_KILL(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + ++pc.token; + if (eval(value,_("file name"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR)) return value; + if (pass==INTERPRET && unlink(value->u.string.character)==-1) + { + char *msg=strerror(errno); + + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,IOERROR,msg); + } + else Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LET(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (assign(value)->type==V_ERROR) return value; + if (pass!=INTERPRET) Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LINEINPUT(struct Value *value) /*{{{*/ +{ + int channel=0; + struct Pc lpc; + struct Value *l; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + channel=value->u.integer; + Value_destroy(value); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + else ++pc.token; + } + /*}}}*/ + /* prompt */ /*{{{*/ + if (pc.token->type==T_STRING) + { + if (pass==INTERPRET && channel==0) FS_putString(channel,pc.token->u.string); + ++pc.token; + if (pc.token->type!=T_SEMICOLON && pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGSEMICOMMA); + ++pc.token; + } + if (pass==INTERPRET && channel==0) FS_flush(channel); + /*}}}*/ + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + lpc=pc; + if (((l=lvalue(value))->type)==V_ERROR) return value; + if (pass==COMPILE && l->type!=V_STRING) + { + pc=lpc; + return Value_new_ERROR(value,TYPEMISMATCH4); + } + if (pass==INTERPRET) + { + String_size(&l->u.string,0); + if (FS_appendToString(channel,&l->u.string,1)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + if (l->u.string.length==0) return Value_new_ERROR(value,IOERROR,_("end of file")); + if (l->u.string.character[l->u.string.length-1]=='\n') + { + String_size(&l->u.string,l->u.string.length-1); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LIST_LLIST(struct Value *value) /*{{{*/ +{ + struct Pc from,to; + int f=0,t=0,channel; + + channel=(pc.token->type==T_LLIST?LPCHANNEL:STDCHANNEL); + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==INTERPRET && Program_fromLine(&program,pc.token->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + f=1; + ++pc.token; + } + else if (pc.token->type!=T_MINUS && pc.token->type!=T_COMMA) + { + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + if (pass==INTERPRET && Program_fromLine(&program,value->u.integer,&from)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + f=1; + Value_destroy(value); + } + } + if (pc.token->type==T_MINUS || pc.token->type==T_COMMA) + { + ++pc.token; + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + if (pass==INTERPRET && Program_toLine(&program,value->u.integer,&to)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + t=1; + Value_destroy(value); + } + } + else if (f==1) + { + to=from; + t=1; + } + if (pass==INTERPRET) + { + /* Some implementations do not require direct mode */ + if (Program_list(&program,channel,channel==STDCHANNEL,f?&from:(struct Pc*)0,t?&to:(struct Pc*)0,value)) return value; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOAD(struct Value *value) /*{{{*/ +{ + struct Pc loadpc; + + if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + ++pc.token; + loadpc=pc; + if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) + { + pc=loadpc; + return value; + } + if (pass==INTERPRET) + { + int dev; + + new(); + Program_setname(&program,value->u.string.character); + if ((dev=FS_openin(value->u.string.character))==-1) + { + pc=loadpc; + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + FS_width(dev,0); + Value_destroy(value); + if (Program_merge(&program,dev,value)) + { + pc=loadpc; + return value; + } + FS_close(dev); + program.unsaved=0; + } + else Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOCAL(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + + if (pass==DECLARE || pass==COMPILE) + { + if ((curfn=findLabel(L_FUNC))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOCAL); + } + ++pc.token; + while (1) + { + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (pass==DECLARE || pass==COMPILE) + { + struct Symbol *fnsym; + + if (Auto_variable(&stack,pc.token->u.identifier)==0) return Value_new_ERROR(value,ALREADYLOCAL); + if (pass==DECLARE) + { + assert(curfn->token->type==T_DEFFN || curfn->token->type==T_DEFPROC || curfn->token->type==T_SUB || curfn->token->type==T_FUNCTION); + fnsym=(curfn->token+1)->u.identifier->sym; + assert(fnsym); + fnsym->u.sub.u.def.localTypes=realloc(fnsym->u.sub.u.def.localTypes,sizeof(enum ValueType)*(fnsym->u.sub.u.def.localLength+1)); + fnsym->u.sub.u.def.localTypes[fnsym->u.sub.u.def.localLength]=pc.token->u.identifier->defaultType; + ++fnsym->u.sub.u.def.localLength; + } + } + ++pc.token; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOCATE(struct Value *value) /*{{{*/ +{ + long int line,column; + struct Pc argpc; + struct Pc statementpc=pc; + + ++pc.token; + argpc=pc; + if (eval(value,_("row"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + line=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && line<1) + { + pc=argpc; + return Value_new_ERROR(value,OUTOFRANGE,_("row")); + } + if (pc.token->type==T_COMMA) ++pc.token; + else return Value_new_ERROR(value,MISSINGCOMMA); + argpc=pc; + if (eval(value,_("column"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + column=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && column<1) + { + pc=argpc; + return Value_new_ERROR(value,OUTOFRANGE,_("column")); + } + if (pass==INTERPRET && FS_locate(STDCHANNEL,line,column)==-1) + { + pc=statementpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOCK_UNLOCK(struct Value *value) /*{{{*/ +{ + int lock=pc.token->type==T_LOCK; + int channel; + + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + channel=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET) + { + if (FS_lock(channel,0,0,lock?FS_LOCK_EXCLUSIVE:FS_LOCK_NONE,1)==-1) + { + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOOP(struct Value *value) /*{{{*/ +{ + struct Pc looppc=pc; + struct Pc *dopc; + + ++pc.token; + if (pass==INTERPRET) + { + pc=looppc.token->u.dopc; + } + if (pass==DECLARE || pass==COMPILE) + { + if ((dopc=popLabel(L_DO))==(struct Pc*)0 && (dopc=popLabel(L_DOcondition))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOOP); + looppc.token->u.dopc=*dopc; + dopc->token->u.exitdo=pc; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LOOPUNTIL(struct Value *value) /*{{{*/ +{ + struct Pc loopuntilpc=pc; + struct Pc *dopc; + + ++pc.token; + if (eval(value,_("condition"))->type==V_ERROR) return value; + if (pass==INTERPRET) + { + if (Value_isNull(value)) pc=loopuntilpc.token->u.dopc; + Value_destroy(value); + } + if (pass==DECLARE || pass==COMPILE) + { + if ((dopc=popLabel(L_DO))==(struct Pc*)0) return Value_new_ERROR(value,STRAYLOOPUNTIL); + loopuntilpc.token->u.until=*dopc; + dopc->token->u.exitdo=pc; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_LSET_RSET(struct Value *value) /*{{{*/ +{ + struct Value *l; + struct Pc tmppc; + int lset=(pc.token->type==T_LSET); + + ++pc.token; + if (pass==DECLARE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0 + ) + { + return Value_new_ERROR(value,REDECLARATION); + } + } + tmppc=pc; + if ((l=lvalue(value))->type==V_ERROR) return value; + if (pass==COMPILE && l->type!=V_STRING) + { + pc=tmppc; + return Value_new_ERROR(value,TYPEMISMATCH4); + } + if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ); + ++pc.token; + tmppc=pc; + if (eval(value,_("rhs"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,l->type)->type==V_ERROR)) + { + pc=tmppc; + return value; + } + if (pass==INTERPRET) (lset ? String_lset : String_rset)(&l->u.string,&value->u.string); + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_IDENTIFIER(struct Value *value) /*{{{*/ +{ + struct Pc here=pc; + + if (pass==DECLARE) + { + if (func(value)->type==V_ERROR) return value; + else Value_destroy(value); + if (pc.token->type==T_EQ || pc.token->type==T_COMMA) + { + pc=here; + if (assign(value)->type==V_ERROR) return value; + Value_destroy(value); + } + } + else + { + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + if (strcasecmp(pc.token->u.identifier->name,"mid$") + && (pc.token->u.identifier->sym->type==USERFUNCTION || pc.token->u.identifier->sym->type==BUILTINFUNCTION)) + { + func(value); + if (Value_retype(value,V_VOID)->type==V_ERROR) return value; + Value_destroy(value); + } + else + { + if (assign(value)->type==V_ERROR) return value; + if (pass!=INTERPRET) Value_destroy(value); + } + } + + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_IF_ELSEIFIF(struct Value *value) /*{{{*/ +{ + struct Pc ifpc=pc; + + ++pc.token; + if (eval(value,_("condition"))->type==V_ERROR) return value; + if (pc.token->type!=T_THEN) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGTHEN); + } + ++pc.token; + if (pass==INTERPRET) + { + if (Value_isNull(value)) pc=ifpc.token->u.elsepc; + Value_destroy(value); + } + else + { + Value_destroy(value); + if (pc.token->type==T_EOL) + { + pushLabel(L_IF,&ifpc); + } + else /* compile single line IF THEN ELSE recursively */ /*{{{*/ + { + if (statements(value)->type==V_ERROR) return value; + Value_destroy(value); + if (pc.token->type==T_ELSE) + { + struct Pc elsepc=pc; + + ++pc.token; + ifpc.token->u.elsepc=pc; + if (ifpc.token->type==T_ELSEIFIF) (ifpc.token-1)->u.elsepc=pc; + if (statements(value)->type==V_ERROR) return value; + Value_destroy(value); + elsepc.token->u.endifpc=pc; + } + else + { + ifpc.token->u.elsepc=pc; + if (ifpc.token->type==T_ELSEIFIF) (ifpc.token-1)->u.elsepc=pc; + } + } + /*}}}*/ + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_IMAGE(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pc.token->type!=T_STRING) return Value_new_ERROR(value,MISSINGFMT); + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_INPUT(struct Value *value) /*{{{*/ +{ + int channel=STDCHANNEL; + int nl=1; + int extraprompt=1; + struct Token *inputdata=(struct Token*)0,*t=(struct Token*)0; + struct Pc lvaluepc; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + channel=value->u.integer; + Value_destroy(value); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + else ++pc.token; + } + /*}}}*/ + if (pc.token->type==T_SEMICOLON) /*{{{*/ + { + nl=0; + ++pc.token; + } + /*}}}*/ + /* prompt */ /*{{{*/ + if (pc.token->type==T_STRING) + { + if (pass==INTERPRET && channel==STDCHANNEL) FS_putString(STDCHANNEL,pc.token->u.string); + ++pc.token; + if (pc.token->type==T_COMMA || pc.token->type==T_COLON) { ++pc.token; extraprompt=0; } + else if (pc.token->type==T_SEMICOLON) ++pc.token; + else extraprompt=0; + } + if (pass==INTERPRET && channel==STDCHANNEL && extraprompt) + { + FS_putChars(STDCHANNEL,"? "); + } + /*}}}*/ + retry: + if (pass==INTERPRET) /* read input line and tokenise it */ /*{{{*/ + { + struct String s; + + if (channel==STDCHANNEL) FS_flush(STDCHANNEL); + String_new(&s); + if (FS_appendToString(channel,&s,nl)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + if (s.length==0) return Value_new_ERROR(value,IOERROR,_("end of file")); + inputdata=t=Token_newData(s.character); + String_destroy(&s); + } + /*}}}*/ + while (1) + { + struct Value *l; + + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGVARIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + lvaluepc=pc; + if (((l=lvalue(value))->type)==V_ERROR) return value; + if (pass==INTERPRET) + { + if (t->type==T_COMMA || t->type==T_EOL) + { + enum ValueType ltype=l->type; + + Value_destroy(l); + Value_new_null(l,ltype); + } + else if (convert(value,l,t)) + { + pc=lvaluepc; + if (channel==STDCHANNEL) + { + struct String s; + + String_new(&s); + Value_toString(value,&s,' ',-1,0,0,0,0,-1,0,0); + String_appendChars(&s," ?? "); + FS_putString(STDCHANNEL,&s); + String_destroy(&s); + Value_destroy(value); + Token_destroy(inputdata); + goto retry; + } + else + { + Token_destroy(inputdata); + return value; + } + } + else ++t; + if (pc.token->type==T_COMMA) + { + if (t->type==T_COMMA) ++t; + else + { + Token_destroy(inputdata); + if (channel==STDCHANNEL) + { + FS_putChars(STDCHANNEL,"?? "); + ++pc.token; + goto retry; + } + else + { + pc=lvaluepc; + return Value_new_ERROR(value,MISSINGINPUTDATA); + } + } + } + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + if (pass==INTERPRET) + { + if (t->type!=T_EOL) FS_putChars(STDCHANNEL,_("Too much input data\n")); + Token_destroy(inputdata); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MAT(struct Value *value) /*{{{*/ +{ + struct Var *var1,*var2,*var3=(struct Var*)0; + struct Pc oppc; + enum TokenType op=T_EOL; + + oppc.line=-1; + oppc.token=(struct Token*)0; + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var1=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ); + ++pc.token; + if (pc.token->type==T_IDENTIFIER) /* a = b [ +|-|* c ] */ /*{{{*/ + { + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,1)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + var2=&pc.token->u.identifier->sym->u.var; + if (pass==INTERPRET && ((var2->dim!=1 && var2->dim!=2) || var2->base<0 || var2->base>1)) return Value_new_ERROR(value,NOMATRIX,var2->dim,var2->base); + if (pass==COMPILE && Value_commonType[var1->type][var2->type]==V_ERROR) return Value_new_typeError(value,var2->type,var1->type); + ++pc.token; + if (pc.token->type==T_PLUS || pc.token->type==T_MINUS || pc.token->type==T_MULT) + { + oppc=pc; + op=pc.token->type; + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGARRIDENT); + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,1)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + var3=&pc.token->u.identifier->sym->u.var; + if (pass==INTERPRET && ((var3->dim!=1 && var3->dim!=2) || var3->base<0 || var3->base>1)) return Value_new_ERROR(value,NOMATRIX,var3->dim,var3->base); + ++pc.token; + } + if (pass!=DECLARE) + { + if (var3==(struct Var*)0) + { + if (Var_mat_assign(var1,var2,value,pass==INTERPRET)) + { + assert(oppc.line!=-1); + pc=oppc; + return value; + } + } + else if (op==T_MULT) + { + if (Var_mat_mult(var1,var2,var3,value,pass==INTERPRET)) + { + assert(oppc.line!=-1); + pc=oppc; + return value; + } + } + else if (Var_mat_addsub(var1,var2,var3,op==T_PLUS,value,pass==INTERPRET)) + { + assert(oppc.line!=-1); + pc=oppc; + return value; + } + } + } + /*}}}*/ + else if (pc.token->type==T_OP) /*{{{*/ + { + if (var1->type==V_STRING) return Value_new_ERROR(value,TYPEMISMATCH5); + ++pc.token; + if (eval(value,_("factor"))->type==V_ERROR) return value; + if (pass==COMPILE && Value_commonType[var1->type][value->type]==V_ERROR) return Value_new_typeError(value,var1->type,value->type); + if (pc.token->type!=T_CP) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGCP); + } + ++pc.token; + if (pc.token->type!=T_MULT) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGMULT); + } + oppc=pc; + ++pc.token; + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,1)==0 + ) + { + Value_destroy(value); + return Value_new_ERROR(value,UNDECLARED); + } + } + var2=&pc.token->u.identifier->sym->u.var; + if (pass==INTERPRET && ((var2->dim!=1 && var2->dim!=2) || var2->base<0 || var2->base>1)) + { + Value_destroy(value); + return Value_new_ERROR(value,NOMATRIX,var2->dim,var2->base); + } + if (pass!=DECLARE && Var_mat_scalarMult(var1,value,var2,pass==INTERPRET)) + { + assert(oppc.line!=-1); + pc=oppc; + return value; + } + Value_destroy(value); + ++pc.token; + } + /*}}}*/ + else if (pc.token->type==T_CON || pc.token->type==T_ZER || pc.token->type==T_IDN) /*{{{*/ + { + op=pc.token->type; + if (pass==COMPILE && Value_commonType[var1->type][V_INTEGER]==V_ERROR) return Value_new_typeError(value,V_INTEGER,var1->type); + ++pc.token; + if (pc.token->type==T_OP) + { + unsigned int dim,geometry[2]; + enum ValueType vartype=var1->type; + + ++pc.token; + if (evalGeometry(value,&dim,geometry)) return value; + if (pass==INTERPRET) + { + Var_destroy(var1); + Var_new(var1,vartype,dim,geometry,optionbase); + } + } + if (pass==INTERPRET) + { + unsigned int i; + int unused=1-var1->base; + + if ((var1->dim!=1 && var1->dim!=2) || var1->base<0 || var1->base>1) return Value_new_ERROR(value,NOMATRIX,var1->dim,var1->base); + if (var1->dim==1) + { + for (i=unused; i<var1->geometry[0]; ++i) + { + int c=-1; + + Value_destroy(&(var1->value[i])); + switch (op) + { + case T_CON: c=1; break; + case T_ZER: c=0; break; + case T_IDN: c=(i==unused?1:0); break; + default: assert(0); + } + if (var1->type==V_INTEGER) Value_new_INTEGER(&(var1->value[i]),c); + else Value_new_REAL(&(var1->value[i]),(double)c); + } + } + else + { + int j; + + for (i=unused; i<var1->geometry[0]; ++i) for (j=unused; j<var1->geometry[1]; ++j) + { + int c=-1; + + Value_destroy(&(var1->value[i*var1->geometry[1]+j])); + switch (op) + { + case T_CON: c=1; break; + case T_ZER: c=0; break; + case T_IDN: c=(i==j?1:0); break; + default: assert(0); + } + if (var1->type==V_INTEGER) Value_new_INTEGER(&(var1->value[i*var1->geometry[1]+j]),c); + else Value_new_REAL(&(var1->value[i*var1->geometry[1]+j]),(double)c); + } + } + } + } + /*}}}*/ + else if (pc.token->type==T_TRN || pc.token->type==T_INV) /*{{{*/ + { + op=pc.token->type; + ++pc.token; + if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP); + ++pc.token; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT); + if (pass==COMPILE) + { + if + ( + ((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0) + && Global_find(&globals,pc.token->u.identifier,1)==0 + ) return Value_new_ERROR(value,UNDECLARED); + } + var2=&pc.token->u.identifier->sym->u.var; + if (pass==COMPILE && Value_commonType[var1->type][var2->type]==V_ERROR) return Value_new_typeError(value,var2->type,var1->type); + if (pass==INTERPRET) + { + if (var2->dim!=2 || var2->base<0 || var2->base>1) return Value_new_ERROR(value,NOMATRIX,var2->dim,var2->base); + switch (op) + { + case T_TRN: Var_mat_transpose(var1,var2); break; + case T_INV: if (Var_mat_invert(var1,var2,&stack.lastdet,value)) return value; break; + default: assert(0); + } + } + ++pc.token; + if (pc.token->type!=T_CP) return Value_new_ERROR(value,MISSINGCP); + ++pc.token; + } + /*}}}*/ + else return Value_new_ERROR(value,MISSINGEXPR,_("matrix")); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MATINPUT(struct Value *value) /*{{{*/ +{ + int channel=STDCHANNEL; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + channel=value->u.integer; + Value_destroy(value); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + else ++pc.token; + } + /*}}}*/ + while (1) + { + struct Pc lvaluepc; + struct Var *var; + + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pc.token->type==T_OP) + { + unsigned int dim,geometry[2]; + enum ValueType vartype=var->type; + + ++pc.token; + if (evalGeometry(value,&dim,geometry)) return value; + if (pass==INTERPRET) + { + Var_destroy(var); + Var_new(var,vartype,dim,geometry,optionbase); + } + } + if (pass==INTERPRET) + { + unsigned int i,j; + int unused=1-var->base; + int columns; + struct Token *inputdata,*t; + + if (var->dim!=1 && var->dim!=2) return Value_new_ERROR(value,NOMATRIX,var->dim); + columns=var->dim==1 ? 0 : var->geometry[1]; + inputdata=t=(struct Token*)0; + for (i=unused,j=unused; i<var->geometry[0]; ) + { + struct String s; + + if (!inputdata) + { + if (channel==STDCHANNEL) + { + FS_putChars(STDCHANNEL,"? "); + FS_flush(STDCHANNEL); + } + String_new(&s); + if (FS_appendToString(channel,&s,1)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + if (s.length==0) return Value_new_ERROR(value,IOERROR,_("end of file")); + inputdata=t=Token_newData(s.character); + String_destroy(&s); + } + + if (t->type==T_COMMA) + { + Value_destroy(&(var->value[j*columns+i])); + Value_new_null(&(var->value[j*columns+i]),var->type); + ++t; + } + else if (t->type==T_EOL) + { + while (i<var->geometry[0]) + { + Value_destroy(&(var->value[j*columns+i])); + Value_new_null(&(var->value[j*columns+i]),var->type); + ++i; + } + } + else if (convert(value,&(var->value[j*columns+i]),t)) + { + Token_destroy(inputdata); + pc=lvaluepc; + return value; + } + else + { + ++t; + ++i; + if (t->type==T_COMMA) ++t; + } + + if (i==var->geometry[0] && j<(columns-1)) + { + i=unused; + ++j; + if (t->type==T_EOL) + { + Token_destroy(inputdata); + inputdata=(struct Token*)0; + } + } + } + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MATPRINT(struct Value *value) /*{{{*/ +{ + int chn=STDCHANNEL; + int printusing=0; + struct Value usingval; + struct String *using=(struct String*)0; + size_t usingpos=0; + int notfirst=0; + + ++pc.token; + if (chn==STDCHANNEL && pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + if (pc.token->type==T_USING) /*{{{*/ + { + struct Pc usingpc; + + usingpc=pc; + printusing=1; + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==COMPILE && Program_imageLine(&program,pc.token->u.integer,&usingpc.token->u.image)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHIMAGELINE); + else if (pass==INTERPRET) using=usingpc.token->u.image.token->u.string; + Value_new_STRING(&usingval); + ++pc.token; + } + else + { + if (eval(&usingval,_("format string"))->type==V_ERROR || Value_retype(&usingval,V_STRING)->type==V_ERROR) + { + *value=usingval; + return value; + } + using=&usingval.u.string; + } + if (pc.token->type!=T_SEMICOLON) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,MISSINGSEMICOLON); + } + ++pc.token; + } + /*}}}*/ + else + { + Value_new_STRING(&usingval); + using=&usingval.u.string; + } + while (1) + { + struct Var *var; + int zoned=1; + + if (pc.token->type!=T_IDENTIFIER) + { + if (notfirst) break; + Value_destroy(&usingval); + return Value_new_ERROR(value,MISSINGMATIDENT); + } + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pc.token->type==T_SEMICOLON) zoned=0; + if (pass==INTERPRET) + { + unsigned int i,j; + int unused=1-var->base; + int g0,g1; + + if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base); + if ((notfirst ? FS_putChar(chn,'\n') : FS_nextline(chn))==-1) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + g0=var->geometry[0]; + g1=var->dim==1 ? unused+1 : var->geometry[1]; + for (i=unused; i<g0; ++i) + { + for (j=unused; j<g1; ++j) + { + struct String s; + + String_new(&s); + Value_clone(value,&(var->value[var->dim==1 ? i : i*g1+j])); + if (Value_toStringUsing(value,&s,using,&usingpos)->type==V_ERROR) + { + Value_destroy(&usingval); + String_destroy(&s); + return value; + } + Value_destroy(value); + if (FS_putString(chn,&s)==-1) + { + Value_destroy(&usingval); + String_destroy(&s); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + String_destroy(&s); + if (!printusing && zoned) FS_nextcol(chn); + } + if (FS_putChar(chn,'\n')==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token; + else break; + notfirst=1; + } + Value_destroy(&usingval); + if (pass==INTERPRET) + { + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MATREAD(struct Value *value) /*{{{*/ +{ + ++pc.token; + while (1) + { + struct Pc lvaluepc; + struct Var *var; + + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pc.token->type==T_OP) + { + unsigned int dim,geometry[2]; + enum ValueType vartype=var->type; + + ++pc.token; + if (evalGeometry(value,&dim,geometry)) return value; + if (pass==INTERPRET) + { + Var_destroy(var); + Var_new(var,vartype,dim,geometry,optionbase); + } + } + if (pass==INTERPRET) + { + unsigned int i; + int unused=1-var->base; + + if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base); + if (var->dim==1) + { + for (i=unused; i<var->geometry[0]; ++i) + { + if (dataread(value,&(var->value[i]))) + { + pc=lvaluepc; + return value; + } + } + } + else + { + int j; + + for (i=unused; i<var->geometry[0]; ++i) for (j=unused; j<var->geometry[1]; ++j) + { + if (dataread(value,&(var->value[i*var->geometry[1]+j]))) + { + pc=lvaluepc; + return value; + } + } + } + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MATREDIM(struct Value *value) /*{{{*/ +{ + ++pc.token; + while (1) + { + struct Var *var; + unsigned int dim,geometry[2]; + + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGMATIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP); + ++pc.token; + if (evalGeometry(value,&dim,geometry)) return value; + if (pass==INTERPRET && Var_mat_redim(var,dim,geometry,value)!=(struct Value*)0) return value; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_MATWRITE(struct Value *value) /*{{{*/ +{ + int chn=STDCHANNEL; + int notfirst=0; + int comma=0; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + while (1) + { + struct Var *var; + + if (pc.token->type!=T_IDENTIFIER) + { + if (notfirst) break; + return Value_new_ERROR(value,MISSINGMATIDENT); + } + notfirst=1; + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,GLOBALARRAY,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + var=&pc.token->u.identifier->sym->u.var; + ++pc.token; + if (pass==INTERPRET) + { + unsigned int i,j; + int unused=1-var->base; + int g0,g1; + + if ((var->dim!=1 && var->dim!=2) || var->base<0 || var->base>1) return Value_new_ERROR(value,NOMATRIX,var->dim,var->base); + g0=var->geometry[0]; + g1=var->dim==1 ? unused+1 : var->geometry[1]; + for (i=unused; i<g0; ++i) + { + comma=0; + for (j=unused; j<g1; ++j) + { + struct String s; + + String_new(&s); + Value_clone(value,&(var->value[var->dim==1 ? i : i*g1+j])); + if (comma) String_appendChar(&s,','); + if (FS_putString(chn,Value_toWrite(value,&s))==-1) + { + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + String_destroy(&s); + comma=1; + } + FS_putChar(chn,'\n'); + } + } + if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token; + else break; + } + if (pass==INTERPRET) + { + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_NAME(struct Value *value) /*{{{*/ +{ + struct Pc namepc=pc; + struct Value old; + int res=-1,reserrno=-1; + + ++pc.token; + if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pc.token->type!=T_AS) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGAS); + } + old=*value; + ++pc.token; + if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) + { + Value_destroy(&old); + return value; + } + if (pass==INTERPRET) + { + res=rename(old.u.string.character,value->u.string.character); + reserrno=errno; + } + Value_destroy(&old); + Value_destroy(value); + if (pass==INTERPRET && res==-1) + { + pc=namepc; + return Value_new_ERROR(value,IOERROR,strerror(reserrno)); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_NEW(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) + { + if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + new(); + } + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_NEXT(struct Value *value) /*{{{*/ +{ + struct Next **next=&pc.token->u.next; + int level=0; + + if (pass==INTERPRET) /*{{{*/ + { + struct Value *l,inc; + struct Pc savepc; + + ++pc.token; + while (1) + { + /* get variable lvalue */ /*{{{*/ + savepc=pc; + pc=(*next)[level].var; + if ((l=lvalue(value))->type==V_ERROR) return value; + pc=savepc; + /*}}}*/ + /* get limit value and increment */ /*{{{*/ + savepc=pc; + pc=(*next)[level].limit; + if (eval(value,_("limit"))->type==V_ERROR) return value; + Value_retype(value,l->type); + assert(value->type!=V_ERROR); + if (pc.token->type==T_STEP) + { + ++pc.token; + if (eval(&inc,_("step"))->type==V_ERROR) + { + Value_destroy(value); + *value=inc; + return value; + } + } + else VALUE_NEW_INTEGER(&inc,1); + VALUE_RETYPE(&inc,l->type); + assert(inc.type!=V_ERROR); + pc=savepc; + /*}}}*/ + Value_add(l,&inc,1); + if (Value_exitFor(l,value,&inc)) + { + Value_destroy(value); + Value_destroy(&inc); + if (pc.token->type==T_IDENTIFIER) + { + if (lvalue(value)->type==V_ERROR) return value; + if (pc.token->type==T_COMMA) { ++pc.token; ++level; } + else break; + } + else break; + } + else + { + pc=(*next)[level].body; + Value_destroy(value); + Value_destroy(&inc); + break; + } + } + } + /*}}}*/ + else /*{{{*/ + { + struct Pc *body; + + ++pc.token; + while (1) + { + if ((body=popLabel(L_FOR_BODY))==(struct Pc*)0) return Value_new_ERROR(value,STRAYNEXT,topLabelDescription()); + if (level) + { + struct Next *more; + + more=realloc(*next,sizeof(struct Next)*(level+1)); + *next=more; + } + (*next)[level].body=*body; + (*next)[level].limit=*popLabel(L_FOR_LIMIT); + (*next)[level].var=*popLabel(L_FOR_VAR); + (*next)[level].fr=*popLabel(L_FOR); + if (pc.token->type==T_IDENTIFIER) + { + if (cistrcmp(pc.token->u.identifier->name,(*next)[level].var.token->u.identifier->name)) + { + return Value_new_ERROR(value,FORMISMATCH); + } + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if (lvalue(value)->type==V_ERROR) return value; + if (pc.token->type==T_COMMA) { ++pc.token; ++level; } + else break; + } + else break; + } + while (level>=0) (*next)[level--].fr.token->u.exitfor=pc; + } + /*}}}*/ + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ON(struct Value *value) /*{{{*/ +{ + struct On *on=&pc.token->u.on; + + ++pc.token; + if (eval(value,_("selector"))->type==V_ERROR) return value; + if (Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + if (pass==INTERPRET) + { + struct Pc newpc; + + if (value->u.integer>0 && value->u.integer<on->pcLength) + { + newpc=on->pc[value->u.integer]; + } + else newpc=on->pc[0]; + if (pc.token->type==T_GOTO) pc=newpc; + else + { + pc=on->pc[0]; + Auto_pushGosubRet(&stack,&pc); + pc=newpc; + } + Program_trace(&program,&pc,0,1); + } + else if (pass==DECLARE || pass==COMPILE) + { + Value_destroy(value); + if (pc.token->type!=T_GOTO && pc.token->type!=T_GOSUB) return Value_new_ERROR(value,MISSINGGOTOSUB); + ++pc.token; + on->pcLength=1; + while (1) + { + on->pc=realloc(on->pc,sizeof(struct Pc)*++on->pcLength); + if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGLINENUMBER); + if (Program_goLine(&program,pc.token->u.integer,&on->pc[on->pcLength-1])==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + if (pass==COMPILE && Program_scopeCheck(&program,&on->pc[on->pcLength-1],findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE); + ++pc.token; + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + on->pc[0]=pc; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ONERROR(struct Value *value) /*{{{*/ +{ + if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE); + ++pc.token; + if (pass==INTERPRET) + { + stack.onerror=pc; + Program_nextLine(&program,&pc); + return (struct Value*)0; + } + else return &more_statements; +} +/*}}}*/ +struct Value *stmt_ONERRORGOTO0(struct Value *value) /*{{{*/ +{ + if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE); + if (pass==INTERPRET) + { + stack.onerror.line=-1; + if (stack.resumeable) + { + pc=stack.erpc; + return Value_clone(value,&stack.err); + } + } + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ONERROROFF(struct Value *value) /*{{{*/ +{ + if (DIRECTMODE) return Value_new_ERROR(value,NOTINDIRECTMODE); + if (pass==INTERPRET) stack.onerror.line=-1; + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_OPEN(struct Value *value) /*{{{*/ +{ + int inout=-1,append=0; + int mode=FS_ACCESS_NONE,lock=FS_LOCK_NONE; + long int channel; + long int recLength=-1; + struct Pc errpc; + struct Value recLengthValue; + struct Pc statementpc=pc; + + ++pc.token; + errpc=pc; + if (eval(value,_("mode or file"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pc.token->type==T_COMMA) /* parse MBASIC syntax */ /*{{{*/ + { + if (value->u.string.length>=1) + { + switch (tolower(value->u.string.character[0])) + { + case 'i': inout=0; mode=FS_ACCESS_READ; break; + case 'o': inout=1; mode=FS_ACCESS_WRITE; break; + case 'a': inout=1; mode=FS_ACCESS_WRITE; append=1; break; + case 'r': inout=3; mode=FS_ACCESS_READWRITE; break; + } + } + Value_destroy(value); + if (pass==INTERPRET && inout==-1) + { + pc=errpc; + return Value_new_ERROR(value,BADMODE); + } + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + errpc=pc; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) + { + pc=errpc; + return value; + } + channel=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && channel<0) return Value_new_ERROR(value,OUTOFRANGE,_("channel")); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (inout==3) + { + if (pc.token->type!=T_COMMA) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGCOMMA); + } + ++pc.token; + errpc=pc; + if (eval(&recLengthValue,_("record length"))->type==V_ERROR || Value_retype(&recLengthValue,V_INTEGER)->type==V_ERROR) + { + Value_destroy(value); + *value=recLengthValue; + return value; + } + recLength=recLengthValue.u.integer; + Value_destroy(&recLengthValue); + if (pass==INTERPRET && recLength<=0) + { + Value_destroy(value); + pc=errpc; + return Value_new_ERROR(value,OUTOFRANGE,_("record length")); + } + } + } + /*}}}*/ + else /* parse ANSI syntax */ /*{{{*/ + { + struct Value channelValue; + int newMode; + + switch (pc.token->type) + { + case T_FOR_INPUT: inout=0; mode=FS_ACCESS_READ; ++pc.token; break; + case T_FOR_OUTPUT: inout=1; mode=FS_ACCESS_WRITE; ++pc.token; break; + case T_FOR_APPEND: inout=1; mode=FS_ACCESS_WRITE; append=1; ++pc.token; break; + case T_FOR_RANDOM: inout=3; mode=FS_ACCESS_READWRITE; ++pc.token; break; + case T_FOR_BINARY: inout=4; mode=FS_ACCESS_READWRITE; ++pc.token; break; + default: inout=3; mode=FS_ACCESS_READWRITE; break; + } + switch (pc.token->type) + { + case T_ACCESS_READ: newMode=FS_ACCESS_READ; break; + case T_ACCESS_READ_WRITE: newMode=FS_ACCESS_READWRITE; break; + case T_ACCESS_WRITE: newMode=FS_ACCESS_WRITE; break; + default: newMode=FS_ACCESS_NONE; + } + if (newMode!=FS_ACCESS_NONE) + { + if ((newMode&mode)==0) return Value_new_ERROR(value,WRONGMODE); + mode=newMode; + ++pc.token; + } + switch (pc.token->type) + { + case T_SHARED: lock=FS_LOCK_NONE; ++pc.token; break; + case T_LOCK_READ: lock=FS_LOCK_SHARED; ++pc.token; break; + case T_LOCK_WRITE: lock=FS_LOCK_EXCLUSIVE; ++pc.token; break; + default: ; + } + if (pc.token->type!=T_AS) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGAS); + } + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + errpc=pc; + if (eval(&channelValue,_("channel"))->type==V_ERROR || Value_retype(&channelValue,V_INTEGER)->type==V_ERROR) + { + pc=errpc; + Value_destroy(value); + *value=channelValue; + return value; + } + channel=channelValue.u.integer; + Value_destroy(&channelValue); + if (inout==3) + { + if (pc.token->type==T_IDENTIFIER) + { + if (cistrcmp(pc.token->u.identifier->name,"len")) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGLEN); + } + ++pc.token; + if (pc.token->type!=T_EQ) + { + Value_destroy(value); + return Value_new_ERROR(value,MISSINGEQ); + } + ++pc.token; + errpc=pc; + if (eval(&recLengthValue,_("record length"))->type==V_ERROR || Value_retype(&recLengthValue,V_INTEGER)->type==V_ERROR) + { + Value_destroy(value); + *value=recLengthValue; + return value; + } + recLength=recLengthValue.u.integer; + Value_destroy(&recLengthValue); + if (pass==INTERPRET && recLength<=0) + { + Value_destroy(value); + pc=errpc; + return Value_new_ERROR(value,OUTOFRANGE,_("record length")); + } + } + else recLength=1; + } + } + /*}}}*/ + /* open file with name value */ /*{{{*/ + if (pass==INTERPRET) + { + int res=-1; + + if (inout==0) res=FS_openinChn(channel,value->u.string.character,mode); + else if (inout==1) res=FS_openoutChn(channel,value->u.string.character,mode,append); + else if (inout==3) res=FS_openrandomChn(channel,value->u.string.character,mode,recLength); + else if (inout==4) res=FS_openbinaryChn(channel,value->u.string.character,mode); + if (res==-1) + { + pc=statementpc; + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + else + { + if (lock!=FS_LOCK_NONE && FS_lock(channel,0,0,lock,0)==-1) + { + pc=statementpc; + Value_destroy(value); + Value_new_ERROR(value,IOERROR,FS_errmsg); + FS_close(channel); + return value; + } + } + } + /*}}}*/ + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_OPTIONBASE(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (eval(value,_("array subscript base"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value; + if (pass==INTERPRET) optionbase=value->u.integer; + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_OPTIONRUN(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pass==INTERPRET) + { + FS_allowIntr(0); + FS_xonxoff(STDCHANNEL,0); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_OPTIONSTOP(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pass==INTERPRET) + { + FS_allowIntr(1); + FS_xonxoff(STDCHANNEL,1); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_OUT_POKE(struct Value *value) /*{{{*/ +{ + int out,address,val; + struct Pc lpc; + + out=(pc.token->type==T_OUT); + lpc=pc; + ++pc.token; + if (eval(value,_("address"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + address=value->u.integer; + Value_destroy(value); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + if (eval(value,_("output value"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + val=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET) + { + if ((out ? FS_portOutput : FS_memOutput)(address,val)==-1) + { + pc=lpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_PRINT_LPRINT(struct Value *value) /*{{{*/ +{ + int nl=1; + int chn=(pc.token->type==T_PRINT?STDCHANNEL:LPCHANNEL); + int printusing=0; + struct Value usingval; + struct String *using=(struct String*)0; + size_t usingpos=0; + + ++pc.token; + if (chn==STDCHANNEL && pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + if (pc.token->type==T_USING) /*{{{*/ + { + struct Pc usingpc; + + usingpc=pc; + printusing=1; + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==COMPILE && Program_imageLine(&program,pc.token->u.integer,&usingpc.token->u.image)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHIMAGELINE); + else if (pass==INTERPRET) using=usingpc.token->u.image.token->u.string; + Value_new_STRING(&usingval); + ++pc.token; + } + else + { + if (eval(&usingval,_("format string"))->type==V_ERROR || Value_retype(&usingval,V_STRING)->type==V_ERROR) + { + *value=usingval; + return value; + } + using=&usingval.u.string; + } + if (pc.token->type!=T_SEMICOLON) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,MISSINGSEMICOLON); + } + ++pc.token; + } + /*}}}*/ + else + { + Value_new_STRING(&usingval); + using=&usingval.u.string; + } + while (1) + { + struct Pc valuepc; + + valuepc=pc; + if (eval(value,(const char*)0)) /*{{{*/ + { + if (value->type==V_ERROR) + { + Value_destroy(&usingval); + return value; + } + if (pass==INTERPRET) + { + struct String s; + + String_new(&s); + if (Value_toStringUsing(value,&s,using,&usingpos)->type==V_ERROR) + { + Value_destroy(&usingval); + String_destroy(&s); + pc=valuepc; + return value; + } + if (FS_putItem(chn,&s)==-1) + { + Value_destroy(&usingval); + Value_destroy(value); + String_destroy(&s); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + String_destroy(&s); + } + Value_destroy(value); + nl=1; + } + /*}}}*/ + else if (pc.token->type==T_TAB || pc.token->type==T_SPC) /*{{{*/ + { + int tab=pc.token->type==T_TAB; + + ++pc.token; + if (pc.token->type!=T_OP) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,MISSINGOP); + } + ++pc.token; + if (eval(value,_("count"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) + { + Value_destroy(&usingval); + return value; + } + if (pass==INTERPRET) + { + int s=value->u.integer; + int r=0; + + if (tab) r=FS_tab(chn,s); + else while (s-->0 && (r=FS_putChar(chn,' '))!=-1); + if (r==-1) + { + Value_destroy(&usingval); + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + Value_destroy(value); + if (pc.token->type!=T_CP) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,MISSINGCP); + } + ++pc.token; + nl=1; + } + /*}}}*/ + else if (pc.token->type==T_SEMICOLON) /*{{{*/ + { + ++pc.token; + nl=0; + } + /*}}}*/ + else if (pc.token->type==T_COMMA) /*{{{*/ + { + ++pc.token; + if (pass==INTERPRET && !printusing) FS_nextcol(chn); + nl=0; + } + /*}}}*/ + else break; + if (pass==INTERPRET && FS_flush(chn)==-1) + { + Value_destroy(&usingval); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } + Value_destroy(&usingval); + if (pass==INTERPRET) + { + if (nl && FS_putChar(chn,'\n')==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RANDOMIZE(struct Value *value) /*{{{*/ +{ + struct Pc argpc; + + ++pc.token; + argpc=pc; + if (eval(value,(const char*)0)) + { + Value_retype(value,V_INTEGER); + if (value->type==V_ERROR) + { + pc=argpc; + Value_destroy(value); + return Value_new_ERROR(value,MISSINGEXPR,_("random number generator seed")); + } + if (pass==INTERPRET) srand(pc.token->u.integer); + Value_destroy(value); + } + else srand(getpid()^time((time_t*)0)); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_READ(struct Value *value) /*{{{*/ +{ + ++pc.token; + while (1) + { + struct Value *l; + struct Pc lvaluepc; + + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGREADIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if ((l=lvalue(value))->type==V_ERROR) return value; + if (pass==INTERPRET && dataread(value,l)) + { + pc=lvaluepc; + return value; + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_COPY_RENAME(struct Value *value) /*{{{*/ +{ + struct Pc argpc; + struct Value from; + struct Pc statementpc=pc; + + ++pc.token; + argpc=pc; + if (eval(&from,_("source file"))->type==V_ERROR || (pass!=DECLARE && Value_retype(&from,V_STRING)->type==V_ERROR)) + { + pc=argpc; + *value=from; + return value; + } + if (pc.token->type!=T_TO) + { + Value_destroy(&from); + return Value_new_ERROR(value,MISSINGTO); + } + ++pc.token; + argpc=pc; + if (eval(value,_("destination file"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_STRING)->type==V_ERROR)) + { + pc=argpc; + return value; + } + if (pass==INTERPRET) + { + const char *msg; + int res; + + if (statementpc.token->type==T_RENAME) + { + res=rename(from.u.string.character,value->u.string.character); + msg=strerror(errno); + } + else + { + res=FS_copy(from.u.string.character,value->u.string.character); + msg=FS_errmsg; + } + if (res==-1) + { + Value_destroy(&from); + Value_destroy(value); + pc=statementpc; + return Value_new_ERROR(value,IOERROR,msg); + } + } + Value_destroy(&from); + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RENUM(struct Value *value) /*{{{*/ +{ + int first=10,inc=10; + + ++pc.token; + if (pc.token->type==T_INTEGER) + { + first=pc.token->u.integer; + ++pc.token; + if (pc.token->type==T_COMMA) + { + ++pc.token; + if (pc.token->type!=T_INTEGER) return Value_new_ERROR(value,MISSINGINCREMENT); + inc=pc.token->u.integer; + ++pc.token; + } + } + if (pass==INTERPRET) + { + if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + Program_renum(&program,first,inc); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_REPEAT(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) pushLabel(L_REPEAT,&pc); + ++pc.token; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RESTORE(struct Value *value) /*{{{*/ +{ + struct Token *restorepc=pc.token; + + if (pass==INTERPRET) curdata=pc.token->u.restore; + ++pc.token; + if (pc.token->type==T_INTEGER) + { + if (pass==COMPILE && Program_dataLine(&program,pc.token->u.integer,&restorepc->u.restore)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHDATALINE); + ++pc.token; + } + else if (pass==COMPILE) restorepc->u.restore=stack.begindata; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RETURN(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) ++pc.token; + if (pass==INTERPRET) + { + if (Auto_gosubReturn(&stack,&pc)) Program_trace(&program,&pc,0,1); + else return Value_new_ERROR(value,STRAYRETURN); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_RUN(struct Value *value) /*{{{*/ +{ + struct Pc argpc,begin; + + stack.resumeable=0; + ++pc.token; + argpc=pc; + if (pc.token->type==T_INTEGER) + { + if (Program_goLine(&program,pc.token->u.integer,&begin)==(struct Pc*)0) return Value_new_ERROR(value,NOSUCHLINE); + if (pass==COMPILE && Program_scopeCheck(&program,&begin,findLabel(L_FUNC))) return Value_new_ERROR(value,OUTOFSCOPE); + ++pc.token; + } + else if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) + { + pc=argpc; + return value; + } + else if (pass==INTERPRET) + { + int chn; + struct Program newprogram; + + if ((chn=FS_openin(value->u.string.character))==-1) + { + pc=argpc; + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + Value_destroy(value); + Program_new(&newprogram); + if (Program_merge(&newprogram,chn,value)) + { + pc=argpc; + Program_destroy(&newprogram); + return value; + } + FS_close(chn); + new(); + Program_destroy(&program); + program=newprogram; + if (Program_beginning(&program,&begin)==(struct Pc*)0) + { + return Value_new_ERROR(value,NOPROGRAM); + } + } + else Value_destroy(value); + } + else + { + if (Program_beginning(&program,&begin)==(struct Pc*)0) + { + return Value_new_ERROR(value,NOPROGRAM); + } + } + if (pass==INTERPRET) + { + if (compileProgram(value,1)->type==V_ERROR) return value; + pc=begin; + curdata=stack.begindata; + Global_clear(&globals); + FS_closefiles(); + Program_trace(&program,&pc,0,1); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SAVE(struct Value *value) /*{{{*/ +{ + struct Pc loadpc; + int name; + + if (pass==INTERPRET && !DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + ++pc.token; + loadpc=pc; + if (pc.token->type==T_EOL && program.name.length) + { + name=0; + } + else + { + name=1; + if (eval(value,_("file name"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) + { + pc=loadpc; + return value; + } + } + if (pass==INTERPRET) + { + int chn; + + if (name) Program_setname(&program,value->u.string.character); + if ((chn=FS_openout(program.name.character))==-1) + { + pc=loadpc; + if (name) Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + FS_width(chn,0); + if (name) Value_destroy(value); + if (Program_list(&program,chn,0,(struct Pc*)0,(struct Pc*)0,value)) + { + pc=loadpc; + return value; + } + FS_close(chn); + program.unsaved=0; + } + else if (name) Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SELECTCASE(struct Value *value) /*{{{*/ +{ + struct Pc statementpc=pc; + + if (pass==DECLARE || pass==COMPILE) pushLabel(L_SELECTCASE,&pc); + ++pc.token; + if (eval(value,_("selector"))->type==V_ERROR) return value; + if (pass==DECLARE || pass==COMPILE) + { + statementpc.token->u.selectcase->type=value->type; + statementpc.token->u.selectcase->nextcasevalue.line=-1; + } + else + { + struct Pc casevaluepc; + int match=0; + + pc=casevaluepc=statementpc.token->u.selectcase->nextcasevalue; + do + { + ++pc.token; + switch (casevaluepc.token->type) + { + case T_CASEVALUE: /*{{{*/ + { + do + { + struct Value casevalue1; + + if (pc.token->type==T_IS) + { + enum TokenType relop; + + ++pc.token; + relop=pc.token->type; + ++pc.token; + if (eval(&casevalue1,"`is'")->type==V_ERROR) + { + Value_destroy(value); + *value=casevalue1; + return value; + } + Value_retype(&casevalue1,statementpc.token->u.selectcase->type); + assert(casevalue1.type!=V_ERROR); + if (!match) /*{{{*/ + { + struct Value cmp; + + Value_clone(&cmp,value); + switch (relop) + { + case T_LT: Value_lt(&cmp,&casevalue1,1); break; + case T_LE: Value_le(&cmp,&casevalue1,1); break; + case T_EQ: Value_eq(&cmp,&casevalue1,1); break; + case T_GE: Value_ge(&cmp,&casevalue1,1); break; + case T_GT: Value_gt(&cmp,&casevalue1,1); break; + case T_NE: Value_ne(&cmp,&casevalue1,1); break; + default: assert(0); + } + assert(cmp.type==V_INTEGER); + match=cmp.u.integer; + Value_destroy(&cmp); + } + /*}}}*/ + Value_destroy(&casevalue1); + } + else + { + if (eval(&casevalue1,"`case'")->type==V_ERROR) + { + Value_destroy(value); + *value=casevalue1; + return value; + } + Value_retype(&casevalue1,statementpc.token->u.selectcase->type); + assert(casevalue1.type!=V_ERROR); + if (pc.token->type==T_TO) /* match range */ /*{{{*/ + { + struct Value casevalue2; + + ++pc.token; + if (eval(&casevalue2,"`case'")->type==V_ERROR) + { + Value_destroy(&casevalue1); + Value_destroy(value); + *value=casevalue2; + return value; + } + Value_retype(&casevalue2,statementpc.token->u.selectcase->type); + assert(casevalue2.type!=V_ERROR); + if (!match) + { + struct Value cmp1,cmp2; + + Value_clone(&cmp1,value); + Value_clone(&cmp2,value); + Value_ge(&cmp1,&casevalue1,1); + assert(cmp1.type==V_INTEGER); + Value_le(&cmp2,&casevalue2,1); + assert(cmp2.type==V_INTEGER); + match=cmp1.u.integer && cmp2.u.integer; + Value_destroy(&cmp1); + Value_destroy(&cmp2); + } + Value_destroy(&casevalue2); + } + /*}}}*/ + else /* match value */ /*{{{*/ + { + if (!match) + { + struct Value cmp; + + Value_clone(&cmp,value); + Value_eq(&cmp,&casevalue1,1); + assert(cmp.type==V_INTEGER); + match=cmp.u.integer; + Value_destroy(&cmp); + } + } + /*}}}*/ + Value_destroy(&casevalue1); + } + if (pc.token->type==T_COMMA) ++pc.token; + else break; + } while (1); + break; + } + /*}}}*/ + case T_CASEELSE: /*{{{*/ + { + match=1; + break; + } + /*}}}*/ + default: assert(0); + } + if (!match) + { + if (casevaluepc.token->u.casevalue->nextcasevalue.line!=-1) + { + pc=casevaluepc=casevaluepc.token->u.casevalue->nextcasevalue; + } + else + { + pc=statementpc.token->u.selectcase->endselect; + break; + } + } + } while (!match); + } + Value_destroy(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SHELL(struct Value *value) /*{{{*/ +{ + pid_t pid; + int status; + + ++pc.token; + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value; + if (pass==INTERPRET) + { + if (run_restricted) + { + Value_destroy(value); + return Value_new_ERROR(value,RESTRICTED,strerror(errno)); + } + FS_shellmode(STDCHANNEL); + switch (pid=vfork()) + { + case -1: + { + FS_fsmode(STDCHANNEL); + Value_destroy(value); + return Value_new_ERROR(value,FORKFAILED,strerror(errno)); + } + case 0: + { + execl("/bin/sh","sh","-c",value->u.string.character,(const char*)0); + exit(127); + } + default: + { + while (waitpid(pid,&status,0)==-1 && errno!=EINTR); + } + } + FS_fsmode(STDCHANNEL); + } + Value_destroy(value); + } + else + { + if (pass==INTERPRET) + { + if (run_restricted) + { + return Value_new_ERROR(value,RESTRICTED,strerror(errno)); + } + FS_shellmode(STDCHANNEL); + switch (pid=vfork()) + { + case -1: + { + FS_fsmode(STDCHANNEL); + return Value_new_ERROR(value,FORKFAILED,strerror(errno)); + } + case 0: + { + const char *shell; + + shell=getenv("SHELL"); + if (shell==(const char*)0) shell="/bin/sh"; + execl(shell,(strrchr(shell,'/') ? strrchr(shell,'/')+1 : shell),(const char*)0); + exit(127); + } + default: + { + while (waitpid(pid,&status,0)==-1 && errno!=EINTR); + } + } + FS_fsmode(STDCHANNEL); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SLEEP(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (eval(value,_("pause"))->type==V_ERROR || Value_retype(value,V_REAL)->type==V_ERROR) return value; + { + double s=value->u.real; + + Value_destroy(value); + if (pass==INTERPRET) + { + if (s<0.0) return Value_new_ERROR(value,OUTOFRANGE,_("pause")); + FS_sleep(s); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_STOP(struct Value *value) /*{{{*/ +{ + if (pass==INTERPRET) FS_intr=1; + else + { + ++pc.token; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SUBEXIT(struct Value *value) /*{{{*/ +{ + struct Pc *curfn=(struct Pc*)0; + + if (pass==DECLARE || pass==COMPILE) + { + if ((curfn=findLabel(L_FUNC))==(struct Pc*)0 || (curfn->token+1)->u.identifier->defaultType!=V_VOID) + { + return Value_new_ERROR(value,STRAYSUBEXIT); + } + } + ++pc.token; + if (pass==INTERPRET) return Value_new_VOID(value); + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SWAP(struct Value *value) /*{{{*/ +{ + struct Value *l1,*l2; + struct Pc lvaluepc; + + ++pc.token; + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSWAPIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if ((l1=lvalue(value))->type==V_ERROR) return value; + if (pc.token->type==T_COMMA) ++pc.token; + else return Value_new_ERROR(value,MISSINGCOMMA); + lvaluepc=pc; + if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSWAPIDENT); + if (pass==DECLARE && Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0) + { + return Value_new_ERROR(value,REDECLARATION); + } + if ((l2=lvalue(value))->type==V_ERROR) return value; + if (l1->type!=l2->type) + { + pc=lvaluepc; + return Value_new_typeError(value,l2->type,l1->type); + } + if (pass==INTERPRET) + { + struct Value foo; + + foo=*l1; + *l1=*l2; + *l2=foo; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_SYSTEM(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pass==INTERPRET) + { + if (program.unsaved) + { + int ch; + + FS_putChars(STDCHANNEL,_("Quit without saving? (y/n) ")); + FS_flush(STDCHANNEL); + if ((ch=FS_getChar(STDCHANNEL))!=-1) + { + FS_putChar(STDCHANNEL,ch); + FS_flush(STDCHANNEL); + FS_nextline(STDCHANNEL); + if (tolower(ch)==*_("yes")) + { + bas_exit(); + exit(0); + } + } + } + else + { + bas_exit(); + exit(0); + } + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_TROFF(struct Value *value) /*{{{*/ +{ + ++pc.token; + program.trace=0; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_TRON(struct Value *value) /*{{{*/ +{ + ++pc.token; + program.trace=1; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_TRUNCATE(struct Value *value) /*{{{*/ +{ + struct Pc chnpc; + int chn; + + chnpc=pc; + ++pc.token; + if (pc.token->type==T_CHANNEL) ++pc.token; + if (eval(value,(const char*)0)==(struct Value*)0) + { + return Value_new_ERROR(value,MISSINGEXPR,_("channel")); + } + if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && FS_truncate(chn)==-1) + { + pc=chnpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_UNNUM(struct Value *value) /*{{{*/ +{ + ++pc.token; + if (pass==INTERPRET) + { + if (!DIRECTMODE) return Value_new_ERROR(value,NOTINPROGRAMMODE); + Program_unnum(&program); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_UNTIL(struct Value *value) /*{{{*/ +{ + struct Pc untilpc=pc; + struct Pc *repeatpc; + + ++pc.token; + if (eval(value,_("condition"))->type==V_ERROR) return value; + if (pass==INTERPRET) + { + if (Value_isNull(value)) pc=untilpc.token->u.until; + Value_destroy(value); + } + if (pass==DECLARE || pass==COMPILE) + { + if ((repeatpc=popLabel(L_REPEAT))==(struct Pc*)0) return Value_new_ERROR(value,STRAYUNTIL); + untilpc.token->u.until=*repeatpc; + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_WAIT(struct Value *value) /*{{{*/ +{ + int address,mask,sel=-1,usesel; + struct Pc lpc; + + lpc=pc; + ++pc.token; + if (eval(value,_("address"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + address=value->u.integer; + Value_destroy(value); + if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA); + ++pc.token; + if (eval(value,_("mask"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + mask=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) + { + ++pc.token; + if (eval(value,_("select"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + sel=value->u.integer; + usesel=1; + Value_destroy(value); + } + else usesel=0; + if (pass==INTERPRET) + { + int v; + + do + { + if ((v=FS_portInput(address))==-1) + { + pc=lpc; + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + } while ((usesel ? (v^sel)&mask : v^mask)==0); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_WHILE(struct Value *value) /*{{{*/ +{ + struct Pc whilepc=pc; + + if (pass==DECLARE || pass==COMPILE) pushLabel(L_WHILE,&pc); + ++pc.token; + if (eval(value,_("condition"))->type==V_ERROR) return value; + if (pass==INTERPRET) + { + if (Value_isNull(value)) pc=*whilepc.token->u.afterwend; + Value_destroy(value); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_WEND(struct Value *value) /*{{{*/ +{ + if (pass==DECLARE || pass==COMPILE) + { + struct Pc *whilepc; + + if ((whilepc=popLabel(L_WHILE))==(struct Pc*)0) return Value_new_ERROR(value,STRAYWEND,topLabelDescription()); + *pc.token->u.whilepc=*whilepc; + ++pc.token; + *(whilepc->token->u.afterwend)=pc; + } + else pc=*pc.token->u.whilepc; + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_WIDTH(struct Value *value) /*{{{*/ +{ + int chn=STDCHANNEL,width; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + width=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && FS_width(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + if (pc.token->type==T_COMMA) /*{{{*/ + { + ++pc.token; + if (eval(value,_("zone width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + width=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && FS_zone(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + /*}}}*/ + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_WRITE(struct Value *value) /*{{{*/ +{ + int chn=STDCHANNEL; + int comma=0; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + while (1) + { + if (eval(value,(const char*)0)) + { + if (value->type==V_ERROR) return value; + if (pass==INTERPRET) + { + struct String s; + + String_new(&s); + if (comma) String_appendChar(&s,','); + if (FS_putString(chn,Value_toWrite(value,&s))==-1) + { + Value_destroy(value); + return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + String_destroy(&s); + } + Value_destroy(value); + comma=1; + } + else if (pc.token->type==T_COMMA || pc.token->type==T_SEMICOLON) ++pc.token; + else break; + } + if (pass==INTERPRET) + { + FS_putChar(chn,'\n'); + if (FS_flush(chn)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_XREF(struct Value *value) /*{{{*/ +{ + stack.resumeable=0; + ++pc.token; + if (pass==INTERPRET) + { + if (!program.runnable && compileProgram(value,1)->type==V_ERROR) return value; + Program_xref(&program,STDCHANNEL); + } + return (struct Value*)0; +} +/*}}}*/ +struct Value *stmt_ZONE(struct Value *value) /*{{{*/ +{ + int chn=STDCHANNEL,width; + + ++pc.token; + if (pc.token->type==T_CHANNEL) /*{{{*/ + { + ++pc.token; + if (eval(value,_("channel"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + chn=value->u.integer; + Value_destroy(value); + if (pc.token->type==T_COMMA) ++pc.token; + } + /*}}}*/ + if (eval(value,_("zone width"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value; + width=value->u.integer; + Value_destroy(value); + if (pass==INTERPRET && FS_zone(chn,width)==-1) return Value_new_ERROR(value,IOERROR,FS_errmsg); + return (struct Value*)0; +} +/*}}}*/ diff --git a/apps/interpreters/bas/statement.h b/apps/interpreters/bas/statement.h new file mode 100644 index 000000000..fefb09c06 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/str.c b/apps/interpreters/bas/str.c new file mode 100644 index 000000000..1491d80d8 --- /dev/null +++ b/apps/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); +} +/*}}}*/ diff --git a/apps/interpreters/bas/str.h b/apps/interpreters/bas/str.h new file mode 100644 index 000000000..eb2166d84 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/runbas.in b/apps/interpreters/bas/test/runbas.in new file mode 100644 index 000000000..6072a7b38 --- /dev/null +++ b/apps/interpreters/bas/test/runbas.in @@ -0,0 +1,3 @@ +#!/bin/sh + +@VALGRIND@ ./bas "$@" diff --git a/apps/interpreters/bas/test/test01 b/apps/interpreters/bas/test/test01 new file mode 100644 index 000000000..b89c7a73a --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test02 b/apps/interpreters/bas/test/test02 new file mode 100644 index 000000000..88615fa61 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test03 b/apps/interpreters/bas/test/test03 new file mode 100644 index 000000000..b7b1496e0 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test04 b/apps/interpreters/bas/test/test04 new file mode 100644 index 000000000..547f4ec28 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test05 b/apps/interpreters/bas/test/test05 new file mode 100644 index 000000000..28322325f --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test06 b/apps/interpreters/bas/test/test06 new file mode 100644 index 000000000..8a5402d04 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test07 b/apps/interpreters/bas/test/test07 new file mode 100644 index 000000000..57f2899a6 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test08 b/apps/interpreters/bas/test/test08 new file mode 100644 index 000000000..82209c91b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test09 b/apps/interpreters/bas/test/test09 new file mode 100644 index 000000000..d751b2474 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test10 b/apps/interpreters/bas/test/test10 new file mode 100644 index 000000000..35d65ca4a --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test11 b/apps/interpreters/bas/test/test11 new file mode 100644 index 000000000..88801c730 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test12 b/apps/interpreters/bas/test/test12 new file mode 100644 index 000000000..b78f53747 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test13 b/apps/interpreters/bas/test/test13 new file mode 100644 index 000000000..c4e3e3d2b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test14 b/apps/interpreters/bas/test/test14 new file mode 100644 index 000000000..1699d3bd9 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test15 b/apps/interpreters/bas/test/test15 new file mode 100644 index 000000000..5d4c7545b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test16 b/apps/interpreters/bas/test/test16 new file mode 100644 index 000000000..9e9942381 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test17 b/apps/interpreters/bas/test/test17 new file mode 100644 index 000000000..544e790f8 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test18 b/apps/interpreters/bas/test/test18 new file mode 100644 index 000000000..2ad4d8ec1 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test19 b/apps/interpreters/bas/test/test19 new file mode 100644 index 000000000..9f0a471f4 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test20 b/apps/interpreters/bas/test/test20 new file mode 100644 index 000000000..c8a1a06e1 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test21 b/apps/interpreters/bas/test/test21 new file mode 100644 index 000000000..407430d4c --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test22 b/apps/interpreters/bas/test/test22 new file mode 100644 index 000000000..73e2317f9 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test23 b/apps/interpreters/bas/test/test23 new file mode 100644 index 000000000..60b37da89 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test24 b/apps/interpreters/bas/test/test24 new file mode 100644 index 000000000..40037cdcd --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test25 b/apps/interpreters/bas/test/test25 new file mode 100644 index 000000000..07132f8c5 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test26 b/apps/interpreters/bas/test/test26 new file mode 100644 index 000000000..f7b85687a --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test27 b/apps/interpreters/bas/test/test27 new file mode 100644 index 000000000..f90c0c236 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test28 b/apps/interpreters/bas/test/test28 new file mode 100644 index 000000000..fa22845bb --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test29 b/apps/interpreters/bas/test/test29 new file mode 100644 index 000000000..945f33e4d --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test30 b/apps/interpreters/bas/test/test30 new file mode 100644 index 000000000..0d7b29a26 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test31 b/apps/interpreters/bas/test/test31 new file mode 100644 index 000000000..7c4b79017 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test32 b/apps/interpreters/bas/test/test32 new file mode 100644 index 000000000..d080d3c27 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test33 b/apps/interpreters/bas/test/test33 new file mode 100644 index 000000000..adc53dd62 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test34 b/apps/interpreters/bas/test/test34 new file mode 100644 index 000000000..0419284d8 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test35 b/apps/interpreters/bas/test/test35 new file mode 100644 index 000000000..448fc0dfa --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test36 b/apps/interpreters/bas/test/test36 new file mode 100644 index 000000000..b26cffae3 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test37 b/apps/interpreters/bas/test/test37 new file mode 100644 index 000000000..ca0d446eb --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test38 b/apps/interpreters/bas/test/test38 new file mode 100644 index 000000000..3733d0ad4 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test39 b/apps/interpreters/bas/test/test39 new file mode 100644 index 000000000..25c33d475 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test40 b/apps/interpreters/bas/test/test40 new file mode 100644 index 000000000..d2c4eb0fe --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test41 b/apps/interpreters/bas/test/test41 new file mode 100644 index 000000000..58bc28c74 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test42 b/apps/interpreters/bas/test/test42 new file mode 100644 index 000000000..f448251a4 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test43 b/apps/interpreters/bas/test/test43 new file mode 100644 index 000000000..56d993a0f --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test44 b/apps/interpreters/bas/test/test44 new file mode 100644 index 000000000..25b1ec3de --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test45 b/apps/interpreters/bas/test/test45 new file mode 100644 index 000000000..88878c2d0 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test46 b/apps/interpreters/bas/test/test46 new file mode 100644 index 000000000..4537f3e56 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test47 b/apps/interpreters/bas/test/test47 new file mode 100644 index 000000000..13eb94db2 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test48 b/apps/interpreters/bas/test/test48 new file mode 100644 index 000000000..fe2a9e870 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test49 b/apps/interpreters/bas/test/test49 new file mode 100644 index 000000000..0d8bcb455 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test50 b/apps/interpreters/bas/test/test50 new file mode 100644 index 000000000..4155ca52b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test51 b/apps/interpreters/bas/test/test51 new file mode 100644 index 000000000..9341dd09b --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/test/test52 b/apps/interpreters/bas/test/test52 new file mode 100644 index 000000000..dc524f645 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/token.h b/apps/interpreters/bas/token.h new file mode 100644 index 000000000..8feb76283 --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/token.l b/apps/interpreters/bas/token.l new file mode 100644 index 000000000..54179765a --- /dev/null +++ b/apps/interpreters/bas/token.l @@ -0,0 +1,1943 @@ +/* Tokens and token sequence arrays. */ +%{ +/* #includes */ /*{{{C}}}*//*{{{*/ +#include "config.h" + +#include <assert.h> +#include <ctype.h> +#include <float.h> +#include <limits.h> +#include <math.h> +#include <stddef.h> +#include <stdlib.h> +#include <string.h> + +#include "auto.h" +#include "token.h" +#include "statement.h" + +#ifdef DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ + +static int matchdata; +static int backslash_colon; +static int uppercase; +int yylex(void); +static struct Token *cur; + +static void string(const char *text) /*{{{*/ +{ + if (cur) + { + const char *t; + char *q; + size_t l; + + for (t=text+1,l=0; *(t+1); ++t,++l) + { + if (*t=='"') ++t; + } + cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(cur->u.string),l); + for (t=text+1,q=cur->u.string->character; *(t+1); ++t,++q) + { + *q=*t; + if (*t=='"') ++t; + } + } +} +/*}}}*/ +static void string2(void) /*{{{*/ +{ + if (cur) + { + char *t,*q; + size_t l; + + for (t=yytext+1,l=0; *t; ++t,++l) + { + if (*t=='"') ++t; + } + cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(cur->u.string),l); + for (t=yytext+1,q=cur->u.string->character; *t; ++t,++q) + { + *q=*t; + if (*t=='"') ++t; + } + } +} +/*}}}*/ +%} + /* flex options and definitions */ /*{{{*/ +%option noyywrap +%option nounput +%x DATAINPUT ELSEIF IMAGEFMT +REAL ([0-9]+("!"|"#"))|([0-9]+\.[0-9]*(e("+"|"-")?[0-9]+)?("!"|"#")?)|([0-9]*\.[0-9]+(e("+"|"-")?[0-9]+)?("!"|"#")?|([0-9]+e("+"|"-")?[0-9]+("!"|"#")?)) +INTEGER [0-9]+%? +HEXINTEGER &H[0-9A-F]+ +OCTINTEGER &O[0-7]+ +IDENTIFIER ("fn"[ \t]+)?[A-Z][A-Z_0-9\.]*("$"|"%"|"#")? +STRING \"([^"]|\"\")*\" +STRING2 \"([^"]|\"\")*$ +REM rem([^0-9A-Z_\.\n][^\n]*)? +QUOTE ("'"|"!")[^\n]* +ENDIF end[ \t]*if +ENDPROC end[ \t]*proc +ENDSELECT end[ \t]*select +DOUNTIL do[ \t]+until +DOWHILE do[ \t]+while +EXITDO exit[ \t]+do +EXITFOR exit[ \t]+for +LINEINPUT (line[ \t]+input)|linput +LOOPUNTIL loop[ \t]+until +DATAITEM [^ \t\n,:][^,:\n]* +ONERROR on[ \t]+error +ONERROROFF on[ \t]+error[ \t]+off +ONERRORGOTO0 on[ \t]+error[ \t]+goto[ \t]+0 +SELECTCASE select[ \t]+case + /*}}}*/ +%% + /* flex rules */ /*{{{*/ + if (matchdata) BEGIN(DATAINPUT); + +"#" return T_CHANNEL; +{REAL} { + int overflow; + double d; + + d=Value_vald(yytext,(char**)0,&overflow); + if (overflow) + { + if (cur) cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (cur) cur->u.real=d; + return T_REAL; + } +{INTEGER} { + int overflow; + long int n; + + n=Value_vali(yytext,(char**)0,&overflow); + if (overflow) + { + double d; + + d=Value_vald(yytext,(char**)0,&overflow); + if (overflow) + { + if (cur) cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (cur) cur->u.real=d; + return T_REAL; + } + if (cur) cur->u.integer=n; + return T_INTEGER; + } +{HEXINTEGER} { + int overflow; + long int n; + + n=Value_vali(yytext,(char**)0,&overflow); + if (overflow) + { + if (cur) cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (cur) cur->u.hexinteger=n; + return T_HEXINTEGER; + } +{OCTINTEGER} { + int overflow; + long int n; + + n=Value_vali(yytext,(char**)0,&overflow); + if (overflow) + { + if (cur) cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (cur) cur->u.octinteger=n; + return T_OCTINTEGER; + } +{STRING} string(yytext); return T_STRING; +{STRING2} string2(); return T_STRING; +"("|"[" return T_OP; +")"|"]" return T_CP; +"*" return T_MULT; +"+" return T_PLUS; +"-" return T_MINUS; +"," return T_COMMA; +"/" return T_DIV; +"\\" { + if (backslash_colon) + { + if (cur) cur->statement=stmt_COLON_EOL; + return T_COLON; + } + return T_IDIV; + } +":" { + if (cur) + { + cur->statement=stmt_COLON_EOL; + } + return T_COLON; + } +";" return T_SEMICOLON; +"<" return T_LT; +"<=" return T_LE; +"=<" return T_LE; +"<>"|"><" return T_NE; +"=" { + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_EQ; + } +">" return T_GT; +">=" return T_GE; +"=>" return T_GE; +"^" return T_POW; +"access"[ \t]+"read" return T_ACCESS_READ; +"access"[ \t]+"read"[ \t]+"write" return T_ACCESS_READ_WRITE; +"access"[ \t]+"write" return T_ACCESS_WRITE; +"and" return T_AND; +"as" return T_AS; +"call" { + if (cur) + { + cur->statement=stmt_CALL; + } + return T_CALL; + } +"case"[ \t]+"else" { + if (cur) + { + cur->statement=stmt_CASE; + cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEELSE; + } +"case" { + if (cur) + { + cur->statement=stmt_CASE; + cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEVALUE; + } +"chdir" { + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_CHDIR; + } +"clear" { + if (cur) + { + cur->statement=stmt_CLEAR; + } + return T_CLEAR; + } +"close" { + if (cur) + { + cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } +"close"/"#" { + if (cur) + { + cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } +"cls"|"home" { + if (cur) + { + cur->statement=stmt_CLS; + } + return T_CLS; + } +"color" { + if (cur) + { + cur->statement=stmt_COLOR; + } + return T_COLOR; + } +"con" return T_CON; +"copy" { + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_COPY; + } +"data"|"d." { + BEGIN(DATAINPUT); + if (cur) + { + cur->statement=stmt_DATA; + } + return T_DATA; + } +<DATAINPUT>{STRING} string(yytext); return T_STRING; +<DATAINPUT>{STRING2} string2(); return T_STRING; +<DATAINPUT>"," return T_COMMA; +<DATAINPUT>{DATAITEM} { + if (cur) cur->u.datainput=strcpy(malloc(strlen(yytext)+1),yytext); + return T_DATAINPUT; + } +<DATAINPUT>[ \t]+ +<DATAINPUT>\n BEGIN(INITIAL); +<DATAINPUT>: BEGIN(INITIAL); return T_COLON; +"dec" { + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_DEC; + } +"defdbl" { + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFDBL; + } +"defint" { + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFINT; + } +"defstr" { + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFSTR; + } +"def"/[ \t]+fn[ \t]*[A-Z_0-9\.] { + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFFN; + } +"def"/[ \t]+proc[A-Z_0-9\.] { + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFPROC; + } +"delete" { + if (cur) + { + cur->statement=stmt_DELETE; + } + return T_DELETE; + } +"dim" { + if (cur) + { + cur->statement=stmt_DIM; + } + return T_DIM; + } +"display" { + if (cur) + { + cur->statement=stmt_DISPLAY; + } + return T_DISPLAY; + } +"do" { + if (cur) + { + cur->statement=stmt_DO; + } + return T_DO; + } +{DOUNTIL} { + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOUNTIL; + } +{DOWHILE} { + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOWHILE; + } +"edit" { + if (cur) + { + cur->statement=stmt_EDIT; + } + return T_EDIT; + } +"else"|"el." { + if (cur) + { + cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSE; + } +"else"/"if" { + BEGIN(ELSEIF); + if (cur) + { + cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSEIFELSE; + } +<ELSEIF>"if" { + BEGIN(INITIAL); + if (cur) + { + cur->statement=stmt_IF_ELSEIFIF; + } + return T_ELSEIFIF; + } +end[ \t]+function { + if (cur) + { + cur->statement=stmt_ENDFN; + } + return T_ENDFN; + } +{ENDIF} { + if (cur) + { + cur->statement=stmt_ENDIF; + } + return T_ENDIF; + } +{ENDPROC} { + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_ENDPROC; + } +{ENDSELECT} { + if (cur) + { + cur->statement=stmt_ENDSELECT; + } + return T_ENDSELECT; + } +"end"[ \t]*"sub" { + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } +"end" { + if (cur) + { + cur->statement=stmt_END; + } + return T_END; + } +"environ" { + if (cur) + { + cur->statement=stmt_ENVIRON; + } + return T_ENVIRON; + } +"erase" { + if (cur) + { + cur->statement=stmt_ERASE; + } + return T_ERASE; + } +"eqv" return T_EQV; +{EXITDO} { + if (cur) + { + cur->statement=stmt_EXITDO; + } + return T_EXITDO; + } +{EXITFOR} { + if (cur) + { + cur->statement=stmt_EXITFOR; + } + return T_EXITFOR; + } +"exit"[ \t]+"function" { + if (cur) + { + cur->statement=stmt_FNEXIT; + } + return T_FNEXIT; + } +"exit"[ \t]+"sub" { + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } +"field" { + if (cur) + { + cur->statement=stmt_FIELD; + } + return T_FIELD; + } +"field"/"#" { + if (cur) + { + cur->statement=stmt_FIELD; + } + return T_FIELD; + } +"fnend" { + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNEND; + } +"fnreturn" { + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNRETURN; + } +"for" { + if (cur) + { + cur->statement=stmt_FOR; + } + return T_FOR; + } +"for"[ \t]+"input" return T_FOR_INPUT; +"for"[ \t]+"output" return T_FOR_OUTPUT; +"for"[ \t]+"append" return T_FOR_APPEND; +"for"[ \t]+"random" return T_FOR_RANDOM; +"for"[ \t]+"binary" return T_FOR_BINARY; +"function" { + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_FUNCTION; + } +"get" { + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_GET; + } +"get"/"#" { + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_GET; + } +"go"[ \t]*"sub" { + if (cur) + { + cur->statement=stmt_GOSUB; + } + return T_GOSUB; + } +"go"[ \t]*"to" { + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_GOTO; + } +"idn" return T_IDN; +"if" { + if (cur) + { + cur->statement=stmt_IF_ELSEIFIF; + } + return T_IF; + } +"image"[ \t]*/[^"\n \t] { + BEGIN(IMAGEFMT); + if (cur) + { + cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } +<IMAGEFMT>.*$ { + BEGIN(INITIAL); + if (cur) + { + size_t l; + + l=strlen(yytext); + cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(cur->u.string),l); + memcpy(cur->u.string->character,yytext,l); + } + return T_STRING; + } +"image" { + if (cur) + { + cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } +"imp" return T_IMP; +"inc" { + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_INC; + } +"input" { + if (cur) + { + cur->statement=stmt_INPUT; + } + return T_INPUT; + } +"input"/"#" { + if (cur) + { + cur->statement=stmt_INPUT; + } + return T_INPUT; + } +"inv" return T_INV; +"is" return T_IS; +"kill" { + if (cur) + { + cur->statement=stmt_KILL; + } + return T_KILL; + } +"let" { + if (cur) + { + cur->statement=stmt_LET; + } + return T_LET; + } +"list" { + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LIST; + } +"llist" { + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LLIST; + } +"load" { + if (cur) + { + cur->statement=stmt_LOAD; + } + return T_LOAD; + } +"local" { + if (cur) + { + cur->statement=stmt_LOCAL; + } + return T_LOCAL; + } +"locate" { + if (cur) + { + cur->statement=stmt_LOCATE; + } + return T_LOCATE; + } +"lock" { + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_LOCK; + } +"lock"[ \t]+"read" return T_LOCK_READ; +"lock"[ \t]+"write" return T_LOCK_WRITE; +"loop" { + if (cur) + { + cur->statement=stmt_LOOP; + } + return T_LOOP; + } +{LOOPUNTIL} { + if (cur) + { + cur->statement=stmt_LOOPUNTIL; + } + return T_LOOPUNTIL; + } +"lprint" { + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_LPRINT; + } +"lset" { + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_LSET; + } +"mat"[ \t]+"input" { + if (cur) + { + cur->statement=stmt_MATINPUT; + } + return T_MATINPUT; + } +"mat"[ \t]+"print" { + if (cur) + { + cur->statement=stmt_MATPRINT; + } + return T_MATPRINT; + } +"mat"[ \t]+"read" { + if (cur) + { + cur->statement=stmt_MATREAD; + } + return T_MATREAD; + } +"mat"[ \t]+"redim" { + if (cur) + { + cur->statement=stmt_MATREDIM; + } + return T_MATREDIM; + } +"mat"[ \t]+"write" { + if (cur) + { + cur->statement=stmt_MATWRITE; + } + return T_MATWRITE; + } +"mat" { + if (cur) + { + cur->statement=stmt_MAT; + } + return T_MAT; + } +"mkdir" { + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_MKDIR; + } +"mod" return T_MOD; +"new" { + if (cur) + { + cur->statement=stmt_NEW; + } + return T_NEW; + } +"name" { + if (cur) + { + cur->statement=stmt_NAME; + } + return T_NAME; + } +"next" { + if (cur) + { + cur->statement=stmt_NEXT; + cur->u.next=malloc(sizeof(struct Next)); + } + return T_NEXT; + } +"not" return T_NOT; +{ONERROROFF} { + if (cur) + { + cur->statement=stmt_ONERROROFF; + } + return T_ONERROROFF; + } +{ONERRORGOTO0} { + if (cur) + { + cur->statement=stmt_ONERRORGOTO0; + } + return T_ONERRORGOTO0; + } +{ONERROR} { + if (cur) + { + cur->statement=stmt_ONERROR; + } + return T_ONERROR; + } +"on" { + if (cur) + { + cur->statement=stmt_ON; + cur->u.on.pcLength=1; + cur->u.on.pc=(struct Pc*)0; + } + return T_ON; + } +"open" { + if (cur) + { + cur->statement=stmt_OPEN; + } + return T_OPEN; + } +"option"[ \t]+"base" { + if (cur) + { + cur->statement=stmt_OPTIONBASE; + } + return T_OPTIONBASE; + } +"option"[ \t]+"run" { + if (cur) + { + cur->statement=stmt_OPTIONRUN; + } + return T_OPTIONRUN; + } +"option"[ \t]+"stop" { + if (cur) + { + cur->statement=stmt_OPTIONSTOP; + } + return T_OPTIONSTOP; + } +"or" return T_OR; +"out" { + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_OUT; + } +"print"|"p."|"?" { + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } +("print"|"p."|"?")/"#" { + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } +"poke" { + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_POKE; + } +"put" { + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_PUT; + } +"put"/"#" { + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_PUT; + } +"randomize" { + if (cur) + { + cur->statement=stmt_RANDOMIZE; + } + return T_RANDOMIZE; + } +"read" { + if (cur) + { + cur->statement=stmt_READ; + } + return T_READ; + } +"renum"|"ren." { + if (cur) + { + cur->statement=stmt_RENUM; + } + return T_RENUM; + } +"repeat"|"rep." { + if (cur) + { + cur->statement=stmt_REPEAT; + } + return T_REPEAT; + } +"restore"|"res." { + if (cur) + { + cur->statement=stmt_RESTORE; + } + return T_RESTORE; + } +"resume" { + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_RESUME; + } +"return"|"r." { + if (cur) + { + cur->statement=stmt_RETURN; + } + return T_RETURN; + } +"rset" { + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_RSET; + } +"run" { + if (cur) + { + cur->statement=stmt_RUN; + } + return T_RUN; + } +"save" { + if (cur) + { + cur->statement=stmt_SAVE; + } + return T_SAVE; + } +{SELECTCASE} { + if (cur) + { + cur->statement=stmt_SELECTCASE; + cur->u.selectcase=malloc(sizeof(struct Selectcase)); + } + return T_SELECTCASE; + } +"shared" return T_SHARED; +"shell" { + if (cur) + { + cur->statement=stmt_SHELL; + } + return T_SHELL; + } +"sleep" { + if (cur) + { + cur->statement=stmt_SLEEP; + } + return T_SLEEP; + } +"spc" return T_SPC; +"step" return T_STEP; +"stop" { + if (cur) + { + cur->statement=stmt_STOP; + } + return T_STOP; + } +"sub"[ \t]*"end" { + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } +"sub"[ \t]*"exit" { + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } +"sub" { + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_SUB; + } +"swap" { + if (cur) + { + cur->statement=stmt_SWAP; + } + return T_SWAP; + } +"system"|"bye" { + if (cur) + { + cur->statement=stmt_SYSTEM; + } + return T_SYSTEM; + } +"then"|"th." return T_THEN; +"tab" return T_TAB; +"to" return T_TO; +"trn" return T_TRN; +"troff" { + if (cur) + { + cur->statement=stmt_TROFF; + } + return T_TROFF; + } +"tron" { + if (cur) + { + cur->statement=stmt_TRON; + } + return T_TRON; + } +"truncate" { + if (cur) + { + cur->statement=stmt_TRUNCATE; + } + return T_TRUNCATE; + } +"unlock" { + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_UNLOCK; + } +"unnum" { + if (cur) + { + cur->statement=stmt_UNNUM; + } + return T_UNNUM; + } +"until" { + if (cur) + { + cur->statement=stmt_UNTIL; + } + return T_UNTIL; + } +"using" return T_USING; +"wait" { + if (cur) + { + cur->statement=stmt_WAIT; + } + return T_WAIT; + } +"wend" { + if (cur) + { + cur->statement=stmt_WEND; + cur->u.whilepc=malloc(sizeof(struct Pc)); + } + return T_WEND; + } +"while" { + if (cur) + { + cur->statement=stmt_WHILE; + cur->u.afterwend=malloc(sizeof(struct Pc)); + } + return T_WHILE; + } +"width" { + if (cur) + { + cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } +"width"/"#" { + if (cur) + { + cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } +"write" { + if (cur) + { + cur->statement=stmt_WRITE; + } + return T_WRITE; + } +"write"/"#" { + if (cur) + { + cur->statement=stmt_WRITE; + } + return T_WRITE; + } +"xor" return T_XOR; +"xref" { + if (cur) + { + cur->statement=stmt_XREF; + } + return T_XREF; + } +"zer" return T_ZER; +"zone" { + if (cur) + { + cur->statement=stmt_ZONE; + } + return T_ZONE; + } +{REM} { + if (cur) + { + cur->statement=stmt_QUOTE_REM; + cur->u.rem=strcpy(malloc(strlen(yytext+3)+1),yytext+3); + } + return T_REM; + } +"rename" { + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_RENAME; + } +{QUOTE} { + if (cur) + { + cur->statement=stmt_QUOTE_REM; + strcpy(cur->u.rem=malloc(strlen(yytext+1)+1),yytext+1); + } + return T_QUOTE; + } +{LINEINPUT} { + if (cur) + { + cur->statement=stmt_LINEINPUT; + } + return T_LINEINPUT; + } +{IDENTIFIER} { + if (cur) + { + size_t len; + char *s; + int fn; + + cur->statement=stmt_IDENTIFIER; + if (tolower(yytext[0])=='f' && tolower(yytext[1])=='n') + { + for (len=2,s=&yytext[2]; *s==' ' || *s=='\t'; ++s); + fn=1; + } + else + { + len=0; + s=yytext; + fn=0; + } + len+=strlen(s); + cur->u.identifier=malloc(offsetof(struct Identifier,name)+len+1); + if (fn) + { + memcpy(cur->u.identifier->name,yytext,2); + strcpy(cur->u.identifier->name+2,s); + } + else + { + strcpy(cur->u.identifier->name,s); + } + switch (yytext[yyleng-1]) + { + case '$': cur->u.identifier->defaultType=V_STRING; break; + case '%': cur->u.identifier->defaultType=V_INTEGER; break; + default: cur->u.identifier->defaultType=V_REAL; break; + } + } + return T_IDENTIFIER; + } +[ \t\n]+ +. { + if (cur) cur->u.junk=yytext[0]; + return T_JUNK; + } + /*}}}*/ +%% + +int Token_property[T_LASTTOKEN]; + +struct Token *Token_newCode(const char *ln) /*{{{*/ +{ + int l,lasttok,thistok,addNumber=0,sawif; + struct Token *result; + YY_BUFFER_STATE buf; + + cur=(struct Token*)0; + buf=yy_scan_string(ln); + /* determine number of tokens */ /*{{{*/ + matchdata=sawif=0; + for (lasttok=T_EOL,l=1; (thistok=yylex()); ++l) + { + if (l==1 && thistok!=T_INTEGER) { addNumber=1; ++l; } + if ((lasttok==T_THEN || lasttok==T_ELSE) && thistok==T_INTEGER) ++l; + if (thistok==T_IF) sawif=1; + if (thistok==T_THEN) sawif=0; + if (thistok==T_GOTO && sawif) ++l; + lasttok=thistok; + } + if (l==1) { addNumber=1; ++l; } + /*}}}*/ + yy_delete_buffer(buf); + cur=result=malloc(sizeof(struct Token)*l); + if (addNumber) + { + cur->type=T_UNNUMBERED; + ++cur; + } + buf=yy_scan_string(ln); + lasttok=T_EOL; + matchdata=sawif=0; + while (cur->statement=NULL,(cur->type=yylex())) + { + if (cur->type==T_IF) sawif=1; + if (cur->type==T_THEN) sawif=0; + if (cur->type==T_GOTO && sawif) + { + sawif=0; + *(cur+1)=*cur; + cur->type=T_THEN; + lasttok=T_GOTO; + cur+=2; + } + else if ((lasttok==T_THEN || lasttok==T_ELSE) && cur->type==T_INTEGER) + { + *(cur+1)=*cur; + cur->type=T_GOTO; + cur->statement=stmt_RESUME_GOTO; + lasttok=T_INTEGER; + cur+=2; + } + else + { + lasttok=cur->type; + ++cur; + } + } + cur->type=T_EOL; + cur->statement=stmt_COLON_EOL; + yy_delete_buffer(buf); + return result; +} +/*}}}*/ +struct Token *Token_newData(const char *ln) /*{{{*/ +{ + int l; + struct Token *result; + YY_BUFFER_STATE buf; + + cur=(struct Token*)0; + buf=yy_scan_string(ln); + matchdata=1; + for (l=1; yylex(); ++l); + yy_delete_buffer(buf); + cur=result=malloc(sizeof(struct Token)*l); + buf=yy_scan_string(ln); + matchdata=1; + while (cur->statement=NULL,(cur->type=yylex())) ++cur; + cur->type=T_EOL; + cur->statement=stmt_COLON_EOL; + yy_delete_buffer(buf); + return result; +} +/*}}}*/ +void Token_destroy(struct Token *token) /*{{{*/ +{ + struct Token *r=token; + + do + { + switch (r->type) + { + case T_ACCESS_READ: break; + case T_ACCESS_WRITE: break; + case T_AND: break; + case T_AS: break; + case T_CALL: break; + case T_CASEELSE: + case T_CASEVALUE: free(r->u.casevalue); break; + case T_CHANNEL: break; + case T_CHDIR: break; + case T_CLEAR: break; + case T_CLOSE: break; + case T_CLS: break; + case T_COLON: break; + case T_COLOR: break; + case T_COMMA: break; + case T_CON: break; + case T_COPY: break; + case T_CP: break; + case T_DATA: break; + case T_DATAINPUT: free(r->u.datainput); break; + case T_DEC: break; + case T_DEFFN: break; + case T_DEFDBL: break; + case T_DEFINT: break; + case T_DEFPROC: break; + case T_DEFSTR: break; + case T_DELETE: break; + case T_DIM: break; + case T_DISPLAY: break; + case T_DIV: break; + case T_DO: break; + case T_DOUNTIL: break; + case T_DOWHILE: break; + case T_EDIT: break; + case T_ELSE: break; + case T_ELSEIFELSE: break; + case T_ELSEIFIF: break; + case T_END: break; + case T_ENDFN: break; + case T_ENDIF: break; + case T_ENDPROC: break; + case T_ENDSELECT: break; + case T_ENVIRON: break; + case T_EOL: break; + case T_EQ: break; + case T_EQV: break; + case T_ERASE: break; + case T_EXITDO: break; + case T_EXITFOR: break; + case T_FIELD: break; + case T_FNEND: break; + case T_FNEXIT: break; + case T_FNRETURN: break; + case T_FOR: break; + case T_FOR_INPUT: break; + case T_FOR_OUTPUT: break; + case T_FOR_APPEND: break; + case T_FOR_RANDOM: break; + case T_FOR_BINARY: break; + case T_FUNCTION: break; + case T_GE: break; + case T_GET: break; + case T_GOSUB: break; + case T_GOTO: break; + case T_GT: break; + case T_HEXINTEGER: break; + case T_OCTINTEGER: break; + case T_IDENTIFIER: free(r->u.identifier); break; + case T_IDIV: break; + case T_IDN: break; + case T_IF: break; + case T_IMAGE: break; + case T_IMP: break; + case T_INC: break; + case T_INPUT: break; + case T_INTEGER: break; + case T_INV: break; + case T_IS: break; + case T_JUNK: break; + case T_KILL: break; + case T_LE: break; + case T_LET: break; + case T_LINEINPUT: break; + case T_LIST: break; + case T_LLIST: break; + case T_LOAD: break; + case T_LOCAL: break; + case T_LOCATE: break; + case T_LOCK: break; + case T_LOCK_READ: break; + case T_LOCK_WRITE: break; + case T_LOOP: break; + case T_LOOPUNTIL: break; + case T_LPRINT: break; + case T_LSET: break; + case T_LT: break; + case T_MAT: break; + case T_MATINPUT: break; + case T_MATPRINT: break; + case T_MATREAD: break; + case T_MATREDIM: break; + case T_MATWRITE: break; + case T_MINUS: break; + case T_MKDIR: break; + case T_MOD: break; + case T_MULT: break; + case T_NAME: break; + case T_NE: break; + case T_NEW: break; + case T_NEXT: free(r->u.next); break; + case T_NOT: break; + case T_ON: if (r->u.on.pc) free(r->u.on.pc); break; + case T_ONERROR: break; + case T_ONERRORGOTO0: break; + case T_ONERROROFF: break; + case T_OP: break; + case T_OPEN: break; + case T_OPTIONBASE: break; + case T_OPTIONRUN: break; + case T_OPTIONSTOP: break; + case T_OR: break; + case T_OUT: break; + case T_PLUS: break; + case T_POKE: break; + case T_POW: break; + case T_PRINT: break; + case T_PUT: break; + case T_QUOTE: free(r->u.rem); break; + case T_RANDOMIZE: break; + case T_READ: break; + case T_REAL: break; + case T_REM: free(r->u.rem); break; + case T_RENAME: break; + case T_RENUM: break; + case T_REPEAT: break; + case T_RESTORE: break; + case T_RESUME: break; + case T_RETURN: break; + case T_RSET: break; + case T_RUN: break; + case T_SAVE: break; + case T_SELECTCASE: free(r->u.selectcase); break; + case T_SEMICOLON: break; + case T_SHARED: break; + case T_SHELL: break; + case T_SLEEP: break; + case T_SPC: break; + case T_STEP: break; + case T_STOP: break; + case T_STRING: String_destroy(r->u.string); free(r->u.string); break; + case T_SUB: break; + case T_SUBEND: break; + case T_SUBEXIT: break; + case T_SWAP: break; + case T_SYSTEM: break; + case T_TAB: break; + case T_THEN: break; + case T_TO: break; + case T_TRN: break; + case T_TROFF: break; + case T_TRON: break; + case T_TRUNCATE: break; + case T_UNLOCK: break; + case T_UNNUM: break; + case T_UNNUMBERED: break; + case T_UNTIL: break; + case T_USING: break; + case T_WAIT: break; + case T_WEND: free(r->u.whilepc); break; + case T_WHILE: free(r->u.afterwend); break; + case T_WIDTH: break; + case T_WRITE: break; + case T_XOR: break; + case T_XREF: break; + case T_ZER: break; + case T_ZONE: break; + default: assert(0); + } + } while ((r++)->type!=T_EOL); + free(token); +} +/*}}}*/ +struct String *Token_toString(struct Token *token, struct Token *spaceto, struct String *s, int *indent, int width) /*{{{*/ +{ + int ns=0,infn=0; + int thisindent=0,thisnotindent=0,nextindent=0; + size_t oldlength=s->length; + struct Token *t; + static struct + { + const char *text; + char space; + } table[]= + { + /* 0 */ {(const char*)0,-1}, + /* T_ACCESS_READ */ {"access read",1}, + /* T_ACCESS_READ_WRITE */ {"access read write",1}, + /* T_ACCESS_WRITE */ {"access write",1}, + /* T_AND */ {"and",1}, + /* T_AS */ {"as",1}, + /* T_CALL */ {"call",1}, + /* T_CASEELSE */ {"case else",1}, + /* T_CASEVALUE */ {"case",1}, + /* T_CHANNEL */ {"#",0}, + /* T_CHDIR */ {"chdir",1}, + /* T_CLEAR */ {"clear",1}, + /* T_CLOSE */ {"close",1}, + /* T_CLS */ {"cls",1}, + /* T_COLON */ {":",1}, + /* T_COLOR */ {"color",1}, + /* T_COMMA */ {",",0}, + /* T_CON */ {"con",0}, + /* T_COPY */ {"copy",1}, + /* T_CP */ {")",0}, + /* T_DATA */ {"data",1}, + /* T_DATAINPUT */ {(const char*)0,0}, + /* T_DEC */ {"dec",1}, + /* T_DEFDBL */ {"defdbl",1}, + /* T_DEFFN */ {"def",1}, + /* T_DEFINT */ {"defint",1}, + /* T_DEFPROC */ {"def",1}, + /* T_DEFSTR */ {"defstr",1}, + /* T_DELETE */ {"delete",1}, + /* T_DIM */ {"dim",1}, + /* T_DISPLAY */ {"display",1}, + /* T_DIV */ {"/",0}, + /* T_DO */ {"do",1}, + /* T_DOUNTIL */ {"do until",1}, + /* T_DOWHILE */ {"do while",1}, + /* T_EDIT */ {"edit",1}, + /* T_ELSE */ {"else",1}, + /* T_ELSEIFELSE */ {"elseif",1}, + /* T_ELSEIFIF */ {(const char*)0,0}, + /* T_END */ {"end",1}, + /* T_ENDFN */ {"end function",1}, + /* T_ENDIF */ {"end if",1}, + /* T_ENDPROC */ {"end proc",1}, + /* T_ENDSELECT */ {"end select",1}, + /* T_ENVIRON */ {"environ",1}, + /* T_EOL */ {"\n",0}, + /* T_EQ */ {"=",0}, + /* T_EQV */ {"eqv",0}, + /* T_ERASE */ {"erase",1}, + /* T_EXITDO */ {"exit do",1}, + /* T_EXITFOR */ {"exit for",1}, + /* T_FIELD */ {"field",1}, + /* T_FNEND */ {"fnend",1}, + /* T_FNEXIT */ {"exit function",1}, + /* T_FNRETURN */ {"fnreturn",1}, + /* T_FOR */ {"for",1}, + /* T_FOR_INPUT */ {"for input",1}, + /* T_FOR_OUTPUT */ {"for output",1}, + /* T_FOR_APPEND */ {"for append",1}, + /* T_FOR_RANDOM */ {"for random",1}, + /* T_FOR_BINARY */ {"for binary",1}, + /* T_FUNCTION */ {"function",1}, + /* T_GE */ {">=",0}, + /* T_GET */ {"get",1}, + /* T_GOSUB */ {"gosub",1}, + /* T_GOTO */ {"goto",1}, + /* T_GT */ {">",0}, + /* T_HEXINTEGER */ {(const char*)0,0}, + /* T_OCTINTEGER */ {(const char*)0,0}, + /* T_IDENTIFIER */ {(const char*)0,0}, + /* T_IDIV */ {"\\",0}, + /* T_IDN */ {"idn",0}, + /* T_IF */ {"if",1}, + /* T_IMAGE */ {"image",1}, + /* T_IMP */ {"imp",0}, + /* T_INC */ {"inc",1}, + /* T_INPUT */ {"input",1}, + /* T_INTEGER */ {(const char*)0,0}, + /* T_INV */ {"inv",0}, + /* T_IS */ {"is",1}, + /* T_JUNK */ {(const char*)0,0}, + /* T_KILL */ {"kill",1}, + /* T_LE */ {"<=",0}, + /* T_LET */ {"let",1}, + /* T_LINEINPUT */ {"line input",1}, + /* T_LIST */ {"list",1}, + /* T_LLIST */ {"llist",1}, + /* T_LOAD */ {"load",1}, + /* T_LOCAL */ {"local",1}, + /* T_LOCATE */ {"locate",1}, + /* T_LOCK */ {"lock",1}, + /* T_LOCK_READ */ {"lock read",1}, + /* T_LOCK_WRITE */ {"lock write",1}, + /* T_LOOP */ {"loop",1}, + /* T_LOOPUNTIL */ {"loop until",1}, + /* T_LPRINT */ {"lprint",1}, + /* T_LSET */ {"lset",1}, + /* T_LT */ {"<",0}, + /* T_MAT */ {"mat",1}, + /* T_MATINPUT */ {"mat input",1}, + /* T_MATPRINT */ {"mat print",1}, + /* T_MATREAD */ {"mat read",1}, + /* T_MATREDIM */ {"mat redim",1}, + /* T_MATWRITE */ {"mat write",1}, + /* T_MINUS */ {"-",0}, + /* T_MKDIR */ {"mkdir",1}, + /* T_MOD */ {"mod",0}, + /* T_MULT */ {"*",0}, + /* T_NAME */ {"name",1}, + /* T_NE */ {"<>",0}, + /* T_NEW */ {"new",1}, + /* T_NEXT */ {"next",1}, + /* T_NOT */ {"not",0}, + /* T_ON */ {"on",1}, + /* T_ONERROR */ {"on error",1}, + /* T_ONERRORGOTO0 */ {"on error goto 0",1}, + /* T_ONERROROFF */ {"on error off",1}, + /* T_OP */ {"(",0}, + /* T_OPEN */ {"open",1}, + /* T_OPTIONBASE */ {"option base",1}, + /* T_OPTIONRUN */ {"option run",1}, + /* T_OPTIONSTOP */ {"option stop",1}, + /* T_OR */ {"or",1}, + /* T_OUT */ {"out",1}, + /* T_PLUS */ {"+",0}, + /* T_POKE */ {"poke",1}, + /* T_POW */ {"^",0}, + /* T_PRINT */ {"print",1}, + /* T_PUT */ {"put",1}, + /* T_QUOTE */ {(const char*)0,1}, + /* T_RANDOMIZE */ {"randomize",1}, + /* T_READ */ {"read",1}, + /* T_REAL */ {(const char*)0,0}, + /* T_REM */ {(const char*)0,1}, + /* T_RENAME */ {"rename",1}, + /* T_RENUM */ {"renum",1}, + /* T_REPEAT */ {"repeat",1}, + /* T_RESTORE */ {"restore",1}, + /* T_RESUME */ {"resume",1}, + /* T_RETURN */ {"return",1}, + /* T_RSET */ {"rset",1}, + /* T_RUN */ {"run",1}, + /* T_SAVE */ {"save",1}, + /* T_SELECTCASE */ {"select case",1}, + /* T_SEMICOLON */ {";",0}, + /* T_SHARED */ {"shared",1}, + /* T_SHELL */ {"shell",1}, + /* T_SLEEP */ {"sleep",1}, + /* T_SPC */ {"spc",0}, + /* T_STEP */ {"step",1}, + /* T_STOP */ {"stop",1}, + /* T_STRING */ {(const char*)0,0}, + /* T_SUB */ {"sub",1}, + /* T_SUBEND */ {"subend",1}, + /* T_SUBEXIT */ {"subexit",1}, + /* T_SWAP */ {"swap",1}, + /* T_SYSTEM */ {"system",1}, + /* T_TAB */ {"tab",0}, + /* T_THEN */ {"then",1}, + /* T_TO */ {"to",1}, + /* T_TRN */ {"trn",0}, + /* T_TROFF */ {"troff",1}, + /* T_TRON */ {"tron",1}, + /* T_TRUNCATE */ {"truncate",1}, + /* T_UNLOCK */ {"unlock",1}, + /* T_UNNUM */ {"unnum",1}, + /* T_UNNUMBERED */ {"",0}, + /* T_UNTIL */ {"until",1}, + /* T_USING */ {"using",0}, + /* T_WAIT */ {"wait",1}, + /* T_WEND */ {"wend",1}, + /* T_WHILE */ {"while",1}, + /* T_WIDTH */ {"width",1}, + /* T_WRITE */ {"write",1}, + /* T_XOR */ {"xor",0}, + /* T_XREF */ {"xref",0}, + /* T_ZER */ {"zer",0}, + /* T_ZONE */ {"zone",1}, + }; + + /* precompute indentation */ /*{{{*/ + if (indent) thisindent=nextindent=*indent; + t=token; + do + { + switch (t->type) + { + case T_CASEELSE: + case T_CASEVALUE: + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + break; + } + case T_DEFFN: + case T_FUNCTION: + { + struct Token *cp; + + for (cp=t; cp->type!=T_EOL && cp->type!=T_CP; ++cp); + if ((cp+1)->type!=T_EQ) + { + ++thisnotindent; + ++nextindent; + } + infn=1; + break; + } + case T_COLON: infn=0; break; + case T_DEFPROC: + case T_DO: + case T_DOUNTIL: + case T_DOWHILE: + case T_REPEAT: + case T_SUB: + case T_WHILE: ++thisnotindent; ++nextindent; break; + case T_FOR: + { + if ((t>token && ((t-1)->type==T_COLON || (t-1)->type==T_INTEGER || (t-1)->type==T_UNNUMBERED))) + { + ++thisnotindent; ++nextindent; + } + break; + } + case T_SELECTCASE: thisnotindent+=2; nextindent+=2; break; + case T_EQ: + { + if (infn || (t>token && ((t-1)->type==T_COLON || (t-1)->type==T_INTEGER || (t-1)->type==T_UNNUMBERED))) + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + if (nextindent) --nextindent; + } + infn=0; + break; + } + case T_ENDFN: + case T_FNEND: + case T_ENDIF: + case T_ENDPROC: + case T_SUBEND: + case T_LOOP: + case T_LOOPUNTIL: + case T_UNTIL: + case T_WEND: + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + if (nextindent) --nextindent; + break; + } + case T_ENDSELECT: + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + if (nextindent) --nextindent; + if (nextindent) --nextindent; + break; + } + case T_NEXT: + { + ++t; + while (1) + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + if (nextindent) --nextindent; + if (t->type==T_IDENTIFIER) + { + ++t; + if (t->type==T_OP) + { + int par=0; + + do + { + if (t->type==T_OP) ++par; + else if (t->type==T_CP) --par; + if (t->type!=T_EOL) ++t; + else break; + } while (par); + } + if (t->type==T_COMMA) ++t; + else break; + } + else break; + } + break; + } + case T_THEN: if ((t+1)->type==T_EOL) { ++thisnotindent; ++nextindent; } break; + case T_ELSE: + { + if (t==token+1) + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + } + break; + } + case T_ELSEIFELSE: + { + if (t==token+1) + { + if (thisnotindent) --thisnotindent; else if (thisindent) --thisindent; + } + if (nextindent) --nextindent; + break; + } + default: break; + } + } while (t++->type!=T_EOL); + /*}}}*/ + if (width>=0) /* whole line */ + { + if (width) /* nicely formatted listing */ + { + assert (token->type==T_UNNUMBERED || token->type==T_INTEGER); + if (token->type==T_INTEGER) String_appendPrintf(s,"%*ld ",width,token->u.integer); + else String_appendPrintf(s,"%*s ",width,""); + } + else assert (token->type==T_UNNUMBERED); + ++token; + } + while (thisindent--) String_appendPrintf(s," "); + do + { + if (s->length>oldlength && token->type!=T_EOL) + { + const char *keyword; + + if ((keyword=table[token->type].text)==(const char*)0) keyword="X"; + if (ns && s->character[s->length-1]!=' ') + { + String_appendPrintf(s," "); + } + else if (isalnum((int)(s->character[s->length-1])) && isalnum((int)*keyword)) + { + String_appendPrintf(s," "); + } + else if (s->character[s->length-1]!=' ' && table[token->type].space) + { + String_appendChar(s,' '); + } + } + if (spaceto && token==spaceto) break; + switch (token->type) + { + case T_DATAINPUT: String_appendChars(s,token->u.datainput); break; + case T_ELSEIFIF: break; + case T_IDENTIFIER: String_appendChars(s,token->u.identifier->name); break; + case T_INTEGER: String_appendPrintf(s,"%ld",token->u.integer); break; + case T_HEXINTEGER: String_appendPrintf(s,"&h%lx",token->u.hexinteger); break; + case T_OCTINTEGER: String_appendPrintf(s,"&o%lo",token->u.octinteger); break; + case T_JUNK: String_appendChar(s,token->u.junk); break; + case T_REAL: + { + String_appendPrintf(s,"%.*g",DBL_DIG,token->u.real); + if ((token->u.real<((double)LONG_MIN)) || (token->u.real>((double)LONG_MAX))) String_appendChar(s,'!'); + break; + } + case T_REM: String_appendPrintf(s,"%s%s",uppercase?"REM":"rem",token->u.rem); break; + case T_QUOTE: String_appendPrintf(s,"'%s",token->u.rem); break; + case T_STRING: /*{{{*/ + { + size_t l=token->u.string->length; + char *data=token->u.string->character; + + String_appendPrintf(s,"\""); + while (l--) + { + if (*data=='"') String_appendPrintf(s,"\""); + String_appendPrintf(s,"%c",*data); + ++data; + } + String_appendPrintf(s,"\""); + break; + } + /*}}}*/ + default: + { + if (uppercase) + { + struct String u; + + String_new(&u); + String_appendChars(&u,table[token->type].text); + String_ucase(&u); + String_appendString(s,&u); + String_destroy(&u); + } + else String_appendChars(s,table[token->type].text); + } + } + ns=table[token->type].space; + } while (token++->type!=T_EOL); + if (indent) *indent=nextindent; + if (spaceto && s->length>oldlength) memset(s->character+oldlength,' ',s->length-oldlength); + return s; +} +/*}}}*/ +void Token_init(int b_c, int uc) /*{{{*/ +{ +#define PROPERTY(t,assoc,unary_priority,binary_priority,is_unary,is_binary) \ + Token_property[t]=(assoc<<8)|(unary_priority<<5)|(binary_priority<<2)|(is_unary<<1)|is_binary + + backslash_colon=b_c; + uppercase=uc; + PROPERTY(T_POW, 1,0,7,0,1); + PROPERTY(T_MULT, 0,0,5,0,1); + PROPERTY(T_DIV, 0,0,5,0,1); + PROPERTY(T_IDIV, 0,0,5,0,1); + PROPERTY(T_MOD, 0,0,5,0,1); + PROPERTY(T_PLUS, 0,6,4,1,1); + PROPERTY(T_MINUS,0,6,4,1,1); + PROPERTY(T_LT, 0,0,3,0,1); + PROPERTY(T_LE, 0,0,3,0,1); + PROPERTY(T_EQ, 0,0,3,0,1); + PROPERTY(T_GE, 0,0,3,0,1); + PROPERTY(T_GT, 0,0,3,0,1); + PROPERTY(T_NE, 0,0,3,0,1); + PROPERTY(T_NOT, 0,2,0,1,0); + PROPERTY(T_AND, 0,0,1,0,1); + PROPERTY(T_OR, 0,0,0,0,1); + PROPERTY(T_XOR, 0,0,0,0,1); + PROPERTY(T_EQV, 0,0,0,0,1); + PROPERTY(T_IMP, 0,0,0,0,1); +} +/*}}}*/ diff --git a/apps/interpreters/bas/value.c b/apps/interpreters/bas/value.c new file mode 100644 index 000000000..6a5ab0b4d --- /dev/null +++ b/apps/interpreters/bas/value.c @@ -0,0 +1,1471 @@ +/* #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> +#include <errno.h> +#include <float.h> +#ifdef HAVE_GETTEXT +#include <libintl.h> +#define _(String) gettext(String) +#else +#define _(String) String +#endif +#include <limits.h> +#include <math.h> +/* Buggy on some systems */ +#if 0 +#ifdef HAVE_TGMATH_H +#include <tgmath.h> +#endif +#else +extern long int lrint(double x); +#endif +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "error.h" +#include "value.h" + +#ifdef USE_DMALLOC +#include "dmalloc.h" +#endif +/*}}}*/ + +/* variables */ /*{{{*/ +static const char *typestr[]= +{ + (const char*)0, + (const char*)0, + "integer", + (const char*)0, + "real", + "string", + "void" +}; + +/* for xgettext */ +#if 0 +_("integer") +_("real") +_("string") +_("void") +#endif +/*}}}*/ + +const enum ValueType Value_commonType[V_VOID+1][V_VOID+1]= +{ + { 0, 0, 0, 0, 0, 0, 0 }, + { 0, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR }, + { 0, V_ERROR, V_INTEGER, V_ERROR, V_REAL, V_ERROR, V_ERROR }, + { 0, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR }, + { 0, V_ERROR, V_REAL, V_ERROR, V_REAL, V_ERROR, V_ERROR }, + { 0, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_STRING, V_ERROR }, + { 0, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR, V_ERROR } +}; + +#ifndef HAVE_LRINT +long int lrint(double d) +{ + return d; +} +#endif + +static void format_double(struct String *buf, double value, int width, int precision, int exponent) /*{{{*/ +{ + if (exponent) + { + size_t len; + char *e; + int en; + + len=buf->length; + String_appendPrintf(buf,"%.*E",width-1-(precision>=0),value); + if (buf->character[len+1]=='.') String_delete(buf,len+1,1); + if (precision>=0) String_insertChar(buf,len+width-precision-1,'.'); + for (e=buf->character+buf->length-1; e>=buf->character && *e!='E'; --e); + ++e; + en=strtol(e,(char**)0,10); + en=en+2-(width-precision); + len=e-buf->character; + String_delete(buf,len,buf->length-len); + String_appendPrintf(buf,"%+0*d",exponent-1,en); + } + else if (precision>0) String_appendPrintf(buf,"%.*f",precision,value); + else if (precision==0) String_appendPrintf(buf,"%.f.",value); + else if (width) String_appendPrintf(buf,"%.f",value); + else + { + double x=value; + + if (x<0.0001 || x>=10000000.0) /* print scientific notation */ + { + String_appendPrintf(buf,"%.7g",value); + } + else /* print decimal numbers or integers, if possible */ + { + int o,n,p=6; + + while (x>=10.0 && p>0) { x/=10.0; --p; } + o=buf->length; + String_appendPrintf(buf,"%.*f",p,value); + n=buf->length; + if (memchr(buf->character+o,'.',n-o)) + { + while (buf->character[buf->length-1]=='0') --buf->length; + if (buf->character[buf->length-1]=='.') --buf->length; + } + } + } +} +/*}}}*/ + +double Value_trunc(double d) /*{{{*/ +{ + return (d<0.0?ceil(d):floor(d)); +} +/*}}}*/ +double Value_round(double d) /*{{{*/ +{ + return (d<0.0?ceil(d-0.5):floor(d+0.5)); +} +/*}}}*/ +long int Value_toi(double d, int *overflow) /*{{{*/ +{ + d=Value_round(d); + *overflow=(d<LONG_MIN || d>LONG_MAX); + return lrint(d); +} +/*}}}*/ +long int Value_vali(const char *s, char **end, int *overflow) /*{{{*/ +{ + long int n; + + errno=0; + if (*s=='&' && tolower(*(s+1))=='h') n=strtoul(s+2,end,16); + else if (*s=='&' && tolower(*(s+1))=='o') n=strtoul(s+2,end,8); + else n=strtol(s,end,10); + *overflow=(errno==ERANGE); + return n; +} +/*}}}*/ +double Value_vald(const char *s, char **end, int *overflow) /*{{{*/ +{ + double d; + + errno=0; + d=strtod(s,end); + *overflow=(errno==ERANGE); + return d; +} +/*}}}*/ + +struct Value *Value_new_NIL(struct Value *this) /*{{{*/ +{ + assert(this!=(struct Value*)0); + this->type=V_NIL; + return this; +} +/*}}}*/ +struct Value *Value_new_ERROR(struct Value *this, int code, const char *error, ...) /*{{{*/ +{ + va_list ap; + char buf[128]; + + assert(this!=(struct Value*)0); + va_start(ap,error); + vsprintf(buf,error,ap); + va_end(ap); + this->type=V_ERROR; + this->u.error.code=code; + this->u.error.msg=strcpy(malloc(strlen(buf)+1),buf); + return this; +} +/*}}}*/ +struct Value *Value_new_INTEGER(struct Value *this, int n) /*{{{*/ +{ + assert(this!=(struct Value*)0); + this->type=V_INTEGER; + this->u.integer=n; + return this; +} +/*}}}*/ +struct Value *Value_new_REAL(struct Value *this, double n) /*{{{*/ +{ + assert(this!=(struct Value*)0); + this->type=V_REAL; + this->u.real=n; + return this; +} +/*}}}*/ +struct Value *Value_new_STRING(struct Value *this) /*{{{*/ +{ + assert(this!=(struct Value*)0); + this->type=V_STRING; + String_new(&this->u.string); + return this; +} +/*}}}*/ +struct Value *Value_new_VOID(struct Value *this) /*{{{*/ +{ + assert(this!=(struct Value*)0); + this->type=V_VOID; + return this; +} +/*}}}*/ +struct Value *Value_new_null(struct Value *this, enum ValueType type) /*{{{*/ +{ + assert(this!=(struct Value*)0); + switch (type) + { + case V_INTEGER: + { + this->type=V_INTEGER; + this->u.integer=0; + break; + } + case V_REAL: + { + this->type=V_REAL; + this->u.real=0.0; + break; + } + case V_STRING: + { + this->type=V_STRING; + String_new(&this->u.string); + break; + } + case V_VOID: + { + this->type=V_VOID; + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +int Value_isNull(const struct Value *this) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: return (this->u.integer==0); + case V_REAL: return (this->u.real==0.0); + case V_STRING: return (this->u.string.length==0); + default: assert(0); + } + return -1; +} +/*}}}*/ +void Value_destroy(struct Value *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; +} +/*}}}*/ +struct Value *Value_clone(struct Value *this, const struct Value *original) /*{{{*/ +{ + assert(this!=(struct Value*)0); + assert(original!=(struct Value*)0); + switch (original->type) + { + case V_ERROR: + { + strcpy(this->u.error.msg=malloc(strlen(original->u.error.msg)+1),original->u.error.msg); + this->u.error.code=original->u.error.code; + break; + } + case V_INTEGER: this->u.integer=original->u.integer; break; + case V_NIL: break; + case V_REAL: this->u.real=original->u.real; break; + case V_STRING: String_clone(&this->u.string,&original->u.string); break; + default: assert(0); + } + this->type=original->type; + return this; +} +/*}}}*/ +struct Value *Value_uplus(struct Value *this, int calc) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: + case V_REAL: + { + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDUOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_uneg(struct Value *this, int calc) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: + { + if (calc) this->u.integer=-this->u.integer; + break; + } + case V_REAL: + { + if (calc) this->u.real=-this->u.real; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDUOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_unot(struct Value *this, int calc) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: + { + if (calc) this->u.integer=~this->u.integer; + break; + } + case V_REAL: + { + Value_retype(this,V_INTEGER); + if (calc) this->u.integer=~this->u.integer; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDUOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_add(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer+=x->u.integer; + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) this->u.real+=x->u.real; + break; + } + case V_STRING: + { + if (calc) String_appendString(&this->u.string,&x->u.string); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_sub(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer-=x->u.integer; + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) this->u.real-=x->u.real; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_mult(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer*=x->u.integer; + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) this->u.real*=x->u.real; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_div(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) + { + if (x->u.real==0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Division by zero"); + } + else this->u.real/=x->u.real; + } + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) + { + if (x->u.real==0.0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Division by zero"); + } + else this->u.real/=x->u.real; + } + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_idiv(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) + { + if (x->u.integer==0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Division by zero"); + } + else this->u.integer/=x->u.integer; + } + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) + { + if (x->u.real==0.0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Division by zero"); + } + else this->u.real=Value_trunc(this->u.real/x->u.real); + } + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_mod(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) + { + if (x->u.integer==0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Modulo by zero"); + } + else this->u.integer%=x->u.integer; + } + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) + { + if (x->u.real==0.0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"Modulo by zero"); + } + else this->u.real=fmod(this->u.real,x->u.real); + } + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_pow(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) + { + if (this->u.integer==0 && x->u.integer==0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"0^0"); + } + else if (x->u.integer>0) this->u.integer=pow(this->u.integer,x->u.integer); + else + { + long int thisi=this->u.integer; + Value_destroy(this); + Value_new_REAL(this,pow(thisi,x->u.integer)); + } + } + break; + } + case V_REAL: + { + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) + { + if (this->u.real==0.0 && x->u.real==0.0) + { + Value_destroy(this); + Value_new_ERROR(this,UNDEFINED,"0^0"); + } + else this->u.real=pow(this->u.real,x->u.real); + } + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_and(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + case V_REAL: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer&=x->u.integer; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_or(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + case V_REAL: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer|=x->u.integer; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_xor(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + case V_REAL: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer^=x->u.integer; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_eqv(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + case V_REAL: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=~(this->u.integer^x->u.integer); + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_imp(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + case V_REAL: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(~this->u.integer)|x->u.integer; + break; + } + case V_STRING: + { + Value_destroy(this); + Value_new_ERROR(this,INVALIDOPERAND); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_lt(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer<x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real<x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=(String_cmp(&this->u.string,&x->u.string)<0)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_le(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer<=x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real<=x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=(String_cmp(&this->u.string,&x->u.string)<=0)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_eq(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer==x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real==x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=(String_cmp(&this->u.string,&x->u.string)==0)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_ge(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer>=x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real>=x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=(String_cmp(&this->u.string,&x->u.string)>=0)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_gt(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer>x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real>x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=(String_cmp(&this->u.string,&x->u.string)>0)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +struct Value *Value_ne(struct Value *this, struct Value *x, int calc) /*{{{*/ +{ + switch (Value_commonType[this->type][x->type]) + { + case V_INTEGER: + { + VALUE_RETYPE(this,V_INTEGER); + VALUE_RETYPE(x,V_INTEGER); + if (calc) this->u.integer=(this->u.integer!=x->u.integer)?-1:0; + break; + } + case V_REAL: + { + int v; + + VALUE_RETYPE(this,V_REAL); + VALUE_RETYPE(x,V_REAL); + if (calc) v=(this->u.real!=x->u.real)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + case V_STRING: + { + int v; + + if (calc) v=String_cmp(&this->u.string,&x->u.string)?-1:0; + else v=0; + Value_destroy(this); + Value_new_INTEGER(this,v); + break; + } + default: assert(0); + } + return this; +} +/*}}}*/ +int Value_exitFor(struct Value *this, struct Value *limit, struct Value *step) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: return + ( + step->u.integer<0 + ? (this->u.integer<limit->u.integer) + : (this->u.integer>limit->u.integer) + ); + case V_REAL: return + ( + step->u.real<0.0 + ? (this->u.real<limit->u.real) + : (this->u.real>limit->u.real) + ); + case V_STRING: return (String_cmp(&this->u.string,&limit->u.string)>0); + default: assert(0); + } + return -1; +} +/*}}}*/ +void Value_errorPrefix(struct Value *this, const char *prefix) /*{{{*/ +{ + size_t prefixlen,msglen; + + assert(this->type==V_ERROR); + prefixlen=strlen(prefix); + msglen=strlen(this->u.error.msg); + this->u.error.msg=realloc(this->u.error.msg,prefixlen+msglen+1); + memmove(this->u.error.msg+prefixlen,this->u.error.msg,msglen); + memcpy(this->u.error.msg,prefix,prefixlen); +} +/*}}}*/ +void Value_errorSuffix(struct Value *this, const char *suffix) /*{{{*/ +{ + size_t suffixlen,msglen; + + assert(this->type==V_ERROR); + suffixlen=strlen(suffix); + msglen=strlen(this->u.error.msg); + this->u.error.msg=realloc(this->u.error.msg,suffixlen+msglen+1); + memcpy(this->u.error.msg+msglen,suffix,suffixlen+1); +} +/*}}}*/ +struct Value *Value_new_typeError(struct Value *this, enum ValueType t1, enum ValueType t2) /*{{{*/ +{ + assert(typestr[t1]); + assert(typestr[t2]); + return Value_new_ERROR(this,TYPEMISMATCH1,_(typestr[t1]),_(typestr[t2])); +} +/*}}}*/ +static void retypeError(struct Value *this, enum ValueType to) /*{{{*/ +{ + enum ValueType thisType=this->type; + + assert(typestr[thisType]); + assert(typestr[to]); + Value_destroy(this); + Value_new_ERROR(this,TYPEMISMATCH1,_(typestr[thisType]),_(typestr[to])); +} +/*}}}*/ +struct Value *Value_retype(struct Value *this, enum ValueType type) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: + { + switch (type) + { + case V_INTEGER: break; + case V_REAL: this->u.real=this->u.integer; this->type=type; break; + case V_VOID: Value_destroy(this); Value_new_VOID(this); break; + default: retypeError(this,type); break; + } + break; + } + case V_REAL: + { + int overflow; + + switch (type) + { + case V_INTEGER: + { + this->u.integer=Value_toi(this->u.real,&overflow); + this->type=V_INTEGER; + if (overflow) + { + Value_destroy(this); + Value_new_ERROR(this,OUTOFRANGE,typestr[V_INTEGER]); + } + break; + } + case V_REAL: break; + case V_VOID: Value_destroy(this); Value_new_VOID(this); break; + default: retypeError(this,type); break; + } + break; + } + case V_STRING: + { + switch (type) + { + case V_STRING: break; + case V_VOID: Value_destroy(this); Value_new_VOID(this); break; + default: retypeError(this,type); break; + } + break; + } + case V_VOID: + { + switch (type) + { + case V_VOID: break; + default: retypeError(this,type); + } + break; + } + case V_ERROR: break; + default: assert(0); + } + return this; +} +/*}}}*/ +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) /*{{{*/ +{ + size_t oldlength=s->length; + + switch (this->type) + { + case V_ERROR: String_appendChars(s,this->u.error.msg); break; + case V_REAL: + case V_INTEGER: + { + int sign; + struct String buf; + size_t totalwidth=width; + + String_new(&buf); + if (this->type==V_INTEGER) + { + if (this->u.integer<0) + { + sign=-1; + this->u.integer=-this->u.integer; + } + else if (this->u.integer==0) sign=0; + else sign=1; + } + else + { + if (this->u.real<0.0) + { + sign=-1; + this->u.real=-this->u.real; + } + else if (this->u.real==0.0) sign=0; + else sign=1; + } + switch (headingsign) + { + case -1: + { + ++totalwidth; + String_appendChar(&buf,sign==-1?'-':' '); + break; + } + case 0: + { + if (sign==-1) String_appendChar(&buf,'-'); + break; + } + case 1: + { + ++totalwidth; + String_appendChar(&buf,sign==-1?'-':'+'); + break; + } + case 2: break; + default: assert(0); + } + totalwidth+=exponent; + if (this->type==V_INTEGER) + { + if (precision>0 || exponent) format_double(&buf,(double)this->u.integer,width,precision,exponent); + else if (precision==0) String_appendPrintf(&buf,"%lu.",this->u.integer); + else String_appendPrintf(&buf,"%lu",this->u.integer); + } + else format_double(&buf,this->u.real,width,precision,exponent); + if (commas) + { + size_t digits; + int first; + + first=(headingsign?1:0); + for (digits=first; digits<buf.length && buf.character[digits]>='0' && buf.character[digits]<='9'; ++digits); + while (digits>first+3) + { + digits-=3; + String_insertChar(&buf,digits,','); + } + } + if (dollar) + { + String_insertChar(&buf,0,'$'); + } + if (trailingsign==-1) + { + ++totalwidth; + String_appendChar(&buf,sign==-1?'-':' '); + } + else if (trailingsign==1) + { + ++totalwidth; + String_appendChar(&buf,sign==-1?'-':'+'); + } + String_size(s,oldlength+(totalwidth>buf.length?totalwidth:buf.length)); + if (totalwidth>buf.length) memset(s->character+oldlength,pad,totalwidth-buf.length+dollarleft); + memcpy(s->character+oldlength+(totalwidth>buf.length?(totalwidth-buf.length):0)+dollarleft,buf.character+dollarleft,buf.length-dollarleft); + if (dollarleft) s->character[oldlength]='$'; + String_destroy(&buf); + break; + } + case V_STRING: + { + if (width>0) + { + size_t blanks=(this->u.string.length<width?(width-this->u.string.length):0); + + String_size(s,oldlength+width); + memcpy(s->character+oldlength,this->u.string.character,blanks?this->u.string.length:width); + if (blanks) memset(s->character+oldlength+this->u.string.length,' ',blanks); + } + else String_appendString(s,&this->u.string); + break; + } + default: assert(0); return 0; + } + return s; +} +/*}}}*/ +struct Value *Value_toStringUsing(struct Value *this, struct String *s, struct String *using, size_t *usingpos) /*{{{*/ +{ + char pad=' '; + int headingsign; + int width=0; + int commas=0; + int dollar=0; + int dollarleft=0; + int precision=-1; + int exponent=0; + int trailingsign=0; + + headingsign=(using->length ? 0 : -1); + if (*usingpos==using->length) *usingpos=0; + while (*usingpos<using->length) + { + switch (using->character[*usingpos]) + { + case '_': /* output next char */ /*{{{*/ + { + ++(*usingpos); + if (*usingpos<using->length) String_appendChar(s,using->character[(*usingpos)++]); + else + { + Value_destroy(this); + return Value_new_ERROR(this,MISSINGCHARACTER); + } + break; + } + /*}}}*/ + case '!': /* output first character of string */ /*{{{*/ + { + width=1; + ++(*usingpos); + goto work; + } + /*}}}*/ + case '\\': /* output n characters of string */ /*{{{*/ + { + width=1; + ++(*usingpos); + while (*usingpos<using->length && using->character[*usingpos]==' ') + { + ++(*usingpos); + ++width; + } + if (*usingpos<using->length && using->character[*usingpos]=='\\') + { + ++(*usingpos); + ++width; + goto work; + } + else + { + Value_destroy(this); + return Value_new_ERROR(this,IOERROR,_("unpaired \\ in format")); + } + break; + } + /*}}}*/ + case '&': /* output string */ /*{{{*/ + { + width=0; + ++(*usingpos); + goto work; + } + /*}}}*/ + case '*': + case '$': + case '0': + case '+': + case '#': + case '.': + { + if (using->character[*usingpos]=='+') + { + headingsign=1; + ++(*usingpos); + } + while (*usingpos<using->length && strchr("$#*0,",using->character[*usingpos])) + { + switch (using->character[*usingpos]) + { + case '$': if (width==0) dollarleft=1; if (++dollar>1) ++width; break; + case '*': pad='*'; ++width; break; + case '0': pad='0'; ++width; break; + case ',': commas=1; ++width; break; + default: ++width; + } + ++(*usingpos); + } + if (*usingpos<using->length && using->character[*usingpos]=='.' ) + { + ++(*usingpos); + ++width; + precision=0; + while (*usingpos<using->length && strchr("*#",using->character[*usingpos])) + { + ++(*usingpos); + ++precision; + ++width; + } + if (width==1 && precision==0) + { + Value_destroy(this); + return Value_new_ERROR(this,BADFORMAT); + } + } + if (*usingpos<using->length && using->character[*usingpos]=='-' ) + { + ++(*usingpos); + if (headingsign==0) headingsign=2; + trailingsign=-1; + } + else if (*usingpos<using->length && using->character[*usingpos]=='+') + { + ++(*usingpos); + if (headingsign==0) headingsign=2; + trailingsign=1; + } + while (*usingpos<using->length && using->character[*usingpos]=='^') + { + ++(*usingpos); + ++exponent; + } + goto work; + } + default: + { + String_appendChar(s,using->character[(*usingpos)++]); + } + } + } + work: + Value_toString(this,s,pad,headingsign,width,commas,dollar,dollarleft,precision,exponent,trailingsign); + if ((this->type==V_INTEGER || this->type==V_REAL) && width==0 && precision==-1) String_appendChar(s,' '); + while (*usingpos<using->length) + { + switch (using->character[*usingpos]) + { + case '_': /* output next char */ /*{{{*/ + { + ++(*usingpos); + if (*usingpos<using->length) String_appendChar(s,using->character[(*usingpos)++]); + else + { + Value_destroy(this); + return Value_new_ERROR(this,MISSINGCHARACTER); + } + break; + } + /*}}}*/ + case '!': + case '\\': + case '&': + case '*': + case '0': + case '+': + case '#': + case '.': return this; + default: + { + String_appendChar(s,using->character[(*usingpos)++]); + } + } + } + return this; +} +/*}}}*/ +struct String *Value_toWrite(struct Value *this, struct String *s) /*{{{*/ +{ + switch (this->type) + { + case V_INTEGER: String_appendPrintf(s,"%ld",this->u.integer); break; + case V_REAL: + { + double x; + int p=DBL_DIG; + int n,o; + + x=(this->u.real<0.0 ? -this->u.real : this->u.real); + while (x>1.0 && p>0) { x/=10.0; --p; } + o=s->length; + String_appendPrintf(s,"%.*f",p,this->u.real); + n=s->length; + if (memchr(s->character+o,'.',n-o)) + { + while (s->character[s->length-1]=='0') --s->length; + if (s->character[s->length-1]=='.') --s->length; + } + break; + } + case V_STRING: /*{{{*/ + { + size_t l=this->u.string.length; + char *data=this->u.string.character; + + String_appendChar(s,'"'); + while (l--) + { + if (*data=='"') String_appendChar(s,'"'); + String_appendChar(s,*data); + ++data; + } + String_appendChar(s,'"'); + break; + } + /*}}}*/ + default: assert(0); + } + return s; +} +/*}}}*/ +struct Value *Value_nullValue(enum ValueType type) /*{{{*/ +{ + static struct Value integer={ V_INTEGER }; + static struct Value real={ V_REAL }; + static struct Value string={ V_STRING }; + static char n[]=""; + static int init=0; + + if (!init) + { + integer.u.integer=0; + real.u.real=0.0; + string.u.string.length=0; + string.u.string.character=n; + } + switch (type) + { + case V_INTEGER: return &integer; + case V_REAL: return ℜ + case V_STRING: return &string; + default: assert(0); + } + return (struct Value*)0; +} +/*}}}*/ diff --git a/apps/interpreters/bas/value.h b/apps/interpreters/bas/value.h new file mode 100644 index 000000000..dbcaaff2d --- /dev/null +++ b/apps/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 diff --git a/apps/interpreters/bas/var.c b/apps/interpreters/bas/var.c new file mode 100644 index 000000000..ce5c8673e --- /dev/null +++ b/apps/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; +} +/*}}}*/ diff --git a/apps/interpreters/bas/var.h b/apps/interpreters/bas/var.h new file mode 100644 index 000000000..41db98a85 --- /dev/null +++ b/apps/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 diff --git a/nuttx/include/termios.h b/nuttx/include/termios.h index c862f9db7..24cf15e9b 100644 --- a/nuttx/include/termios.h +++ b/nuttx/include/termios.h @@ -242,7 +242,8 @@ struct termios #ifdef __cplusplus #define EXTERN extern "C" -extern "C" { +extern "C" +{ #else #define EXTERN extern #endif @@ -254,7 +255,7 @@ extern "C" { * supported by simply defining them to be cfgetspeed(). */ -EXTERN speed_t cfgetspeed(FAR const struct termios *termiosp); +speed_t cfgetspeed(FAR const struct termios *termiosp); #define cfgetispeed(termiosp) cfgetspeed(termiosp) #define cfgetospeed(termiosp) cfgetspeed(termiosp) @@ -265,37 +266,41 @@ EXTERN speed_t cfgetspeed(FAR const struct termios *termiosp); * supported by simply defining them to be cfsetspeed(). */ -EXTERN int cfsetspeed(FAR struct termios *termiosp, speed_t speed); +int cfsetspeed(FAR struct termios *termiosp, speed_t speed); #define cfsetispeed(termiosp,speed) cfsetspeed(termiosp,speed) #define cfsetospeed(termiosp,speed) cfsetspeed(termiosp,speed) /* Wait for transmission of output */ -EXTERN int tcdrain(int fd); +int tcdrain(int fd); /* Suspend or restart the transmission or reception of data */ -EXTERN int tcflow(int fd, int action); +int tcflow(int fd, int action); /* Flush non-transmitted output data, non-read input data or both */ -EXTERN int tcflush(int fd, int cmd); +int tcflush(int fd, int cmd); /* Get the parameters associated with the terminal */ -EXTERN int tcgetattr(int fd, FAR struct termios *termiosp); +int tcgetattr(int fd, FAR struct termios *termiosp); /* Get process group ID for session leader for controlling terminal */ -EXTERN pid_t tcgetsid(int fd); +pid_t tcgetsid(int fd); /* Send a "break" for a specific duration */ -EXTERN int tcsendbreak(int fd, int duration); +int tcsendbreak(int fd, int duration); /* Set the parameters associated with the terminal */ -EXTERN int tcsetattr(int fd, int options, FAR const struct termios *termiosp); +int tcsetattr(int fd, int options, FAR const struct termios *termiosp); + +/* Verify if a file descript is a terminal i/o file */ + +int isatty(int fd); #undef EXTERN #ifdef __cplusplus diff --git a/nuttx/libc/termios/lib_isatty.c b/nuttx/libc/termios/lib_isatty.c new file mode 100644 index 000000000..cf8e58332 --- /dev/null +++ b/nuttx/libc/termios/lib_isatty.c @@ -0,0 +1,14 @@ +/* Added by Alan Carvalho de Assis + This code is from: + https://github.com/raggi/apue.2e/blob/master/termios/isatty.c + based on Advanced Programming in the UNIX Environment +*/ + +#include <termios.h> + +int isatty(int fd) +{ + struct termios ts; + return(tcgetattr(fd, &ts) != -1); /* true if no error (is a tty) */ +} + |