diff options
Diffstat (limited to 'apps')
95 files changed, 30958 insertions, 2 deletions
diff --git a/apps/examples/Kconfig b/apps/examples/Kconfig index 3c1639923..9b14a5bca 100644 --- a/apps/examples/Kconfig +++ b/apps/examples/Kconfig @@ -4,6 +4,7 @@ # source "$APPSDIR/examples/adc/Kconfig" +source "$APPSDIR/examples/bastest/Kconfig" source "$APPSDIR/examples/buttons/Kconfig" source "$APPSDIR/examples/can/Kconfig" source "$APPSDIR/examples/cc3000/Kconfig" diff --git a/apps/examples/Make.defs b/apps/examples/Make.defs index 8a09a1ee1..050eefef5 100644 --- a/apps/examples/Make.defs +++ b/apps/examples/Make.defs @@ -38,6 +38,10 @@ ifeq ($(CONFIG_EXAMPLES_ADC),y) CONFIGURED_APPS += examples/adc endif +ifeq ($(CONFIG_EXAMPLES_BASTEST),y) +CONFIGURED_APPS += examples/bastest +endif + ifeq ($(CONFIG_EXAMPLES_BUTTONS),y) CONFIGURED_APPS += examples/buttons endif diff --git a/apps/examples/Makefile b/apps/examples/Makefile index 815b410a3..b2e04be81 100644 --- a/apps/examples/Makefile +++ b/apps/examples/Makefile @@ -37,7 +37,7 @@ # Sub-directories -SUBDIRS = adc buttons can cc3000 cpuhog cxxtest dhcpd discover elf +SUBDIRS = adc bastest buttons can cc3000 cpuhog cxxtest dhcpd discover elf SUBDIRS += flash_test ftpc ftpd hello helloxx hidkbd igmp i2schar json SUBDIRS += keypadtest lcdrw mm modbus mount mtdpart mtdrwb netpkt nettest SUBDIRS += nrf24l01_term nsh null nx nxterm nxffs nxflat nxhello nximage diff --git a/apps/examples/README.txt b/apps/examples/README.txt index a1d754ae1..caac77e4a 100644 --- a/apps/examples/README.txt +++ b/apps/examples/README.txt @@ -48,6 +48,22 @@ examples/adc CONFIG_EXAMPLES_ADC_GROUPSIZE - The number of samples to read at once. Default: 4 +examples/bastest +^^^^^^^^^^^^^^^^ + This directory contains a small program that will mount a ROMFS file system + containing the BASIC test files extracted from the BAS 2.4 release. See + examples/bastest/README.txt for licensing and usage information. + + CONFIG_EXAMPLES_BASTEST_DEVMINOR - The minor device number of the ROMFS block + driver. For example, the N in /dev/ramN. Used for registering the RAM + block driver that will hold the ROMFS file system containing the BASIC + files to be tested. Default: 0 + + CONFIG_EXAMPLES_BASTEST_DEVPATH - The path to the ROMFS block driver device. This + must match EXAMPLES_BASTEST_DEVMINOR. Used for registering the RAM block driver + that will hold the ROMFS file system containing the BASIC files to be + tested. Default: "/dev/ram0" + examples/buttons ^^^^^^^^^^^^^^^^ diff --git a/apps/examples/bastest/.gitignore b/apps/examples/bastest/.gitignore new file mode 100644 index 000000000..af17d4c1b --- /dev/null +++ b/apps/examples/bastest/.gitignore @@ -0,0 +1,13 @@ +/Make.dep +/.depend +/.built +/romfs.img +/romfs.h +/*.asm +/*.obj +/*.rel +/*.lst +/*.sym +/*.adb +/*.lib +/*.src diff --git a/apps/examples/bastest/Kconfig b/apps/examples/bastest/Kconfig new file mode 100644 index 000000000..c12281d6d --- /dev/null +++ b/apps/examples/bastest/Kconfig @@ -0,0 +1,31 @@ +# +# For a description of the syntax of this configuration file, +# see misc/tools/kconfig-language.txt. +# + +config EXAMPLES_BASTEST + bool "Setup Test Files for BAS" + default n + depends on INTERPRETERS_BAS + ---help--- + Mount the ROMFS file system containing the BAS test files at /mnt/romfs. + +if EXAMPLES_BASTEST + +config EXAMPLES_BASTEST_DEVMINOR + int "ROMFS Minor Device Number" + default 0 + ---help--- + The minor device number of the ROMFS block. For example, the N in /dev/ramN. + Used for registering the RAM block driver that will hold the ROMFS file system + containing the BASIC files to be tested. Default: 0 + +config EXAMPLES_BASTEST_DEVPATH + string "ROMFS Device Path" + default "/dev/ram0" + ---help--- + The path to the ROMFS block driver device. This must match EXAMPLES_BASTEST_DEVMINOR. + Used for registering the RAM block driver that will hold the ROMFS file system + containing the BASIC files to be tested. Default: "/dev/ram0" + +endif diff --git a/apps/examples/bastest/Makefile b/apps/examples/bastest/Makefile new file mode 100644 index 000000000..f6f788570 --- /dev/null +++ b/apps/examples/bastest/Makefile @@ -0,0 +1,159 @@ +############################################################################ +# apps/examples/bastest/Makefile +# +# Copyright (C) 2014 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 test volume mounter + +APPNAME = bastest +PRIORITY = SCHED_PRIORITY_DEFAULT +STACKSIZE = 2048 + +# Hello, World! Example + +ASRCS = +CSRCS = +MAINSRC = bastest_main.c + +AOBJS = $(ASRCS:.S=$(OBJEXT)) +COBJS = $(CSRCS:.c=$(OBJEXT)) +MAINOBJ = $(MAINSRC:.c=$(OBJEXT)) + +SRCS = $(ASRCS) $(CSRCS) $(MAINSRC) +OBJS = $(AOBJS) $(COBJS) + +ifneq ($(CONFIG_BUILD_KERNEL),y) + OBJS += $(MAINOBJ) +endif + +ifeq ($(CONFIG_WINDOWS_NATIVE),y) + BIN = ..\..\libapps$(LIBEXT) +else +ifeq ($(WINTOOL),y) + BIN = ..\\..\\libapps$(LIBEXT) +else + BIN = ../../libapps$(LIBEXT) +endif +endif + +ifeq ($(WINTOOL),y) + INSTALL_DIR = "${shell cygpath -w $(BIN_DIR)}" +else + INSTALL_DIR = $(BIN_DIR) +endif + +BASTEST_DIR = $(APPDIR)$(DELIM)examples$(DELIM)bastest +TESTS_DIR = $(BASTEST_DIR)$(DELIM)tests +ROMFS_IMG = romfs.img +ROMFS_HDR = romfs.h + +PROGNAME = bastest$(EXEEXT) + +ROOTDEPPATH = --dep-path . + +# Common build + +VPATH = + +all: .built +.PHONY: clean depend distclean + +$(AOBJS): %$(OBJEXT): %.S + $(call ASSEMBLE, $<, $@) + +$(COBJS) $(MAINOBJ): %$(OBJEXT): %.c + $(call COMPILE, $<, $@) + +# Create the romfs.h header file from the tests/ directory + +$(ROMFS_IMG) : + $(Q) genromfs -f $@ -d $(TESTS_DIR) -V "BASTEST" + +$(ROMFS_HDR) : $(ROMFS_IMG) + $(Q) (xxd -i $(ROMFS_IMG) | sed -e "s/^unsigned/static const unsigned/g" >$@) + +# Add the BASTEST object to the archive + +.built: $(ROMFS_HDR) $(OBJS) + $(call ARCHIVE, $(BIN), $(OBJS)) + @touch .built + +# Link and install the program binary + +ifeq ($(CONFIG_BUILD_KERNEL),y) +$(BIN_DIR)$(DELIM)$(PROGNAME): $(OBJS) $(MAINOBJ) + @echo "LD: $(PROGNAME)" + $(Q) $(LD) $(LDELFFLAGS) $(LDLIBPATH) -o $(INSTALL_DIR)$(DELIM)$(PROGNAME) $(ARCHCRT0OBJ) $(MAINOBJ) $(LDLIBS) + $(Q) $(NM) -u $(INSTALL_DIR)$(DELIM)$(PROGNAME) + +install: $(BIN_DIR)$(DELIM)$(PROGNAME) + +else +install: + +endif + +# Register the NSH builtin application + +ifeq ($(CONFIG_NSH_BUILTIN_APPS),y) +$(BUILTIN_REGISTRY)$(DELIM)$(APPNAME)_main.bdat: $(DEPCONFIG) Makefile + $(call REGISTER,$(APPNAME),$(PRIORITY),$(STACKSIZE),$(APPNAME)_main) + +context: $(BUILTIN_REGISTRY)$(DELIM)$(APPNAME)_main.bdat +else +context: +endif + +# Housekeeping stuff + +.depend: Makefile $(SRCS) + @$(MKDEP) $(ROOTDEPPATH) "$(CC)" -- $(CFLAGS) -- $(SRCS) >Make.dep + @touch $@ + +depend: .depend + +clean: + $(call DELFILE, .built) + $(call CLEAN) + +distclean: clean + $(call DELFILE, $(ROMFS_HDR)) + $(call DELFILE, $(ROMFS_IMG)) + $(call DELFILE, Make.dep) + $(call DELFILE, .depend) + +-include Make.dep diff --git a/apps/examples/bastest/README.txt b/apps/examples/bastest/README.txt new file mode 100644 index 000000000..846fad0e0 --- /dev/null +++ b/apps/examples/bastest/README.txt @@ -0,0 +1,1628 @@ +README +====== + + This directory contains a small program that will mount a ROMFS file system + containing the BASIC test files extracted from the BAS 2.4 release. + +Background +========== + 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. + +License +======= + BAS 2.4 is released as part of NuttX under the standard 3-clause BSD license + use by all components of NuttX. This is not incompatible with the original + BAS 2.4 licensing + + 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. + +TEST OVERVIEW +============= + +test01.bas +========== +Scalar variable assignment + +Test File +--------- +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 + +Expected Result +--------------- + 1 +hello + 0.0002 + 2e-06 + 2e-07 + +test02.bas +========== +Array variable assignment + +Test File +--------- +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 + +Expected Result +--------------- + 10 + 11 + 12 + +test03.bas +========== +FOR loops + +Test File +--------- + 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 + +Expected Result +--------------- + 0 + 1 + 2 + 3 + 4 + 5 + 0 + 1 + 0 + +a +aa +aaa +aaaa +aaaaa +aaaaaa +aaaaaaa +aaaaaaaa +aaaaaaaaa +aaaaaaaaaa + +test04.bas +========== +REPEAT UNTIL loop + +Test File +--------- +10 a=1 +20 repeat +30 print a +40 a=a+1 +50 until a=10 + +Expected Result +--------------- + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + +test05.bas +========== +GOSUB RETURN subroutines + +Test File +--------- +10 gosub 100 +20 gosub 100 +30 end +100 gosub 200 +110 gosub 200 +120 return +200 print "hello, world":return + +Expected Result +--------------- +hello, world +hello, world +hello, world +hello, world + +test06.bas +========== +Recursive function without arguments + +Test File +--------- +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 + +Expected Result +--------------- + 10 + 9 + 8 + 7 + 6 + 5 + 4 + 3 + 2 + 1 + 0 + +test07.bas +========== +Recursive function with arguments + +Test File +--------- +10 def fna(x) +20 if x=0 then r=1 else r=x*fna(x-1) +30 =r +40 print fna(7) + +Expected Result +--------------- + 5040 + +test08.bas +========== +DATA, READ and RESTORE + +Test File +--------- +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 + +Expected Result +--------------- +j=a +j=c k=d +Error: end of `data' in line 80 at: +80 read j$,k$ + ^ + +test09.bas +========== +LOCAL variables + +Test File +--------- +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 + +Expected Result +--------------- + 3 + 5 + 3 + +test10.bas +========== +PRINT USING + +Test File +--------- + 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" + +Expected Result +--------------- +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 + +test11.bas +========== +OPEN and LINE INPUT + +Test File +--------- +10 open "i",1,"test.bas" +20 while not eof(1) +30 line input #1,a$ +40 print a$ +50 wend + +Expected Result +--------------- +10 open "i",1,"test.bas" +20 while not eof(1) +30 line input #1,a$ +40 print a$ +50 wend + +test12.bas +========== +Exception handling + +Test File +--------- +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 + +Expected Result +--------------- +global handler 1 caught error in line 20 +local handler caught error in line 60 +global handler 2 caught error in line 90 + +test01.bas +========== +Unnumbered lines + +Test File +--------- +print "a" +goto 20 +print "b" +20 print "c" + +Expected Result +--------------- +a +c + +test14.bas +========== +SELECT CASE + +Test File +--------- + 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 + +Expected Result +--------------- + 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 + +test15.bas +========== +FIELD, PUT and GET + +Test File +--------- +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" + +Expected Result +--------------- +before field a$=a +a$=hi ya +after close a$= +after get b$=hi ya + +test16.bas +========== +SWAP + +Test File +--------- +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) + +Expected Result +--------------- +a= 1 b= 2 +a= 2 b= 1 +a$(1,0)=ab$(0,1)=b +a$(1,0)=bb$(0,1)=a + +test17.bas +========== +DO, EXIT DO, LOOP + +Test File +--------- +print "loop started" +i=1 +do + print "i is";i + i=i+1 + if i>10 then exit do +loop +print "loop ended" + +Expected Result +--------------- +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 + +test18.bas +========== +DO WHILE, LOOP + +Test File +--------- +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" + +Expected Result +--------------- +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 + +test19.bas +========== +ELSEIF + +Test File +--------- +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 + +Expected Result +--------------- +1a +2a +3a +1b +2b +3b + +test20.bas +========== +Caller trace + +Test File +--------- + 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 + +Expected Result +--------------- +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 + ^ + +test21.bas +========== +Matrix assignment + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test22.bas +========== +MAT PRINT + +Test File +--------- +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 + +Expected Result +--------------- + 11.00 21.00 + 12.00 22.00 + 11.00 12.00 + 21.00 22.00 + + 11.00 12.00 + 21.00 22.00 + +test23.bas +========== +Matrix addition and subtraction + +Test File +--------- +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$ + +Expected Result +--------------- + 0 0 + 0 2.5 + 0 0 + 0 -0.5 + +hi + +hihi + +test24.bas +========== +Matrix multiplication + +Test File +--------- +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 + +Expected Result +--------------- + 1 2 3 + 3 2 1 + + 1 2 + 2 1 + 3 3 + + 14 13 + 10 11 + +test25.bas +========== +Matrix scalar multiplication + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test26.bas +========== +MAT READ + +Test File +--------- +dim a(3,3) +data 5,5,5,8,8,8,3,3 +mat read a(2,3) +mat print a + +Expected Result +--------------- + 5 5 5 + 8 8 8 + +test27.bas +========== +Matrix inversion + +Test File +--------- +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 + +Expected Result +--------------- + 1 2 + 3 4 +-2 1 + 1.5 -0.5 + 1 0 + 0 1 + +test28.bas +========== +TDL BASIC FNRETURN/FNEND + +Test File +--------- +def fnfac(n) + if n=1 then fnreturn 1 +fnend n*fnfac(n-1) + +print fnfac(10) + +Expected Result +--------------- + 3628800 + +test29.bas +========== +TDL INSTR + +Test File +--------- +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?" + +Expected Result +--------------- + 4 = 4? + 0 = 0? + 3 = 3? + 8 = 8? + 0 = 0? + 8 = 8? + +test30.bas +========== +Type mismatch check + +Test File +--------- +print 1+"a" + +Expected Result +--------------- +Error: Invalid binary operand at: end of program + +test31.bas +========== +PRINT default format + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test032.bas +========== +SUB routines + +Test File +--------- +PUTS("abc") +END + +SUB PUTS(s$) + FOR i=1 to LEN(s$) : print mid$(s$,i,1); : NEXT + PRINT +END SUB + +Expected Result +--------------- +abc + +test33.bas +========== +OPEN FOR BINARY + +Test File +--------- +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" + +Expected Result +--------------- +xyz! + 0.333333 + 9999 + +test34.bas +========== +OPTION BASE + +Test File +--------- +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) + +Expected Result +--------------- + 1 + 2 + 1 + 2 + 10 + 20 + +test35.bas +========== +Real to integer conversion + +Test File +--------- +a%=1.2 +print a% +a%=1.7 +print a% +a%=-0.2 +print a% +a%=-0.7 +print a% + +Expected Result +--------------- + 1 + 2 + 0 +-1 + +test36.bas +========== +OPEN file locking + +Test File +--------- +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" + +Expected Result +--------------- +opening file +open succeeded +opening file +open failed + +test37.bas +========== +LINE INPUT reaching EOF + +Test File +--------- +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 + +Result +------ + Output should match test.ref + +test38.bas +========== +MAT REDIM + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test39.bas +========== +Nested function and procedure calls + +Test File +--------- +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) + +Expected Result +--------------- + 6 + +test40.bas +========== +IMAGE + +Test File +--------- + d=3.1 + print using "#.#";d + print using 10;d +10 image #.## + +Expected Result +--------------- +3.1 +3.10 + +test41.bas +========== +EXIT FUNCTION + +Test File +--------- +function f(c) +print "f running" +if (c) then f=42 : exit function +f=43 +end function + +print f(0) +print f(1) + +Expected Result +--------------- +f running + 43 +f running + 42 + +test42.bas +========== +Arithmetic + +Test File +--------- +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) + +Expected Result +--------------- + 1 +-2 +-3 + 2 +-2 + 2 +-0.3 + 0.3 + +test43.bas +========== +Matrix multiplication size checks + +Test File +--------- +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 + +Expected Result +--------------- + 17 + 47 + 77 +Error: Dimension mismatch in line 14 at: +mat c=a*b + ^ + +test44.bas +========== +DELETE + +Test File +--------- +10 print 10 +20 print 20 +30 print 30 +40 print 40 +50 print 50 +60 print 60 +70 print 70 + +Usage +----- +load "test.bas" +delete -20 +delete 60- +delete 30-40 +delete 15 +list + +Expected Result +--------------- +Error: No such line at: 15 +50 print 50 + +test45.bas +========== +MID$ on left side + +Test File +--------- +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$ + +Expected Result +--------------- + +01234ABCD9 +01234ABCD9 + +test46.bas +========== +END used without program + +Test File +--------- +for i=1 to 10:print i;:next i:end + +Expected Result +--------------- + 1 2 3 4 5 6 7 8 9 10 + +test47.bas +========== +MAT WRITE + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test48.bas +========== +Multi assignment + +Test File +--------- +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$ + +Expected Result +--------------- + 10 10 + 2 0 2 +test test + +test49.bas +========== +Matrix determinant + +Test File +--------- +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 + +Expected Result +--------------- + 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 + +test50.bas +========== +Min and max function + +Test File +--------- +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) + +Expected Result +--------------- + 1 + 1 +-0.3 +-0.3 + 2 + 2 + 0.3 + 4 + +test51.bas +========== +Print items + +Test File +--------- +PRINT "Line 1";TAB(78);1.23456789 + +Expected Result +--------------- +Line 1 + 1.234568 + +test52.bas +========== +MAT INPUT + +Test File +--------- +dim a(2,2) +mat input a +mat print a +mat input a +mat print a + +Test File +--------- +1,2,3,4,5 +1 +3,4 + +Expected Result +--------------- +? + 1 2 + 3 4 +? ? + 1 0 + 3 4 diff --git a/apps/examples/bastest/bastest_main.c b/apps/examples/bastest/bastest_main.c new file mode 100644 index 000000000..fe6da27f8 --- /dev/null +++ b/apps/examples/bastest/bastest_main.c @@ -0,0 +1,128 @@ +/**************************************************************************** + * examples/bastest/bastest_main.c + * + * Copyright (C) 2014 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <sys/mount.h> +#include <stdio.h> +#include <errno.h> + +#include <nuttx/fs/ramdisk.h> + +#include "romfs.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ +/* Check configuration. This is not all of the configuration settings that + * are required -- only the more obvious. + */ + +#if CONFIG_NFILE_DESCRIPTORS < 1 +# error "You must provide file descriptors via CONFIG_NFILE_DESCRIPTORS in your configuration file" +#endif + +#ifndef CONFIG_FS_ROMFS +# error "You must select CONFIG_FS_ROMFS in your configuration file" +#endif + +#ifdef CONFIG_DISABLE_MOUNTPOINT +# error "You must not disable mountpoints via CONFIG_DISABLE_MOUNTPOINT in your configuration file" +#endif + +/* Describe the ROMFS file system */ + +#define SECTORSIZE 512 +#define NSECTORS(b) (((b)+SECTORSIZE-1)/SECTORSIZE) +#define MOUNTPT "/mnt/romfs" + +#ifndef CONFIG_EXAMPLES_BASTEST_DEVMINOR +# define CONFIG_EXAMPLES_BASTEST_DEVMINOR 0 +#endif + +#ifndef CONFIG_EXAMPLES_BASTEST_DEVPATH +# define CONFIG_EXAMPLES_BASTEST_DEVPATH "/dev/ram0" +#endif + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +/**************************************************************************** + * bastest_main + ****************************************************************************/ + +#ifdef CONFIG_BUILD_KERNEL +int main(int argc, FAR char *argv[]) +#else +int bastest_main(int argc, char *argv[]) +#endif +{ + int ret; + + /* Create a ROM disk for the ROMFS filesystem */ + + printf("Registering romdisk at /dev/ram%d\n", CONFIG_EXAMPLES_BASTEST_DEVMINOR); + ret = romdisk_register(CONFIG_EXAMPLES_BASTEST_DEVMINOR, (FAR uint8_t *)romfs_img, + NSECTORS(romfs_img_len), SECTORSIZE); + if (ret < 0) + { + fprintf(stderr, "ERROR: romdisk_register failed: %d\n", ret); + return 1; + } + + /* Mount the file system */ + + printf("Mounting ROMFS filesystem at target=%s with source=%s\n", + MOUNTPT, CONFIG_EXAMPLES_BASTEST_DEVPATH); + + ret = mount(CONFIG_EXAMPLES_BASTEST_DEVPATH, MOUNTPT, "romfs", MS_RDONLY, NULL); + if (ret < 0) + { + fprintf(stderr, "ERROR: mount(%s,%s,romfs) failed: %s\n", + CONFIG_EXAMPLES_BASTEST_DEVPATH, MOUNTPT, errno); + return 1; + } + + return 0; +} diff --git a/apps/examples/bastest/tests/test01.bas b/apps/examples/bastest/tests/test01.bas new file mode 100644 index 000000000..d2c3494e0 --- /dev/null +++ b/apps/examples/bastest/tests/test01.bas @@ -0,0 +1,10 @@ +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 diff --git a/apps/examples/bastest/tests/test02.bas b/apps/examples/bastest/tests/test02.bas new file mode 100644 index 000000000..cc8b50ebc --- /dev/null +++ b/apps/examples/bastest/tests/test02.bas @@ -0,0 +1,8 @@ +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 + diff --git a/apps/examples/bastest/tests/test03.bas b/apps/examples/bastest/tests/test03.bas new file mode 100644 index 000000000..5d991d330 --- /dev/null +++ b/apps/examples/bastest/tests/test03.bas @@ -0,0 +1,16 @@ + 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 diff --git a/apps/examples/bastest/tests/test04.bas b/apps/examples/bastest/tests/test04.bas new file mode 100644 index 000000000..f2755e5a9 --- /dev/null +++ b/apps/examples/bastest/tests/test04.bas @@ -0,0 +1,6 @@ +10 a=1 +20 repeat +30 print a +40 a=a+1 +50 until a=10 + diff --git a/apps/examples/bastest/tests/test05.bas b/apps/examples/bastest/tests/test05.bas new file mode 100644 index 000000000..49100a00e --- /dev/null +++ b/apps/examples/bastest/tests/test05.bas @@ -0,0 +1,8 @@ +10 gosub 100 +20 gosub 100 +30 end +100 gosub 200 +110 gosub 200 +120 return +200 print "hello, world":return + diff --git a/apps/examples/bastest/tests/test06.bas b/apps/examples/bastest/tests/test06.bas new file mode 100644 index 000000000..ddd6efe78 --- /dev/null +++ b/apps/examples/bastest/tests/test06.bas @@ -0,0 +1,12 @@ +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 + diff --git a/apps/examples/bastest/tests/test07.bas b/apps/examples/bastest/tests/test07.bas new file mode 100644 index 000000000..12c0cbdc7 --- /dev/null +++ b/apps/examples/bastest/tests/test07.bas @@ -0,0 +1,5 @@ +10 def fna(x) +20 if x=0 then r=1 else r=x*fna(x-1) +30 =r +40 print fna(7) + diff --git a/apps/examples/bastest/tests/test08.bas b/apps/examples/bastest/tests/test08.bas new file mode 100644 index 000000000..0e6f13ad6 --- /dev/null +++ b/apps/examples/bastest/tests/test08.bas @@ -0,0 +1,10 @@ +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 + diff --git a/apps/examples/bastest/tests/test09.bas b/apps/examples/bastest/tests/test09.bas new file mode 100644 index 000000000..7d5f72735 --- /dev/null +++ b/apps/examples/bastest/tests/test09.bas @@ -0,0 +1,9 @@ +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 + diff --git a/apps/examples/bastest/tests/test10.bas b/apps/examples/bastest/tests/test10.bas new file mode 100644 index 000000000..41a935cca --- /dev/null +++ b/apps/examples/bastest/tests/test10.bas @@ -0,0 +1,31 @@ + 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" + diff --git a/apps/examples/bastest/tests/test11.bas b/apps/examples/bastest/tests/test11.bas new file mode 100644 index 000000000..78eb6d1c6 --- /dev/null +++ b/apps/examples/bastest/tests/test11.bas @@ -0,0 +1,6 @@ +10 open "i",1,"test.bas" +20 while not eof(1) +30 line input #1,a$ +40 print a$ +50 wend + diff --git a/apps/examples/bastest/tests/test12.bas b/apps/examples/bastest/tests/test12.bas new file mode 100644 index 000000000..ecbb9d138 --- /dev/null +++ b/apps/examples/bastest/tests/test12.bas @@ -0,0 +1,10 @@ +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 + diff --git a/apps/examples/bastest/tests/test13.bas b/apps/examples/bastest/tests/test13.bas new file mode 100644 index 000000000..e3be7a00b --- /dev/null +++ b/apps/examples/bastest/tests/test13.bas @@ -0,0 +1,4 @@ +print "a" +goto 20 +print "b" +20 print "c" diff --git a/apps/examples/bastest/tests/test14.bas b/apps/examples/bastest/tests/test14.bas new file mode 100644 index 000000000..56040112a --- /dev/null +++ b/apps/examples/bastest/tests/test14.bas @@ -0,0 +1,22 @@ + 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 + diff --git a/apps/examples/bastest/tests/test15.bas b/apps/examples/bastest/tests/test15.bas new file mode 100644 index 000000000..a9195bf4b --- /dev/null +++ b/apps/examples/bastest/tests/test15.bas @@ -0,0 +1,18 @@ +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" + diff --git a/apps/examples/bastest/tests/test16.bas b/apps/examples/bastest/tests/test16.bas new file mode 100644 index 000000000..809137d75 --- /dev/null +++ b/apps/examples/bastest/tests/test16.bas @@ -0,0 +1,10 @@ +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) + diff --git a/apps/examples/bastest/tests/test17.bas b/apps/examples/bastest/tests/test17.bas new file mode 100644 index 000000000..bfe0c9c2c --- /dev/null +++ b/apps/examples/bastest/tests/test17.bas @@ -0,0 +1,9 @@ +print "loop started" +i=1 +do + print "i is";i + i=i+1 + if i>10 then exit do +loop +print "loop ended" + diff --git a/apps/examples/bastest/tests/test18.bas b/apps/examples/bastest/tests/test18.bas new file mode 100644 index 000000000..73ab93e1b --- /dev/null +++ b/apps/examples/bastest/tests/test18.bas @@ -0,0 +1,13 @@ +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" + diff --git a/apps/examples/bastest/tests/test19.bas b/apps/examples/bastest/tests/test19.bas new file mode 100644 index 000000000..aa19fa4ae --- /dev/null +++ b/apps/examples/bastest/tests/test19.bas @@ -0,0 +1,20 @@ +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 + diff --git a/apps/examples/bastest/tests/test20.bas b/apps/examples/bastest/tests/test20.bas new file mode 100644 index 000000000..6b982bf89 --- /dev/null +++ b/apps/examples/bastest/tests/test20.bas @@ -0,0 +1,11 @@ + 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 + diff --git a/apps/examples/bastest/tests/test21.bas b/apps/examples/bastest/tests/test21.bas new file mode 100644 index 000000000..dd0f63beb --- /dev/null +++ b/apps/examples/bastest/tests/test21.bas @@ -0,0 +1,16 @@ +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 + diff --git a/apps/examples/bastest/tests/test22.bas b/apps/examples/bastest/tests/test22.bas new file mode 100644 index 000000000..e10b03a14 --- /dev/null +++ b/apps/examples/bastest/tests/test22.bas @@ -0,0 +1,14 @@ +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 + diff --git a/apps/examples/bastest/tests/test23.bas b/apps/examples/bastest/tests/test23.bas new file mode 100644 index 000000000..faf5c5593 --- /dev/null +++ b/apps/examples/bastest/tests/test23.bas @@ -0,0 +1,13 @@ +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$ + diff --git a/apps/examples/bastest/tests/test24.bas b/apps/examples/bastest/tests/test24.bas new file mode 100644 index 000000000..95678830b --- /dev/null +++ b/apps/examples/bastest/tests/test24.bas @@ -0,0 +1,8 @@ +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 + diff --git a/apps/examples/bastest/tests/test25.bas b/apps/examples/bastest/tests/test25.bas new file mode 100644 index 000000000..bf4d34c93 --- /dev/null +++ b/apps/examples/bastest/tests/test25.bas @@ -0,0 +1,14 @@ +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 + diff --git a/apps/examples/bastest/tests/test26.bas b/apps/examples/bastest/tests/test26.bas new file mode 100644 index 000000000..8055735a1 --- /dev/null +++ b/apps/examples/bastest/tests/test26.bas @@ -0,0 +1,5 @@ +dim a(3,3) +data 5,5,5,8,8,8,3,3 +mat read a(2,3) +mat print a + diff --git a/apps/examples/bastest/tests/test27.bas b/apps/examples/bastest/tests/test27.bas new file mode 100644 index 000000000..92ba744a8 --- /dev/null +++ b/apps/examples/bastest/tests/test27.bas @@ -0,0 +1,8 @@ +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 + diff --git a/apps/examples/bastest/tests/test28.bas b/apps/examples/bastest/tests/test28.bas new file mode 100644 index 000000000..d5185ca98 --- /dev/null +++ b/apps/examples/bastest/tests/test28.bas @@ -0,0 +1,6 @@ +def fnfac(n) + if n=1 then fnreturn 1 +fnend n*fnfac(n-1) + +print fnfac(10) + diff --git a/apps/examples/bastest/tests/test29.bas b/apps/examples/bastest/tests/test29.bas new file mode 100644 index 000000000..fbc20942c --- /dev/null +++ b/apps/examples/bastest/tests/test29.bas @@ -0,0 +1,7 @@ +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?" + diff --git a/apps/examples/bastest/tests/test30.bas b/apps/examples/bastest/tests/test30.bas new file mode 100644 index 000000000..06cea549a --- /dev/null +++ b/apps/examples/bastest/tests/test30.bas @@ -0,0 +1,2 @@ +print 1+"a" + diff --git a/apps/examples/bastest/tests/test31.bas b/apps/examples/bastest/tests/test31.bas new file mode 100644 index 000000000..d168bd072 --- /dev/null +++ b/apps/examples/bastest/tests/test31.bas @@ -0,0 +1,7 @@ +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 + diff --git a/apps/examples/bastest/tests/test32.bas b/apps/examples/bastest/tests/test32.bas new file mode 100644 index 000000000..43fdc4cf5 --- /dev/null +++ b/apps/examples/bastest/tests/test32.bas @@ -0,0 +1,8 @@ +PUTS("abc") +END + +SUB PUTS(s$) + FOR i=1 to LEN(s$) : print mid$(s$,i,1); : NEXT + PRINT +END SUB + diff --git a/apps/examples/bastest/tests/test33.bas b/apps/examples/bastest/tests/test33.bas new file mode 100644 index 000000000..2d64a4d05 --- /dev/null +++ b/apps/examples/bastest/tests/test33.bas @@ -0,0 +1,17 @@ +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" + diff --git a/apps/examples/bastest/tests/test34.bas b/apps/examples/bastest/tests/test34.bas new file mode 100644 index 000000000..2cd77b914 --- /dev/null +++ b/apps/examples/bastest/tests/test34.bas @@ -0,0 +1,18 @@ +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) + diff --git a/apps/examples/bastest/tests/test35.bas b/apps/examples/bastest/tests/test35.bas new file mode 100644 index 000000000..158f20719 --- /dev/null +++ b/apps/examples/bastest/tests/test35.bas @@ -0,0 +1,9 @@ +a%=1.2 +print a% +a%=1.7 +print a% +a%=-0.2 +print a% +a%=-0.7 +print a% + diff --git a/apps/examples/bastest/tests/test36.bas b/apps/examples/bastest/tests/test36.bas new file mode 100644 index 000000000..c7bd6f054 --- /dev/null +++ b/apps/examples/bastest/tests/test36.bas @@ -0,0 +1,8 @@ +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" + diff --git a/apps/examples/bastest/tests/test37.bas b/apps/examples/bastest/tests/test37.bas new file mode 100644 index 000000000..80f65a7de --- /dev/null +++ b/apps/examples/bastest/tests/test37.bas @@ -0,0 +1,6 @@ +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 + diff --git a/apps/examples/bastest/tests/test38.bas b/apps/examples/bastest/tests/test38.bas new file mode 100644 index 000000000..c1b151eee --- /dev/null +++ b/apps/examples/bastest/tests/test38.bas @@ -0,0 +1,9 @@ +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 + diff --git a/apps/examples/bastest/tests/test39.bas b/apps/examples/bastest/tests/test39.bas new file mode 100644 index 000000000..076c07be9 --- /dev/null +++ b/apps/examples/bastest/tests/test39.bas @@ -0,0 +1,12 @@ +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) + diff --git a/apps/examples/bastest/tests/test40.bas b/apps/examples/bastest/tests/test40.bas new file mode 100644 index 000000000..5ddc05009 --- /dev/null +++ b/apps/examples/bastest/tests/test40.bas @@ -0,0 +1,5 @@ + d=3.1 + print using "#.#";d + print using 10;d +10 image #.## + diff --git a/apps/examples/bastest/tests/test41.bas b/apps/examples/bastest/tests/test41.bas new file mode 100644 index 000000000..f307a866d --- /dev/null +++ b/apps/examples/bastest/tests/test41.bas @@ -0,0 +1,9 @@ +function f(c) +print "f running" +if (c) then f=42 : exit function +f=43 +end function + +print f(0) +print f(1) + diff --git a/apps/examples/bastest/tests/test42.bas b/apps/examples/bastest/tests/test42.bas new file mode 100644 index 000000000..5be79ac26 --- /dev/null +++ b/apps/examples/bastest/tests/test42.bas @@ -0,0 +1,9 @@ +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) + diff --git a/apps/examples/bastest/tests/test43.bas b/apps/examples/bastest/tests/test43.bas new file mode 100644 index 000000000..26ac0dd02 --- /dev/null +++ b/apps/examples/bastest/tests/test43.bas @@ -0,0 +1,16 @@ +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 + diff --git a/apps/examples/bastest/tests/test44.bas b/apps/examples/bastest/tests/test44.bas new file mode 100644 index 000000000..72cb37ccf --- /dev/null +++ b/apps/examples/bastest/tests/test44.bas @@ -0,0 +1,8 @@ +10 print 10 +20 print 20 +30 print 30 +40 print 40 +50 print 50 +60 print 60 +70 print 70 + diff --git a/apps/examples/bastest/tests/test45.bas b/apps/examples/bastest/tests/test45.bas new file mode 100644 index 000000000..cea534dda --- /dev/null +++ b/apps/examples/bastest/tests/test45.bas @@ -0,0 +1,9 @@ +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$ + diff --git a/apps/examples/bastest/tests/test46.bas b/apps/examples/bastest/tests/test46.bas new file mode 100644 index 000000000..f7a08468d --- /dev/null +++ b/apps/examples/bastest/tests/test46.bas @@ -0,0 +1,2 @@ +for i=1 to 10:print i;:next i:end + diff --git a/apps/examples/bastest/tests/test47.bas b/apps/examples/bastest/tests/test47.bas new file mode 100644 index 000000000..960ac46c5 --- /dev/null +++ b/apps/examples/bastest/tests/test47.bas @@ -0,0 +1,10 @@ +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 + diff --git a/apps/examples/bastest/tests/test48.bas b/apps/examples/bastest/tests/test48.bas new file mode 100644 index 000000000..223bc1c3e --- /dev/null +++ b/apps/examples/bastest/tests/test48.bas @@ -0,0 +1,8 @@ +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$ + diff --git a/apps/examples/bastest/tests/test49.bas b/apps/examples/bastest/tests/test49.bas new file mode 100644 index 000000000..d9b167af0 --- /dev/null +++ b/apps/examples/bastest/tests/test49.bas @@ -0,0 +1,16 @@ +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 + diff --git a/apps/examples/bastest/tests/test50.bas b/apps/examples/bastest/tests/test50.bas new file mode 100644 index 000000000..de12fbe87 --- /dev/null +++ b/apps/examples/bastest/tests/test50.bas @@ -0,0 +1,9 @@ +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) + diff --git a/apps/examples/bastest/tests/test51.bas b/apps/examples/bastest/tests/test51.bas new file mode 100644 index 000000000..503cb2693 --- /dev/null +++ b/apps/examples/bastest/tests/test51.bas @@ -0,0 +1,2 @@ +PRINT "Line 1";TAB(78);1.23456789 + diff --git a/apps/examples/bastest/tests/test52.bas b/apps/examples/bastest/tests/test52.bas new file mode 100644 index 000000000..4470bb5b2 --- /dev/null +++ b/apps/examples/bastest/tests/test52.bas @@ -0,0 +1,6 @@ +dim a(2,2) +mat input a +mat print a +mat input a +mat print a + 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/.gitignore b/apps/interpreters/bas/.gitignore new file mode 100644 index 000000000..b85c7dfc1 --- /dev/null +++ b/apps/interpreters/bas/.gitignore @@ -0,0 +1,8 @@ +.built +.depend +Make.dep +Make.srcs +ficl-* + + + diff --git a/apps/interpreters/bas/Kconfig b/apps/interpreters/bas/Kconfig new file mode 100644 index 000000000..27c67ac70 --- /dev/null +++ b/apps/interpreters/bas/Kconfig @@ -0,0 +1,76 @@ +# +# 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 + select SCHED_WAITPID + select LIBC_EXECFUNCS + select LIBC_FLOATINGPOINT + depends on FS_READABLE + ---help--- + This is a Basic interpreter written by Michael Haardt + + NOTE: This interpreter requires a usable math.h header file. By + default, the math library (and hence, math.h) are not provided by + NuttX. Therefore, when the Basic code includes math.h it will + either fail to find the math.h header file or, worse, will take an + incompatible version of math.h from your toolchain. The toolchain's + version of math.h will be incompatible because it will have been + implemented to work with a different version of the C library. + + Normally, developers will use an optimized math library for their + processor architecture and do the following: + + - Save a customized copy of math.h from your tool chain in + nuttx/arch/<arch>/include + - Set CONFIG_ARCH_MATH_H=y in your .config file to select this + architecture-specific math.h header file. + + An option is to use the built-in, generic, unoptimized NuttX math + library that is selected by simply by: + + - Set CONFIG_LIBM=y in your .config file + +if INTERPRETERS_BAS + +config INTERPRETER_BAS_VERSION + string "Version number" + default "2.4" + +config INTERPRETER_BAS_PRIORITY + int "Basic interpreter priority" + default 100 + ---help--- + Task priority of the Basic interpreter main task + +config INTERPRETER_BAS_STACKSIZE + int "Basic interpreter stack size" + default 4096 + ---help--- + Size of the stack allocated for the Basic interpreter main task + +config INTERPREPTER_BAS_VT100 + bool "VT100 terminal support" + default y + +config INTERPRETER_BAS_USE_LR0 + bool "LR0 parser" + default n + ---help--- + Select if you want LR0 parser. + +config INTERPRETER_BAS_USE_SELECT + bool "Use select()" + default n + +config INTERPRETER_BAS_HAVE_FTRUNCATE + bool + default n + ---help--- + NuttX does not currently support the ftruncate interface + + +endif diff --git a/apps/interpreters/bas/Makefile b/apps/interpreters/bas/Makefile new file mode 100644 index 000000000..819a69d0e --- /dev/null +++ b/apps/interpreters/bas/Makefile @@ -0,0 +1,122 @@ +############################################################################ +# apps/bas/Makefile +# +# Copyright (C) 2014 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 = auto.c bas.c fs.c global.c main.c program.c str.c token.c value.c +CSRCS += var.c + +ifeq ($(CONFIG_INTERPREPTER_BAS_VT100),y) +CSRCS += vt100.c +endif + +DEPPATH = --dep-path . +VPATH = . + +ifeq ($(WINTOOL),y) +INCDIROPT = -w +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 + +# BAS built-in application info + +CONFIG_INTERPRETER_BAS_PRIORITY ?= 100 +CONFIG_INTERPRETER_BAS_STACKSIZE ?= 4096 + +APPNAME = bas +PRIORITY = $(CONFIG_INTERPRETER_BAS_PRIORITY) +STACKSIZE = $(CONFIG_INTERPRETER_BAS_STACKSIZE) + +# Build targets + +all: .built +.PHONY: context .depend depend clean distclean + +$(AOBJS): %$(OBJEXT): %.S + $(call ASSEMBLE, $<, $@) + +$(COBJS): %$(OBJEXT): %.c + $(call COMPILE, $<, $@) + +.built: $(OBJS) + $(call ARCHIVE, $(BIN), $(OBJS)) + $(Q) touch .built + +install: + +ifeq ($(CONFIG_NSH_BUILTIN_APPS),y) +$(BUILTIN_REGISTRY)$(DELIM)$(APPNAME)_main.bdat: $(DEPCONFIG) Makefile + $(call REGISTER,$(APPNAME),$(PRIORITY),$(STACKSIZE),$(APPNAME)_main) + +context: $(BUILTIN_REGISTRY)$(DELIM)$(APPNAME)_main.bdat +else +context: +endif + +.depend: Makefile $(SRCS) + $(Q) $(MKDEP) $(DEPPATH) "$(CC)" -- $(CFLAGS) -- $(SRCS) >Make.dep + $(Q) touch $@ + +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/README.txt b/apps/interpreters/bas/README.txt new file mode 100644 index 000000000..d8435930e --- /dev/null +++ b/apps/interpreters/bas/README.txt @@ -0,0 +1,63 @@ +README +====== + +Introduction +============ + 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. + +License +======= + BAS 2.4 is released as part of NuttX under the standard 3-clause BSD license + use by all components of NuttX. This is not incompatible with the original + BAS 2.4 licensing + + 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. + +Bas 2.4 Release Notes +===================== + 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/auto.c b/apps/interpreters/bas/auto.c new file mode 100644 index 000000000..5a807bc93 --- /dev/null +++ b/apps/interpreters/bas/auto.c @@ -0,0 +1,375 @@ +/**************************************************************************** + * apps/interpreters/bas/auto.c + * BASIC file system interface. + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <assert.h> +#include <ctype.h> +#include <stdlib.h> +#include <string.h> + +#include "auto.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define INCREASE_STACK 16 +#define _(String) String + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +/* 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..841ea5380 --- /dev/null +++ b/apps/interpreters/bas/auto.h @@ -0,0 +1,133 @@ +/**************************************************************************** + * apps/interpreters/bas/auto.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_AUTO_H +#define __APPS_EXAMPLES_BAS_AUTO_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "programtypes.h" +#include "var.h" + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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" + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Auto *Auto_new(struct Auto *this); +void Auto_destroy(struct Auto *this); +struct Var *Auto_pushArg(struct Auto *this); +void Auto_pushFuncRet(struct Auto *this, int firstarg, struct Pc *pc); +void Auto_pushGosubRet(struct Auto *this, struct Pc *pc); +struct Var *Auto_local(struct Auto *this, int l); +int Auto_funcReturn(struct Auto *this, struct Pc *pc); +int Auto_gosubReturn(struct Auto *this, struct Pc *pc); +void Auto_frameToError(struct Auto *this, struct Program *program, struct Value *v); +void Auto_setError(struct Auto *this, long int line, struct Pc *pc, struct Value *v); + +int Auto_find(struct Auto *this, struct Identifier *ident); +int Auto_variable(struct Auto *this, const struct Identifier *ident); +enum ValueType Auto_argType(const struct Auto *this, int l); +enum ValueType Auto_varType(const struct Auto *this, struct Symbol *sym); +void Auto_funcEnd(struct Auto *this); + +#endif /* __APPS_EXAMPLES_BAS_AUTO_H */ diff --git a/apps/interpreters/bas/autotypes.h b/apps/interpreters/bas/autotypes.h new file mode 100644 index 000000000..ce736ca37 --- /dev/null +++ b/apps/interpreters/bas/autotypes.h @@ -0,0 +1,107 @@ +/**************************************************************************** + * apps/interpreters/bas/autotypes.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/* REVISIT: Why is this? If the following is __APPS_EXAMPLES_BAS_AUTOTYPES_H + * then there are compile errors! Those compile errors occur because this + * function defines some of the same structures as does auto.h. BUT, the + * definitions ARE NOT THE SAME. What is up with this? + */ + +#ifndef __APPS_EXAMPLES_BAS_AUTO_H +#define __APPS_EXAMPLES_BAS_AUTO_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "program.h" +#include "var.h" +#include "token.h" + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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 /* __APPS_EXAMPLES_BAS_AUTO_H */ diff --git a/apps/interpreters/bas/bas.c b/apps/interpreters/bas/bas.c new file mode 100644 index 000000000..fb7006a60 --- /dev/null +++ b/apps/interpreters/bas/bas.c @@ -0,0 +1,2479 @@ +/**************************************************************************** + * apps/interpreters/bas/bas.c + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/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> +#include <limits.h> +#include <math.h> +#include <string.h> +#include <stdlib.h> +#include <stdio.h> +#include <time.h> +#include <unistd.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" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define DIRECTMODE (pc.line== -1) +#define _(String) String + +/**************************************************************************** + * Private 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; + }; + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +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; + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +int bas_argc; +char *bas_argv0; +char **bas_argv; +int bas_end; + +/**************************************************************************** + * Private Function 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); + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +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 CONFIG_INTERPRETER_BAS_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) + { + 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; + 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; + 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; + + 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)); +} + +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 (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); +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd) +{ + 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 " CONFIG_INTERPRETER_BAS_VERSION "\n"); + 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; + + stopped = 0; + FS_nextline(STDCHANNEL); + if (FS_istty(STDCHANNEL)) + { + FS_putChars(STDCHANNEL, "> "); + } + + FS_flush(STDCHANNEL); + String_new(&s); + if (FS_appendToString(STDCHANNEL, &s, 1) == -1) + { + 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); + } + } +} + +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..970e949d6 --- /dev/null +++ b/apps/interpreters/bas/bas.h @@ -0,0 +1,88 @@ +/**************************************************************************** + * apps/interpreters/bas/fs.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_BAS_H +#define __APPS_EXAMPLES_BAS_BAS_H + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define STDCHANNEL 0 +#define LPCHANNEL 32 + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +extern int bas_argc; +extern char *bas_argv0; +extern char **bas_argv; +extern int bas_end; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd); +void bas_runFile(const char *runFile); +void bas_runLine(const char *runLine); +void bas_interpreter(void); +void bas_exit(void); + +#endif /* __APPS_EXAMPLES_BAS_BAS_H */ diff --git a/apps/interpreters/bas/error.h b/apps/interpreters/bas/error.h new file mode 100644 index 000000000..15af8da49 --- /dev/null +++ b/apps/interpreters/bas/error.h @@ -0,0 +1,188 @@ +/**************************************************************************** + * apps/interpreters/bas/error.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_ERROR_H +#define __APPS_EXAMPLES_BAS_ERROR_H + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +#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 /* __APPS_EXAMPLES_BAS_ERROR_H */ diff --git a/apps/interpreters/bas/fs.c b/apps/interpreters/bas/fs.c new file mode 100644 index 000000000..61730ee5e --- /dev/null +++ b/apps/interpreters/bas/fs.c @@ -0,0 +1,1868 @@ +/**************************************************************************** + * apps/interpreters/bas/fs.c + * BASIC file system interface. + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <sys/time.h> +#include <sys/types.h> + +#include <assert.h> +#include <errno.h> +#include <fcntl.h> +#include <math.h> +#include <signal.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <termios.h> +#include <time.h> +#include <unistd.h> + +#include "vt100.h" +#include "fs.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define LINEWIDTH 80 +#define COLWIDTH 14 + +#define _(String) String + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +static struct FileStream **file; +static int capacity; +static int used; +static const int open_mode[4] = { 0, O_RDONLY, O_WRONLY, O_RDWR }; + +const char *FS_errmsg; +static char FS_errmsgbuf[80]; + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +static int size(int dev) +{ + if (dev >= capacity) + { + int i; + struct FileStream **n; + + n = (struct FileStream **) + realloc(file, (dev + 1) * sizeof(struct FileStream *)); + if (n == (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 == '\b') + { + if (f->inCapacity) + { +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + /* Could use vt100_clrtoeol */ +#endif + /* Is the previous character in the buffer 2 character escape sequence? */ + + if (f->inBuf[f->inCapacity - 1] >= '\0' && + f->inBuf[f->inCapacity - 1] < ' ') + { + /* Yes.. erase two characters */ + + FS_putChars(chn, "\b\b \b\b"); + } + else + { + /* Yes.. erase one characters */ + + FS_putChars(chn, "\b \b"); + } + + --f->inCapacity; + } + } + else if ((f->inCapacity + 1) < sizeof(f->inBuf)) + { +#ifdef CONFIG_EOL_IS_BOTH_CRLF + /* Ignore carriage returns that may accompany a CRLF sequence. */ + + if (ch != '\r') +#endif + { + /* Is this a new line character */ + +#ifdef CONFIG_EOL_IS_CR + if (ch != '\r') +#elif defined(CONFIG_EOL_IS_LF) + if (ch != '\n') +#elif defined(CONFIG_EOL_IS_EITHER_CRLF) + if (ch != '\n' && ch != '\r' ) +#endif + { + /* No.. escape control characters other than newline and + * carriage return + */ + + if (ch >= '\0' && ch < ' ') + { + FS_putChar(chn, '^'); + FS_putChar(chn, ch ? (ch + 'a' - 1) : '@'); + } + + /* Output normal, printable characters */ + + else + { + FS_putChar(chn, ch); + } + } + + /* It is a newline */ + + else + { + /* Echo the newline (or not). We always use newline + * termination when talking to the host. + */ + + if (onl) + { + FS_putChar(chn, '\n'); + } + +#if defined(CONFIG_EOL_IS_CR) || defined(CONFIG_EOL_IS_EITHER_CRLF) + /* If the host is talking to us with CR line terminations, + * switch to use LF internally. + */ + + ch = '\n'; +#endif + } + + f->inBuf[f->inCapacity++] = ch; + } + } + } + while (ch != '\n'); + + return 0; +} + +static int cls(int chn) +{ +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + vt100_clrscreen(chn); + return 0; +#else + FS_errmsg = _("Clear screen operation not implemented"); + return -1; +#endif +} + +static int locate(int chn, int line, int column) +{ +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + vt100_setcursor(chn, line, column); + return 0; +#else + FS_errmsg = _("Set cursor position operation not implement"); + return -1; +#endif +} + +static int colour(int chn, int foreground, int background) +{ +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + /* REVISIT: Use VT100 commands to color */ +#warning Missing Logic +#endif + FS_errmsg = _("Set color operation no implemented"); + return -1; +} + +static int resetcolour(int chn) +{ +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + /* REVISIT: Use VT100 commands to reset color */ +#warning Missing Logic +#endif + return 0; +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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; +#ifdef CONFIG_SERIAL_TERMIOS + file[chn]->tty = (infd == 0 ? isatty(infd) && isatty(outfd) : 0); +#else + file[chn]->tty = 1; +#endif + 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. */ + + fd = open(name, fl | O_CREAT | (append ? 0 : O_TRUNC) | O_NONBLOCK, 0666); + if (fd == -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]->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; +} + +#ifdef CONFIG_SERIAL_TERMIOS +int FS_istty(int chn) +{ + return (file[chn] && file[chn]->tty); +} +#endif + +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) +{ +#ifdef CONFIG_INTERPRETER_BAS_HAVE_FTRUNCATE + 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, 0, SEEK_CUR)) == (off_t) - 1 || ftruncate(fd, o + 1) == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + + return 0; +#else + FS_errmsg = strerror(ENOSYS); + return -1; +#endif +} + +void FS_shellmode(int dev) +{ +} + +void FS_fsmode(int chn) +{ +} + +void FS_xonxoff(int chn, int on) +{ + /* Not implemented */ +} + +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) + { + f->outBuf[f->outSize++] = '\n'; + f->outPos = 0; + } + + 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 CONFIG_INTERPRETER_BAS_USE_SELECT + fd_set just_infd; + struct timeval timeout; +#endif + + if (opened(dev, 1) == -1) + { + return -1; + } + + f = file[dev]; + if (f->inSize < f->inCapacity) + { + return f->inBuf[f->inSize++]; + } + +#ifdef CONFIG_INTERPRETER_BAS_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 + FS_errmsg = (const char *)0; + len = read(f->infd, &c, 1); + + if (len == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + + return (len == 1 ? c : -1); +#endif +} + +void FS_sleep(double s) +{ + struct timespec p; + + p.tv_sec = floor(s); + p.tv_nsec = 1000000000 * (s - floor(s)); + + nanosleep(&p, (struct timespec *)0); +} + +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) +{ + off_t curpos; + off_t endpos; + 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); + + /* Get the size of the file */ + /* Save the current file position */ + + curpos = lseek(fd, 0, SEEK_CUR); + if (curpos == (off_t)-1) + { + FS_errmsg = strerror(errno); + return -1; + } + + /* Get the position at the end of the file */ + + endpos = lseek(fd, 0, SEEK_END); + if (endpos == (off_t)-1) + { + FS_errmsg = strerror(errno); + return -1; + } + + /* Restore the file position */ + + curpos = lseek(fd, curpos, SEEK_SET); + if (curpos == (off_t)-1) + { + FS_errmsg = strerror(errno); + return -1; + } + + return (long int)(endpos / 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; + } + + 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; +} diff --git a/apps/interpreters/bas/fs.h b/apps/interpreters/bas/fs.h new file mode 100644 index 000000000..ed4055908 --- /dev/null +++ b/apps/interpreters/bas/fs.h @@ -0,0 +1,197 @@ +/**************************************************************************** + * apps/interpreters/bas/fs.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_FS_H +#define __APPS_EXAMPLES_BAS_FS_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "str.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#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 + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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; +}; + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +extern const char *FS_errmsg; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +int FS_opendev(int dev, int infd, int outfd); +int FS_openin(const char *name); +int FS_openinChn(int chn, const char *name, int mode); +int FS_openout(const char *name); +int FS_openoutChn(int chn, const char *name, int mode, int append); +int FS_openrandomChn(int chn, const char *name, int mode, int recLength); +int FS_openbinaryChn(int chn, const char *name, int mode); +int FS_freechn(void); +int FS_flush(int dev); +int FS_close(int dev); + +#ifdef CONFIG_SERIAL_TERMIOS +int FS_istty(int chn); +#else +# define FS_istty(chn) (1) +#endif + +int FS_lock(int chn, off_t offset, off_t length, int mode, int w); +int FS_truncate(int chn); +void FS_shellmode(int chn); +void FS_fsmode(int chn); +void FS_xonxoff(int chn, int on); +int FS_put(int chn); +int FS_putChar(int dev, char ch); +int FS_putChars(int dev, const char *chars); +int FS_putString(int dev, const struct String *s); +int FS_putItem(int dev, const struct String *s); +int FS_putbinaryString(int chn, const struct String *s); +int FS_putbinaryInteger(int chn, long int x); +int FS_putbinaryReal(int chn, double x); +int FS_getbinaryString(int chn, struct String *s); +int FS_getbinaryInteger(int chn, long int *x); +int FS_getbinaryReal(int chn, double *x); +int FS_nextcol(int dev); +int FS_nextline(int dev); +int FS_tab(int dev, int position); +int FS_cls(int chn); +int FS_locate(int chn, int line, int column); +int FS_colour(int chn, int foreground, int background); +int FS_get(int chn); +int FS_getChar(int dev); +int FS_eof(int chn); +long int FS_loc(int chn); +long int FS_lof(int chn); +int FS_width(int dev, int width); +int FS_zone(int dev, int zone); +long int FS_recLength(int chn); +void FS_field(int chn, struct String *s, long int position, long int length); +int FS_appendToString(int dev, struct String *s, int onl); +int FS_inkeyChar(int dev, int ms); +void FS_sleep(double s); +int FS_seek(int chn, long int record); +void FS_closefiles(void); +int FS_charpos(int chn); +int FS_copy(const char *from, const char *to); +int FS_portInput(int address); +int FS_memInput(int address); +int FS_portOutput(int address, int value); +int FS_memOutput(int address, int value); + +#endif /* __APPS_EXAMPLES_BAS_FS_H */ diff --git a/apps/interpreters/bas/global.c b/apps/interpreters/bas/global.c new file mode 100644 index 000000000..f32b7159b --- /dev/null +++ b/apps/interpreters/bas/global.c @@ -0,0 +1,2469 @@ +/**************************************************************************** + * apps/interpreters/bas/global.c + * Global variables and functions. + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <assert.h> +#include <ctype.h> +#include <dirent.h> +#include <errno.h> +#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" + +#include <nuttx/clock.h> + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#ifndef M_PI +# define M_PI 3.14159265358979323846 +#endif + +#ifndef RAND_MAX +# define RAND_MAX 32767 +#endif + +#define _(String) String + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +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)(clock_systimer() / + (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] = (enum ValueType)va_arg(ap, int); + } + + va_end(ap); + s->u.sub.u.bltin.call = func; +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +struct Global *Global_new(struct Global *this) +{ + builtin(this, "abs", V_REAL, fn_abs, 1, (int)V_REAL); + builtin(this, "asc", V_INTEGER, fn_asc, 1, (int)V_STRING); + builtin(this, "atn", V_REAL, fn_atn, 1, (int)V_REAL); + builtin(this, "bin$", V_STRING, fn_bini, 1, (int)V_INTEGER); + builtin(this, "bin$", V_STRING, fn_bind, 1, (int)V_REAL); + builtin(this, "bin$", V_STRING, fn_binii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "bin$", V_STRING, fn_bindi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "bin$", V_STRING, fn_binid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "bin$", V_STRING, fn_bindd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "chr$", V_STRING, fn_chr, 1, (int)V_INTEGER); + builtin(this, "cint", V_REAL, fn_cint, 1, (int)V_REAL); + builtin(this, "code", V_INTEGER, fn_asc, 1, (int)V_STRING); + builtin(this, "command$", V_STRING, fn_command, 0); + builtin(this, "command$", V_STRING, fn_commandi, 1, (int)V_INTEGER); + builtin(this, "command$", V_STRING, fn_commandd, 1, (int)V_REAL); + builtin(this, "cos", V_REAL, fn_cos, 1, (int)V_REAL); + builtin(this, "cvi", V_INTEGER, fn_cvi, 1, (int)V_STRING); + builtin(this, "cvs", V_REAL, fn_cvs, 1, (int)V_STRING); + builtin(this, "cvd", V_REAL, fn_cvd, 1, (int)V_STRING); + builtin(this, "date$", V_STRING, fn_date, 0); + builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_REAL, (int)V_STRING); + builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_INTEGER, (int)V_STRING); + builtin(this, "dec$", V_STRING, fn_dec, 2, (int)V_STRING, (int)V_STRING); + builtin(this, "deg", V_REAL, fn_deg, 1, (int)V_REAL); + builtin(this, "det", V_REAL, fn_det, 0); + builtin(this, "edit$", V_STRING, fn_edit, 2, (int)V_STRING, (int)V_INTEGER); + builtin(this, "environ$", V_STRING, fn_environi, 1, (int)V_INTEGER); + builtin(this, "environ$", V_STRING, fn_environd, 1, (int)V_REAL); + builtin(this, "environ$", V_STRING, fn_environs, 1, (int)V_STRING); + builtin(this, "eof", V_INTEGER, fn_eof, 1, (int)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, (int)V_REAL); + builtin(this, "false", V_INTEGER, fn_false, 0); + builtin(this, "find$", V_STRING, fn_find, 1, (int)V_STRING); + builtin(this, "find$", V_STRING, fn_findi, 2, (int)V_STRING, (int)V_INTEGER); + builtin(this, "find$", V_STRING, fn_findd, 2, (int)V_STRING, (int)V_REAL); + builtin(this, "fix", V_REAL, fn_fix, 1, (int)V_REAL); + builtin(this, "frac", V_REAL, fn_frac, 1, (int)V_REAL); + builtin(this, "freefile", V_INTEGER, fn_freefile, 0); + builtin(this, "fp", V_REAL, fn_frac, 1, (int)V_REAL); + builtin(this, "hex$", V_STRING, fn_hexi, 1, (int)V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexd, 1, (int)V_REAL); + builtin(this, "hex$", V_STRING, fn_hexii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexdi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "hex$", V_STRING, fn_hexdd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkey, 0); + builtin(this, "inkey$", V_STRING, fn_inkeyi, 1, (int)V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeyd, 1, (int)V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkeyii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeyid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkeydi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeydd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "inp", V_INTEGER, fn_inp, 1, (int)V_INTEGER); + builtin(this, "input$", V_STRING, fn_input1, 1, (int)V_INTEGER); + builtin(this, "input$", V_STRING, fn_input2, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr2, 2, (int)V_STRING, (int)V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3iss, 3, (int)V_INTEGER, (int)V_STRING, + V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3ssi, 3, (int)V_STRING, (int)V_STRING, + V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr3dss, 3, (int)V_REAL, (int)V_STRING, + V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3ssd, 3, (int)V_STRING, (int)V_STRING, + V_REAL); + builtin(this, "instr", V_INTEGER, fn_instr4ii, 4, (int)V_STRING, (int)V_STRING, + (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr4id, 4, (int)V_STRING, (int)V_STRING, + (int)V_INTEGER, (int)V_REAL); + builtin(this, "instr", V_INTEGER, fn_instr4di, 4, (int)V_STRING, (int)V_STRING, + (int)V_REAL, (int)V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr4dd, 4, (int)V_STRING, (int)V_STRING, + (int)V_REAL, (int)V_REAL); + builtin(this, "int", V_REAL, fn_int, 1, (int)V_REAL); + builtin(this, "int%", V_INTEGER, fn_intp, 1, (int)V_REAL); + builtin(this, "ip", V_REAL, fn_fix, 1, (int)V_REAL); + builtin(this, "lcase$", V_STRING, fn_lcase, 1, (int)V_STRING); + builtin(this, "lower$", V_STRING, fn_lcase, 1, (int)V_STRING); + builtin(this, "left$", V_STRING, fn_left, 2, (int)V_STRING, (int)V_INTEGER); + builtin(this, "len", V_INTEGER, fn_len, 1, (int)V_STRING); + builtin(this, "loc", V_INTEGER, fn_loc, 1, (int)V_INTEGER); + builtin(this, "lof", V_INTEGER, fn_lof, 1, (int)V_INTEGER); + builtin(this, "log", V_REAL, fn_log, 1, (int)V_REAL); + builtin(this, "log10", V_REAL, fn_log10, 1, (int)V_REAL); + builtin(this, "log2", V_REAL, fn_log2, 1, (int)V_REAL); + builtin(this, "ltrim$", V_STRING, fn_ltrim, 1, (int)V_STRING); + builtin(this, "match", V_INTEGER, fn_match, 3, (int)V_STRING, (int)V_STRING, + (int)V_INTEGER); + builtin(this, "max", V_INTEGER, fn_maxii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "max", V_REAL, fn_maxdi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "max", V_REAL, fn_maxid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "max", V_REAL, fn_maxdd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "mid$", V_STRING, fn_mid2i, 2, (int)V_STRING, (int)V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid2d, 2, (int)V_STRING, (int)V_REAL); + builtin(this, "mid$", V_STRING, fn_mid3ii, 3, (int)V_STRING, (int)V_INTEGER, + V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid3id, 3, (int)V_STRING, (int)V_INTEGER, (int)V_REAL); + builtin(this, "mid$", V_STRING, fn_mid3di, 3, (int)V_STRING, (int)V_REAL, (int)V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid3dd, 3, (int)V_STRING, (int)V_REAL, (int)V_REAL); + builtin(this, "min", V_INTEGER, fn_minii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "min", V_REAL, fn_mindi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "min", V_REAL, fn_minid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "min", V_REAL, fn_mindd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "mki$", V_STRING, fn_mki, 1, (int)V_INTEGER); + builtin(this, "mks$", V_STRING, fn_mks, 1, (int)V_REAL); + builtin(this, "mkd$", V_STRING, fn_mkd, 1, (int)V_REAL); + builtin(this, "oct$", V_STRING, fn_oct, 1, (int)V_INTEGER); + builtin(this, "peek", V_INTEGER, fn_peek, 1, (int)V_INTEGER); + builtin(this, "pi", V_REAL, fn_pi, 0); + builtin(this, "pos", V_INTEGER, fn_pos, 1, (int)V_INTEGER); + builtin(this, "pos", V_INTEGER, fn_pos, 1, (int)V_REAL); + builtin(this, "pos", V_INTEGER, fn_instr3ssi, 3, (int)V_STRING, (int)V_STRING, + (int)V_INTEGER); + builtin(this, "pos", V_INTEGER, fn_instr3ssd, 3, (int)V_STRING, (int)V_STRING, + (int)V_REAL); + builtin(this, "rad", V_REAL, fn_rad, 1, (int)V_REAL); + builtin(this, "right$", V_STRING, fn_right, 2, (int)V_STRING, (int)V_INTEGER); + builtin(this, "rnd", V_INTEGER, fn_rnd, 0); + builtin(this, "rnd", V_INTEGER, fn_rndd, 1, (int)V_REAL); + builtin(this, "rnd", V_INTEGER, fn_rndi, 1, (int)V_INTEGER); + builtin(this, "rtrim$", V_STRING, fn_rtrim, 1, (int)V_STRING); + builtin(this, "seg$", V_STRING, fn_mid3ii, 3, (int)V_STRING, (int)V_INTEGER, + (int)V_INTEGER); + builtin(this, "seg$", V_STRING, fn_mid3id, 3, (int)V_STRING, (int)V_INTEGER, + (int)V_REAL); + builtin(this, "seg$", V_STRING, fn_mid3di, 3, (int)V_STRING, (int)V_REAL, + (int)V_INTEGER); + builtin(this, "seg$", V_STRING, fn_mid3dd, 3, (int)V_STRING, (int)V_REAL, + (int)V_REAL); + builtin(this, "sgn", V_INTEGER, fn_sgn, 1, (int)V_REAL); + builtin(this, "sin", V_REAL, fn_sin, 1, (int)V_REAL); + builtin(this, "space$", V_STRING, fn_space, 1, (int)V_INTEGER); + builtin(this, "sqr", V_REAL, fn_sqr, 1, (int)V_REAL); + builtin(this, "str$", V_STRING, fn_str, 1, (int)V_REAL); + builtin(this, "str$", V_STRING, fn_str, 1, (int)V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringii, 2, (int)V_INTEGER, (int)V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringid, 2, (int)V_INTEGER, (int)V_REAL); + builtin(this, "string$", V_STRING, fn_stringdi, 2, (int)V_REAL, (int)V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringdd, 2, (int)V_REAL, (int)V_REAL); + builtin(this, "string$", V_STRING, fn_stringis, 2, (int)V_INTEGER, (int)V_STRING); + builtin(this, "string$", V_STRING, fn_stringds, 2, (int)V_REAL, (int)V_STRING); + builtin(this, "strip$", V_STRING, fn_strip, 1, (int)V_STRING); + builtin(this, "tan", V_REAL, fn_tan, 1, (int)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, (int)V_STRING); + builtin(this, "true", V_INTEGER, fn_true, 0); + builtin(this, "ucase$", V_STRING, fn_ucase, 1, (int)V_STRING); + builtin(this, "upper$", V_STRING, fn_ucase, 1, (int)V_STRING); + builtin(this, "val", V_REAL, fn_val, 1, (int)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..bd91d4a02 --- /dev/null +++ b/apps/interpreters/bas/global.h @@ -0,0 +1,111 @@ +/**************************************************************************** + * apps/interpreters/bas/global.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_GLOBAL_H +#define __APPS_EXAMPLES_BAS_GLOBAL_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "token.h" +#include "value.h" +#include "var.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define GLOBAL_HASHSIZE 31 + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +struct GlobalFunctionChain +{ + struct Pc begin,end; + struct GlobalFunctionChain *next; +}; + +struct Global +{ + struct String command; + struct Symbol *table[GLOBAL_HASHSIZE]; + struct GlobalFunctionChain *chain; +}; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Global *Global_new(struct Global *this); +void Global_destroy(struct Global *this); +void Global_clear(struct Global *this); +void Global_clearFunctions(struct Global *this); +int Global_find(struct Global *this, struct Identifier *ident, int oparen); +int Global_function(struct Global *this, struct Identifier *ident, + enum ValueType type, struct Pc *deffn, struct Pc *begin, + int argTypesLength, enum ValueType *argTypes); +void Global_endfunction(struct Global *this, struct Identifier *ident, + struct Pc *end); +int Global_variable(struct Global *this, struct Identifier *ident, + enum ValueType type, enum SymbolType symbolType, + int redeclare); + +#endif /* __APPS_EXAMPLES_BAS_GLOBAL_H */ diff --git a/apps/interpreters/bas/main.c b/apps/interpreters/bas/main.c new file mode 100644 index 000000000..2cb9bc9c5 --- /dev/null +++ b/apps/interpreters/bas/main.c @@ -0,0 +1,196 @@ +/**************************************************************************** + * apps/interpreters/bas/main.c + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <unistd.h> +#include <errno.h> +#include <fcntl.h> +#include <stdio.h> +#include <string.h> +#include <stdlib.h> + +#include "bas.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +#ifdef CONFIG_BUILD_KERNEL +int main(int argc, FAR char *argv[]) +#else +int bas_main(int argc, char *argv[]) +#endif +{ + char *runFile = (char *)0; + const char *lp = "/dev/null"; + int usage = 0; + int o; + int backslash_colon = 0; + int uppercase = 0; + int restricted = 0; + int lpfd; + + /* parse arguments */ + + while ((o = getopt(argc, argv, ":bl:ruVh")) != 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", CONFIG_INTERPRETER_BAS_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 -h\n"), stderr); + fputs(_(" bas -V\n"), stderr); + fputs("\n", stderr); + fputs(_("Try `bas -h' for more information.\n"), stderr); + exit(1); + } + + if (usage == 2) + { + fputs(_("Usage: bas [-b] [-l file] [-u] [program [argument ...]]\n"), + stdout); + fputs(_(" bas -h\n"), stdout); + fputs(_(" bas -V\n"), stdout); + fputs("\n", stdout); + fputs(_("BASIC interpreter.\n"), stdout); + fputs("\n", stdout); + fputs(_("-b Convert backslashs to colons\n"), stdout); + fputs(_("-l Write LPRINT output to file\n"), stdout); + fputs(_("-r Forbid SHELL\n"), stdout); + fputs(_("-u Output all tokens in uppercase\n"), + stdout); + fputs(_("-h Display this help and exit\n"), stdout); + fputs(_("-V Ooutput version information and exit\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..893825d8d --- /dev/null +++ b/apps/interpreters/bas/program.c @@ -0,0 +1,1126 @@ +/**************************************************************************** + * apps/interpreters/bas/value.c + * Program storage. + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <assert.h> +#include <errno.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "auto.h" +#include "error.h" +#include "fs.h" +#include "program.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Private Types + ****************************************************************************/ + +/* 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; + }; + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +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); + } +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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; + } + } + + /* jump from local block must go to local block */ + + else + { + 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; + } + else + { + 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) + { + 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; + } +} + +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..b50ff0951 --- /dev/null +++ b/apps/interpreters/bas/program.h @@ -0,0 +1,114 @@ +/**************************************************************************** + * apps/interpreters/bas/program.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_PROGRAM_H +#define __APPS_EXAMPLES_BAS_PROGRAM_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "programtypes.h" +#include "token.h" + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Program *Program_new(struct Program *this); +void Program_destroy(struct Program *this); +void Program_norun(struct Program *this); +void Program_store(struct Program *this, struct Token *line, + long int where); +void Program_delete(struct Program *this, const struct Pc *from, + const struct Pc *to); +void Program_addScope(struct Program *this, struct Scope *scope); +struct Pc *Program_goLine(struct Program *this, long int line, + struct Pc *pc); +struct Pc *Program_fromLine(struct Program *this, long int line, + struct Pc *pc); +struct Pc *Program_toLine(struct Program *this, long int line, + struct Pc *pc); +int Program_scopeCheck(struct Program *this, struct Pc *pc, struct Pc *fn); +struct Pc *Program_dataLine(struct Program *this, long int line, + struct Pc *pc); +struct Pc *Program_imageLine(struct Program *this, long int line, + struct Pc *pc); +long int Program_lineNumber(const struct Program *this, + const struct Pc *pc); +struct Pc *Program_beginning(struct Program *this, struct Pc *pc); +struct Pc *Program_end(struct Program *this, struct Pc *pc); +struct Pc *Program_nextLine(struct Program *this, struct Pc *pc); +int Program_skipEOL(struct Program *this, struct Pc *pc, int dev, int tr); +void Program_trace(struct Program *this, struct Pc *pc, int dev, int tr); +void Program_PCtoError(struct Program *this, struct Pc *pc, + struct Value *v); +struct Value *Program_merge(struct Program *this, int dev, + struct Value *value); +int Program_lineNumberWidth(struct Program *this); +struct Value *Program_list(struct Program *this, int dev, int watchIntr, + struct Pc *from, struct Pc *to, + struct Value *value); +struct Value *Program_analyse(struct Program *this, struct Pc *pc, + struct Value *value); +void Program_renum(struct Program *this, int first, int inc); +void Program_unnum(struct Program *this); +int Program_setname(struct Program *this, const char *filename); +void Program_xref(struct Program *this, int chn); + +#endif /* __APPS_EXAMPLES_BAS_PROGRAM_H */ diff --git a/apps/interpreters/bas/programtypes.h b/apps/interpreters/bas/programtypes.h new file mode 100644 index 000000000..b5c1e9c1a --- /dev/null +++ b/apps/interpreters/bas/programtypes.h @@ -0,0 +1,99 @@ +/**************************************************************************** + * apps/interpreters/bas/programtypes.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_PROGRAMTYPES_H +#define __APPS_EXAMPLES_BAS_PROGRAMTYPES_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "str.h" + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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 /* __APPS_EXAMPLES_BAS_PROGRAMTYPES_H */ diff --git a/apps/interpreters/bas/statement.c b/apps/interpreters/bas/statement.c new file mode 100644 index 000000000..f7b2b7e17 --- /dev/null +++ b/apps/interpreters/bas/statement.c @@ -0,0 +1,6356 @@ +/**************************************************************************** + * apps/interpreters/bas/var.c + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <stdlib.h> + +#include "statement.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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) + { + const 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) +{ +#ifdef CONFIG_ARCH_HAVE_VFORK + long int line; + struct Pc statementpc = pc; + int status; + + ++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 = tmpnam(NULL)) == (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: + { + /* Wait for the editor to complete */ + + while (waitpid(pid, &status, 0) < 0 && errno != EINTR); + } + } + + 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; +#else + return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS)); +#endif +} + +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; + } + } + + 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) + { + const 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_xonxoff(STDCHANNEL, 0); + } + + return (struct Value *)0; +} + +struct Value *stmt_OPTIONSTOP(struct Value *value) +{ + ++pc.token; + if (pass == INTERPRET) + { + 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) +{ +#ifdef CONFIG_ARCH_HAVE_VFORK + 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: + { + /* Wait for the shell to complete */ + + while (waitpid(pid, &status, 0) < 0 && 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: + { + /* Wait for the shell to complete */ + + while (waitpid(pid, &status, 0) < 0 && errno != EINTR); + } + } + + FS_fsmode(STDCHANNEL); + } + } + + return (struct Value *)0; +#else + return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS)); +#endif +} + +struct Value *stmt_SLEEP(struct Value *value) +{ + double s; + + ++pc.token; + if (eval(value, _("pause"))->type == V_ERROR || + Value_retype(value, V_REAL)->type == V_ERROR) + { + return value; + } + + 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) + { + ++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..49512171e --- /dev/null +++ b/apps/interpreters/bas/statement.h @@ -0,0 +1,166 @@ +/**************************************************************************** + * apps/interpreters/bas/statement.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_STATEMENT_H +#define __APPS_EXAMPLES_BAS_STATEMENT_H + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Value *stmt_CALL(struct Value *value); +struct Value *stmt_CASE(struct Value *value); +struct Value *stmt_CHDIR_MKDIR(struct Value *value); +struct Value *stmt_CLEAR(struct Value *value); +struct Value *stmt_CLOSE(struct Value *value); +struct Value *stmt_CLS(struct Value *value); +struct Value *stmt_COLOR(struct Value *value); +struct Value *stmt_DATA(struct Value *value); +struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value); +struct Value *stmt_DEC_INC(struct Value *value); +struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value); +struct Value *stmt_DELETE(struct Value *value); +struct Value *stmt_DIM(struct Value *value); +struct Value *stmt_DISPLAY(struct Value *value); +struct Value *stmt_DO(struct Value *value); +struct Value *stmt_DOcondition(struct Value *value); +struct Value *stmt_EDIT(struct Value *value); +struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value); +struct Value *stmt_END(struct Value *value); +struct Value *stmt_ENDIF(struct Value *value); +struct Value *stmt_ENDFN(struct Value *value); +struct Value *stmt_ENDPROC_SUBEND(struct Value *value); +struct Value *stmt_ENDSELECT(struct Value *value); +struct Value *stmt_ENVIRON(struct Value *value); +struct Value *stmt_FNEXIT(struct Value *value); +struct Value *stmt_COLON_EOL(struct Value *value); +struct Value *stmt_QUOTE_REM(struct Value *value); +struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value); +struct Value *stmt_ERASE(struct Value *value); +struct Value *stmt_EXITDO(struct Value *value); +struct Value *stmt_EXITFOR(struct Value *value); +struct Value *stmt_FIELD(struct Value *value); +struct Value *stmt_FOR(struct Value *value); +struct Value *stmt_GET_PUT(struct Value *value); +struct Value *stmt_GOSUB(struct Value *value); +struct Value *stmt_RESUME_GOTO(struct Value *value); +struct Value *stmt_KILL(struct Value *value); +struct Value *stmt_LET(struct Value *value); +struct Value *stmt_LINEINPUT(struct Value *value); +struct Value *stmt_LIST_LLIST(struct Value *value); +struct Value *stmt_LOAD(struct Value *value); +struct Value *stmt_LOCAL(struct Value *value); +struct Value *stmt_LOCATE(struct Value *value); +struct Value *stmt_LOCK_UNLOCK(struct Value *value); +struct Value *stmt_LOOP(struct Value *value); +struct Value *stmt_LOOPUNTIL(struct Value *value); +struct Value *stmt_LSET_RSET(struct Value *value); +struct Value *stmt_IDENTIFIER(struct Value *value); +struct Value *stmt_IF_ELSEIFIF(struct Value *value); +struct Value *stmt_IMAGE(struct Value *value); +struct Value *stmt_INPUT(struct Value *value); +struct Value *stmt_MAT(struct Value *value); +struct Value *stmt_MATINPUT(struct Value *value); +struct Value *stmt_MATPRINT(struct Value *value); +struct Value *stmt_MATREAD(struct Value *value); +struct Value *stmt_MATREDIM(struct Value *value); +struct Value *stmt_MATWRITE(struct Value *value); +struct Value *stmt_NAME(struct Value *value); +struct Value *stmt_NEW(struct Value *value); +struct Value *stmt_NEXT(struct Value *value); +struct Value *stmt_ON(struct Value *value); +struct Value *stmt_ONERROR(struct Value *value); +struct Value *stmt_ONERRORGOTO0(struct Value *value); +struct Value *stmt_ONERROROFF(struct Value *value); +struct Value *stmt_OPEN(struct Value *value); +struct Value *stmt_OPTIONBASE(struct Value *value); +struct Value *stmt_OPTIONRUN(struct Value *value); +struct Value *stmt_OPTIONSTOP(struct Value *value); +struct Value *stmt_OUT_POKE(struct Value *value); +struct Value *stmt_PRINT_LPRINT(struct Value *value); +struct Value *stmt_RANDOMIZE(struct Value *value); +struct Value *stmt_READ(struct Value *value); +struct Value *stmt_COPY_RENAME(struct Value *value); +struct Value *stmt_RENUM(struct Value *value); +struct Value *stmt_REPEAT(struct Value *value); +struct Value *stmt_RESTORE(struct Value *value); +struct Value *stmt_RETURN(struct Value *value); +struct Value *stmt_RUN(struct Value *value); +struct Value *stmt_SAVE(struct Value *value); +struct Value *stmt_SELECTCASE(struct Value *value); +struct Value *stmt_SHELL(struct Value *value); +struct Value *stmt_SLEEP(struct Value *value); +struct Value *stmt_STOP(struct Value *value); +struct Value *stmt_SUBEXIT(struct Value *value); +struct Value *stmt_SWAP(struct Value *value); +struct Value *stmt_SYSTEM(struct Value *value); + +struct Value *stmt_TROFF(struct Value *value); +struct Value *stmt_TRON(struct Value *value); +struct Value *stmt_TRUNCATE(struct Value *value); +struct Value *stmt_UNNUM(struct Value *value); +struct Value *stmt_UNTIL(struct Value *value); +struct Value *stmt_WAIT(struct Value *value); +struct Value *stmt_WHILE(struct Value *value); +struct Value *stmt_WEND(struct Value *value); +struct Value *stmt_WIDTH(struct Value *value); +struct Value *stmt_WRITE(struct Value *value); +struct Value *stmt_XREF(struct Value *value); +struct Value *stmt_ZONE(struct Value *value); + +#endif /* __APPS_EXAMPLES_BAS_STATEMENT_H */ diff --git a/apps/interpreters/bas/str.c b/apps/interpreters/bas/str.c new file mode 100644 index 000000000..134cb0634 --- /dev/null +++ b/apps/interpreters/bas/str.c @@ -0,0 +1,457 @@ +/**************************************************************************** + * apps/interpreters/bas/value.c + * Dynamic strings. + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/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" + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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..9c706a27b --- /dev/null +++ b/apps/interpreters/bas/str.h @@ -0,0 +1,115 @@ +/**************************************************************************** + * apps/interpreters/bas/str.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_STR_H +#define __APPS_EXAMPLES_BAS_STR_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <sys/types.h> + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +struct String +{ + size_t length; + char *character; + struct StringField *field; +}; + +struct StringField +{ + struct String **refStrings; + int refCount; +}; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +int cistrcmp(const char *s, const char *r); + +struct String *String_new(struct String *this); +void String_destroy(struct String *this); +int String_joinField(struct String *this, struct StringField *field, + char *character, size_t length); +void String_leaveField(struct String *this); +struct String *String_clone(struct String *this, const struct String *clon); +int String_appendString(struct String *this, const struct String *app); +int String_appendChar(struct String *this, char ch); +int String_appendChars(struct String *this, const char *ch); +int String_appendPrintf(struct String *this, const char *fmt, ...); +int String_insertChar(struct String *this, size_t where, char ch); +int String_delete(struct String *this, size_t where, size_t len); +void String_ucase(struct String *this); +void String_lcase(struct String *this); +int String_size(struct String *this, size_t length); +int String_cmp(const struct String *this, const struct String *s); +void String_lset(struct String *this, const struct String *s); +void String_rset(struct String *this, const struct String *s); +void String_set(struct String *this, size_t pos, const struct String *s, + size_t length); + +struct StringField *StringField_new(struct StringField *this); +void StringField_destroy(struct StringField *this); + +#endif /* __APPS_EXAMPLES_BAS_STR_H */ diff --git a/apps/interpreters/bas/token.c b/apps/interpreters/bas/token.c new file mode 100644 index 000000000..b1cb0a54c --- /dev/null +++ b/apps/interpreters/bas/token.c @@ -0,0 +1,5387 @@ + +#line 3 "<stdout>" + +#define YY_INT_ALIGNED short int + +/* A lexical scanner generated by flex */ + +#define FLEX_SCANNER +#define YY_FLEX_MAJOR_VERSION 2 +#define YY_FLEX_MINOR_VERSION 5 +#define YY_FLEX_SUBMINOR_VERSION 39 +#if YY_FLEX_SUBMINOR_VERSION > 0 +#define FLEX_BETA +#endif + +/* First, we deal with platform-specific or compiler-specific issues. */ + +/* begin standard C headers. */ +#include <stdio.h> +#include <string.h> +#include <errno.h> +#include <stdlib.h> + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */ + +#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L + +/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, + * if you want the limit (max/min) macros for int types. + */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS 1 +#endif + +#include <inttypes.h> +typedef int8_t flex_int8_t; +typedef uint8_t flex_uint8_t; +typedef int16_t flex_int16_t; +typedef uint16_t flex_uint16_t; +typedef int32_t flex_int32_t; +typedef uint32_t flex_uint32_t; +#else +typedef signed char flex_int8_t; +typedef short int flex_int16_t; +typedef int flex_int32_t; +typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t; +typedef unsigned int flex_uint32_t; + +/* Limits of integral types. */ +#ifndef INT8_MIN +#define INT8_MIN (-128) +#endif +#ifndef INT16_MIN +#define INT16_MIN (-32767-1) +#endif +#ifndef INT32_MIN +#define INT32_MIN (-2147483647-1) +#endif +#ifndef INT8_MAX +#define INT8_MAX (127) +#endif +#ifndef INT16_MAX +#define INT16_MAX (32767) +#endif +#ifndef INT32_MAX +#define INT32_MAX (2147483647) +#endif +#ifndef UINT8_MAX +#define UINT8_MAX (255U) +#endif +#ifndef UINT16_MAX +#define UINT16_MAX (65535U) +#endif +#ifndef UINT32_MAX +#define UINT32_MAX (4294967295U) +#endif + +#endif /* ! C99 */ + +#endif /* ! FLEXINT_H */ + +#ifdef __cplusplus + +/* The "const" storage-class-modifier is valid. */ +#define YY_USE_CONST + +#else /* ! __cplusplus */ + +/* C99 requires __STDC__ to be defined as 1. */ +#if defined (__STDC__) + +#define YY_USE_CONST + +#endif /* defined (__STDC__) */ +#endif /* ! __cplusplus */ + +#ifdef YY_USE_CONST +#define yyconst const +#else +#define yyconst +#endif + +/* Returned upon end-of-file. */ +#define YY_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an unsigned + * integer for use as an array index. If the signed char is negative, + * we want to instead treat it as an 8-bit unsigned char, hence the + * double cast. + */ +#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c) + +/* Enter a start condition. This macro really ought to take a parameter, + * but we do it the disgusting crufty way forced on us by the ()-less + * definition of BEGIN. + */ +#define BEGIN (yy_start) = 1 + 2 * + +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The YYSTATE alias is for lex + * compatibility. + */ +#define YY_START (((yy_start) - 1) / 2) +#define YYSTATE YY_START + +/* Action number for EOF rule of a given start state. */ +#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) + +/* Special action meaning "start processing a new file". */ +#define YY_NEW_FILE yyrestart(yyin ) + +#define YY_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#ifndef YY_BUF_SIZE +#ifdef __ia64__ +/* On IA-64, the buffer size is 16k, not 8k. + * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. + * Ditto for the __ia64__ case accordingly. + */ +#define YY_BUF_SIZE 32768 +#else +#define YY_BUF_SIZE 16384 +#endif /* __ia64__ */ +#endif + +/* The state buf must be large enough to hold one state per character in the main buffer. + */ +#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) + +#ifndef YY_TYPEDEF_YY_BUFFER_STATE +#define YY_TYPEDEF_YY_BUFFER_STATE +typedef struct yy_buffer_state *YY_BUFFER_STATE; +#endif + +#ifndef YY_TYPEDEF_YY_SIZE_T +#define YY_TYPEDEF_YY_SIZE_T +typedef size_t yy_size_t; +#endif + +extern yy_size_t yyleng; + +extern FILE *yyin, *yyout; + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + + #define YY_LESS_LINENO(n) + #define YY_LINENO_REWIND_TO(ptr) + +/* Return all but the first "n" matched characters back to the input stream. */ +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + *yy_cp = (yy_hold_char); \ + YY_RESTORE_YY_MORE_OFFSET \ + (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ + YY_DO_BEFORE_ACTION; /* set up yytext again */ \ + } \ + while ( 0 ) + +#define unput(c) yyunput( c, (yytext_ptr) ) + +#ifndef YY_STRUCT_YY_BUFFER_STATE +#define YY_STRUCT_YY_BUFFER_STATE +struct yy_buffer_state + { + FILE *yy_input_file; + + char *yy_ch_buf; /* input buffer */ + char *yy_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + yy_size_t yy_buf_size; + + /* Number of characters read into yy_ch_buf, not including EOB + * characters. + */ + yy_size_t yy_n_chars; + + /* Whether we "own" the buffer - i.e., we know we created it, + * and can realloc() it to grow it, and should free() it to + * delete it. + */ + int yy_is_our_buffer; + + /* Whether this is an "interactive" input source; if so, and + * if we're using stdio for input, then we want to use getc() + * instead of fread(), to make sure we stop fetching input after + * each newline. + */ + int yy_is_interactive; + + /* Whether we're considered to be at the beginning of a line. + * If so, '^' rules will be active on the next match, otherwise + * not. + */ + int yy_at_bol; + + int yy_bs_lineno; /**< The line count. */ + int yy_bs_column; /**< The column count. */ + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int yy_fill_buffer; + + int yy_buffer_status; + +#define YY_BUFFER_NEW 0 +#define YY_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as YY_EOF_PENDING, to indicate that we + * shouldn't try reading from the input source any more. We might + * still have a bunch of tokens to match, though, because of + * possible backing-up. + * + * When we actually see the EOF, we change the status to "new" + * (via yyrestart()), so that the user can continue scanning by + * just pointing yyin at a new input file. + */ +#define YY_BUFFER_EOF_PENDING 2 + + }; +#endif /* !YY_STRUCT_YY_BUFFER_STATE */ + +/* Stack of input buffers. */ +static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ +static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ +static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */ + +/* We provide macros for accessing buffer states in case in the + * future we want to put the buffer states in a more general + * "scanner state". + * + * Returns the top of the stack, or NULL. + */ +#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ + ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ + : NULL) + +/* Same as previous macro, but useful when we know that the buffer stack is not + * NULL or when we need an lvalue. For internal use only. + */ +#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] + +/* yy_hold_char holds the character lost when yytext is formed. */ +static char yy_hold_char; +static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */ +yy_size_t yyleng; + +/* Points to current character in buffer. */ +static char *yy_c_buf_p = (char *) 0; +static int yy_init = 0; /* whether we need to initialize */ +static int yy_start = 0; /* start state number */ + +/* Flag which is used to allow yywrap()'s to do buffer switches + * instead of setting up a fresh yyin. A bit of a hack ... + */ +static int yy_did_buffer_switch_on_eof; + +void yyrestart (FILE *input_file ); +void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ); +YY_BUFFER_STATE yy_create_buffer (FILE *file,int size ); +void yy_delete_buffer (YY_BUFFER_STATE b ); +void yy_flush_buffer (YY_BUFFER_STATE b ); +void yypush_buffer_state (YY_BUFFER_STATE new_buffer ); +void yypop_buffer_state (void ); + +static void yyensure_buffer_stack (void ); +static void yy_load_buffer_state (void ); +static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file ); + +#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER ) + +YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size ); +YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str ); +YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len ); + +void *yyalloc (yy_size_t ); +void *yyrealloc (void *,yy_size_t ); +void yyfree (void * ); + +#define yy_new_buffer yy_create_buffer + +#define yy_set_interactive(is_interactive) \ + { \ + if ( ! YY_CURRENT_BUFFER ){ \ + yyensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer(yyin,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ + } + +#define yy_set_bol(at_bol) \ + { \ + if ( ! YY_CURRENT_BUFFER ){\ + yyensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer(yyin,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ + } + +#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) + +/* Begin user sect3 */ + +#define yywrap() 1 +#define YY_SKIP_YYWRAP + +typedef unsigned char YY_CHAR; + +FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0; + +typedef int yy_state_type; + +extern int yylineno; + +int yylineno = 1; + +extern char *yytext; +#define yytext_ptr yytext + +static yy_state_type yy_get_previous_state (void ); +static yy_state_type yy_try_NUL_trans (yy_state_type current_state ); +static int yy_get_next_buffer (void ); +static void yy_fatal_error (yyconst char msg[] ); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up yytext. + */ +#define YY_DO_BEFORE_ACTION \ + (yytext_ptr) = yy_bp; \ + yyleng = (size_t) (yy_cp - yy_bp); \ + (yy_hold_char) = *yy_cp; \ + *yy_cp = '\0'; \ + (yy_c_buf_p) = yy_cp; + +#define YY_NUM_RULES 198 +#define YY_END_OF_BUFFER 199 +/* This struct is not used in this scanner, + but its presence is necessary. */ +struct yy_trans_info + { + flex_int32_t yy_verify; + flex_int32_t yy_nxt; + }; +static yyconst flex_int16_t yy_accept[701] = + { 0, + 0, 0, 0, 0, 0, 0, 0, 0, 199, 197, + 196, 196, 193, 197, 1, 197, 8, 9, 10, 11, + 13, 12, 197, 14, 3, 16, 17, 18, 22, 23, + 142, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 15, 26, 47, 48, 49, 47, + 46, 50, 198, 198, 198, 98, 196, 193, 0, 7, + 6, 0, 0, 2, 2, 3, 2, 3, 0, 19, + 21, 20, 25, 24, 143, 195, 195, 195, 195, 31, + 195, 195, 195, 195, 195, 43, 195, 195, 195, 60, + + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 96, 195, 195, 105, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 135, 195, 140, 195, 142, 195, 195, 195, 153, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 171, 195, 195, 195, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 47, 48, + 47, 45, 44, 0, 66, 0, 98, 4, 5, 2, + 0, 2, 2, 0, 0, 2, 195, 30, 168, 195, + 195, 195, 195, 195, 39, 195, 41, 195, 195, 51, + + 195, 195, 58, 195, 0, 195, 64, 195, 72, 195, + 75, 195, 195, 195, 0, 195, 195, 84, 195, 91, + 0, 195, 195, 195, 95, 195, 100, 101, 195, 104, + 195, 107, 195, 195, 195, 195, 195, 195, 195, 195, + 125, 195, 127, 195, 128, 195, 131, 0, 195, 195, + 141, 143, 195, 195, 145, 195, 195, 191, 195, 195, + 195, 195, 195, 155, 195, 195, 195, 195, 195, 161, + 195, 195, 166, 195, 195, 170, 169, 195, 172, 195, + 195, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 187, 195, 189, 195, 44, 0, 2, 2, 0, 0, + + 2, 2, 195, 32, 34, 195, 195, 195, 195, 42, + 0, 195, 195, 195, 195, 195, 0, 0, 63, 64, + 0, 195, 195, 195, 195, 195, 195, 195, 195, 195, + 195, 0, 195, 92, 0, 0, 195, 94, 39, 195, + 195, 106, 195, 195, 108, 195, 110, 195, 113, 116, + 195, 119, 0, 195, 129, 130, 0, 136, 195, 144, + 195, 146, 195, 148, 191, 191, 149, 195, 195, 150, + 195, 151, 195, 195, 195, 154, 156, 195, 195, 195, + 195, 162, 163, 0, 195, 167, 195, 195, 174, 195, + 195, 195, 195, 195, 180, 181, 195, 195, 195, 188, + + 190, 0, 2, 195, 0, 35, 36, 37, 40, 0, + 0, 195, 195, 195, 195, 195, 0, 0, 195, 0, + 0, 0, 0, 68, 195, 195, 195, 195, 74, 0, + 80, 82, 195, 0, 0, 0, 0, 0, 195, 0, + 94, 93, 99, 102, 0, 195, 109, 111, 195, 0, + 0, 195, 0, 0, 0, 0, 126, 0, 195, 195, + 191, 195, 195, 195, 195, 195, 195, 195, 159, 160, + 0, 195, 195, 195, 173, 195, 195, 177, 178, 179, + 182, 183, 185, 195, 0, 38, 0, 0, 52, 53, + 54, 57, 195, 0, 0, 65, 0, 68, 0, 0, + + 0, 195, 195, 71, 195, 0, 0, 0, 81, 195, + 0, 0, 0, 0, 0, 195, 93, 97, 0, 97, + 97, 103, 0, 194, 112, 0, 0, 0, 118, 0, + 0, 0, 0, 0, 195, 195, 192, 195, 152, 195, + 158, 0, 0, 164, 195, 168, 195, 176, 184, 186, + 0, 0, 0, 55, 0, 59, 0, 0, 0, 0, + 0, 71, 69, 195, 73, 76, 0, 0, 0, 195, + 0, 0, 0, 0, 0, 195, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 195, 0, 164, + 0, 165, 195, 0, 0, 0, 0, 61, 62, 0, + + 69, 0, 195, 77, 0, 79, 83, 0, 0, 0, + 0, 0, 90, 0, 0, 0, 0, 0, 0, 122, + 0, 0, 134, 0, 0, 0, 195, 0, 165, 175, + 0, 0, 33, 56, 0, 0, 70, 0, 0, 0, + 85, 0, 0, 0, 114, 0, 0, 120, 121, 123, + 124, 0, 0, 0, 0, 147, 0, 0, 0, 0, + 70, 0, 87, 89, 86, 88, 194, 115, 117, 0, + 0, 0, 138, 0, 0, 27, 0, 0, 0, 0, + 0, 137, 139, 157, 0, 29, 67, 0, 0, 132, + 0, 78, 0, 0, 0, 0, 133, 0, 28, 0 + + } ; + +static yyconst flex_int32_t yy_ec[256] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, 19, 20, 20, + 20, 20, 20, 20, 20, 21, 21, 22, 23, 24, + 25, 26, 27, 1, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, + 54, 55, 56, 57, 58, 1, 59, 60, 61, 62, + + 63, 64, 65, 66, 67, 37, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1 + } ; + +static yyconst flex_int32_t yy_meta[84] = + { 0, + 1, 2, 3, 1, 4, 5, 5, 5, 1, 1, + 1, 1, 1, 1, 6, 1, 7, 1, 8, 8, + 8, 6, 1, 1, 1, 1, 1, 9, 9, 9, + 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 1, 1, 1, 1, 7, 9, 9, + 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10 + } ; + +static yyconst flex_int16_t yy_base[718] = + { 0, + 0, 0, 82, 86, 50, 54, 292, 268, 260, 3041, + 90, 92, 0, 93, 3041, 64, 3041, 3041, 3041, 3041, + 3041, 3041, 90, 3041, 99, 3041, 3041, 87, 76, 90, + 242, 117, 120, 126, 138, 205, 211, 144, 131, 284, + 134, 218, 355, 235, 294, 302, 334, 397, 470, 413, + 258, 547, 409, 427, 3041, 3041, 0, 235, 3041, 172, + 3041, 3041, 3041, 89, 232, 3041, 146, 0, 154, 164, + 218, 0, 162, 506, 3041, 3041, 538, 557, 213, 3041, + 3041, 3041, 3041, 3041, 3041, 3041, 183, 232, 290, 214, + 305, 455, 364, 565, 578, 262, 312, 596, 592, 325, + + 377, 588, 617, 458, 646, 636, 663, 674, 485, 677, + 680, 692, 430, 683, 489, 701, 704, 508, 707, 714, + 725, 744, 756, 734, 781, 786, 796, 799, 812, 815, + 828, 560, 839, 818, 831, 834, 842, 847, 862, 866, + 881, 947, 885, 891, 912, 905, 917, 934, 920, 950, + 971, 957, 923, 996, 1002, 927, 1020, 1030, 965, 1036, + 1033, 1039, 1047, 1043, 1051, 1076, 1079, 1082, 0, 213, + 385, 201, 209, 225, 3041, 205, 3041, 0, 164, 3041, + 1097, 3041, 1108, 1116, 917, 1127, 1087, 1114, 1135, 1149, + 1152, 1155, 1158, 1161, 1166, 1169, 1172, 1175, 1186, 1189, + + 1197, 1202, 1194, 1213, 695, 1223, 1217, 1240, 1247, 1232, + 1244, 1255, 1268, 1271, 198, 1281, 1274, 1289, 1305, 1301, + 406, 1310, 1318, 1321, 1326, 1335, 1340, 1343, 1348, 1355, + 1364, 1367, 1372, 1375, 1379, 1385, 1391, 1399, 1402, 1406, + 1454, 1457, 1424, 1460, 1433, 1467, 1470, 243, 1474, 1480, + 1483, 3041, 1488, 1491, 1494, 1497, 1502, 1564, 1533, 1577, + 1550, 1547, 1594, 1505, 1597, 1600, 1606, 1609, 1627, 1511, + 1630, 1636, 1648, 1639, 1658, 1519, 1523, 1616, 1528, 1661, + 1669, 1677, 1685, 1690, 1693, 1700, 1707, 1714, 1721, 1735, + 1710, 1738, 1744, 1748, 194, 1739, 1766, 3041, 1774, 1746, + + 1785, 3041, 1767, 1793, 1801, 1808, 1811, 1814, 1817, 1820, + 1808, 1825, 1828, 1831, 1841, 1851, 138, 94, 1857, 1860, + 1858, 1899, 1867, 1903, 1907, 1922, 1931, 1937, 1940, 1949, + 1953, 1947, 1963, 3041, 183, 209, 1966, 1971, 1980, 1995, + 1990, 2009, 2026, 2017, 2035, 2038, 2041, 2044, 2053, 2062, + 2065, 2068, 2051, 2071, 2074, 2082, 212, 2091, 2096, 2101, + 2104, 3041, 2121, 2126, 0, 0, 2133, 2136, 2142, 2146, + 2149, 2152, 2158, 2163, 2166, 2172, 2177, 2183, 2188, 2180, + 2191, 2208, 2215, 333, 2218, 2221, 2229, 2232, 2239, 2246, + 2249, 2260, 2264, 2267, 2274, 2277, 2280, 2287, 2307, 2298, + + 2310, 2300, 2305, 2321, 367, 2328, 2334, 2338, 2341, 217, + 239, 2344, 2348, 2351, 2354, 2357, 281, 356, 2365, 296, + 378, 311, 471, 2368, 2372, 2381, 2386, 2393, 2396, 2375, + 2403, 2416, 2424, 359, 404, 409, 409, 476, 2434, 527, + 3041, 2441, 2502, 2446, 579, 2453, 2449, 2456, 2460, 2055, + 734, 2472, 470, 476, 576, 543, 2467, 586, 2480, 2491, + 0, 2475, 2487, 2529, 2533, 2536, 2539, 2547, 2483, 2560, + 1377, 2563, 2574, 2577, 2581, 2584, 2591, 2594, 2607, 2612, + 2615, 2620, 2624, 2631, 594, 3041, 194, 603, 2628, 2638, + 2642, 2645, 2648, 573, 654, 2654, 684, 3041, 686, 728, + + 598, 2657, 2660, 2663, 2666, 728, 1164, 730, 3041, 2669, + 756, 791, 808, 813, 823, 2673, 3041, 3041, 169, 3041, + 2676, 3041, 835, 2682, 2687, 604, 832, 844, 2690, 878, + 637, 1392, 723, 917, 2697, 2702, 2705, 2714, 2718, 2725, + 2728, 754, 931, 2733, 2741, 2744, 2747, 2750, 3041, 3041, + 2715, 938, 162, 3041, 991, 2755, 966, 997, 1003, 1036, + 1153, 3041, 2760, 2766, 2772, 3041, 1025, 1074, 1184, 2775, + 1203, 1239, 1290, 1316, 1240, 2778, 1321, 1277, 1470, 1318, + 1379, 1408, 1476, 1485, 1516, 1551, 2762, 2791, 1628, 3041, + 1584, 2794, 2797, 1607, 1629, 1698, 0, 3041, 3041, 1701, + + 3041, 1701, 2803, 3041, 1800, 3041, 2806, 1799, 1805, 1805, + 1839, 1847, 2824, 1845, 1814, 1917, 1835, 1943, 1944, 3041, + 1965, 1863, 154, 1908, 1960, 1962, 2827, 1925, 3041, 2833, + 1934, 1995, 3041, 3041, 2050, 1989, 2845, 2007, 2061, 2011, + 3041, 2090, 2105, 2115, 3041, 2169, 2179, 3041, 3041, 3041, + 3041, 2813, 2214, 2237, 2296, 2850, 2336, 2200, 2381, 2480, + 3041, 2369, 3041, 3041, 3041, 3041, 3041, 3041, 3041, 2490, + 2374, 2413, 3041, 2490, 2516, 141, 2540, 2534, 2534, 2639, + 2560, 3041, 3041, 3041, 2726, 3041, 3041, 2688, 2745, 3041, + 2748, 3041, 133, 2575, 253, 2789, 3041, 2757, 3041, 3041, + + 2890, 2900, 2910, 2920, 2930, 2936, 2946, 2956, 2966, 2969, + 2978, 2987, 2997, 3007, 3016, 3026, 3030 + } ; + +static yyconst flex_int16_t yy_def[718] = + { 0, + 700, 1, 701, 701, 702, 702, 703, 703, 700, 700, + 700, 700, 704, 705, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 700, 700, 707, 700, 700, 708, + 700, 700, 700, 700, 709, 700, 700, 704, 705, 705, + 700, 710, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 707, 700, + 708, 711, 707, 711, 700, 709, 700, 710, 700, 700, + 700, 700, 700, 700, 700, 700, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + + 706, 706, 706, 706, 700, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 712, 706, 706, 706, 706, 706, + 700, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 700, 706, 706, + 706, 700, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 700, 700, 700, 700, 700, 700, + + 700, 700, 706, 706, 706, 706, 706, 706, 706, 706, + 700, 706, 706, 706, 706, 706, 700, 700, 706, 706, + 700, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 700, 706, 700, 700, 700, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 700, 706, 706, 706, 700, 706, 706, 706, + 706, 700, 706, 706, 713, 713, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 700, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 706, 706, 706, 706, 706, 706, + + 706, 700, 700, 706, 700, 706, 706, 706, 706, 700, + 700, 706, 706, 706, 706, 706, 700, 700, 706, 700, + 700, 700, 700, 706, 706, 706, 706, 706, 706, 700, + 706, 706, 706, 700, 700, 700, 700, 700, 706, 700, + 700, 706, 714, 706, 700, 706, 706, 706, 706, 700, + 700, 706, 700, 700, 700, 700, 706, 700, 706, 706, + 713, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 700, 706, 706, 706, 706, 706, 706, 706, 706, 706, + 706, 706, 706, 706, 700, 700, 715, 700, 706, 706, + 706, 706, 706, 700, 700, 706, 700, 700, 700, 700, + + 700, 706, 706, 706, 706, 700, 700, 700, 700, 706, + 700, 700, 700, 700, 700, 706, 700, 700, 716, 700, + 706, 700, 700, 706, 706, 700, 700, 700, 706, 700, + 700, 700, 700, 700, 706, 706, 706, 706, 706, 706, + 706, 700, 700, 706, 706, 706, 706, 706, 700, 700, + 700, 700, 715, 700, 700, 706, 700, 700, 700, 700, + 700, 700, 706, 706, 706, 700, 700, 700, 700, 706, + 700, 700, 700, 700, 700, 706, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 706, 700, 700, + 700, 706, 706, 700, 700, 700, 717, 700, 700, 700, + + 700, 700, 706, 700, 700, 700, 706, 700, 700, 700, + 700, 700, 706, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 706, 700, 700, 706, + 700, 700, 700, 700, 700, 700, 706, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 706, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 0, + + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700 + } ; + +static yyconst flex_int16_t yy_nxt[3125] = + { 0, + 10, 11, 12, 13, 14, 15, 10, 10, 16, 13, + 17, 18, 19, 20, 21, 22, 23, 24, 25, 25, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 41, 48, 49, 50, 51, 41, 52, + 53, 41, 54, 17, 55, 18, 56, 10, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, + 45, 46, 47, 41, 48, 49, 50, 51, 41, 52, + 53, 41, 54, 58, 59, 64, 60, 58, 59, 64, + 60, 67, 67, 67, 67, 70, 61, 71, 72, 82, + + 61, 83, 75, 62, 75, 73, 76, 62, 74, 74, + 74, 80, 81, 81, 84, 77, 64, 78, 78, 78, + 64, 175, 86, 86, 86, 86, 86, 86, 418, 72, + 79, 86, 86, 86, 695, 73, 86, 86, 86, 86, + 86, 86, 685, 86, 86, 86, 88, 67, 67, 86, + 86, 86, 175, 92, 96, 652, 70, 89, 71, 418, + 93, 79, 90, 553, 94, 97, 70, 95, 71, 98, + 519, 91, 113, 99, 172, 111, 173, 88, 417, 100, + 179, 179, 179, 179, 92, 112, 174, 89, 86, 86, + 86, 93, 90, 174, 94, 553, 97, 95, 174, 215, + + 98, 91, 113, 172, 99, 295, 111, 177, 417, 100, + 86, 86, 86, 171, 170, 112, 86, 86, 86, 86, + 86, 86, 69, 86, 86, 86, 185, 172, 185, 295, + 440, 186, 186, 186, 177, 101, 170, 86, 86, 86, + 86, 86, 86, 102, 248, 103, 107, 85, 104, 105, + 441, 108, 109, 119, 695, 106, 458, 487, 110, 700, + 440, 187, 126, 86, 86, 86, 101, 86, 86, 86, + 66, 697, 127, 102, 357, 103, 128, 107, 104, 105, + 441, 108, 109, 488, 119, 106, 458, 487, 110, 86, + 86, 86, 187, 126, 66, 86, 86, 86, 158, 86, + + 86, 86, 127, 159, 700, 357, 128, 86, 86, 86, + 86, 86, 86, 488, 114, 700, 115, 86, 86, 86, + 188, 129, 700, 116, 117, 130, 205, 494, 158, 118, + 86, 86, 86, 159, 384, 131, 189, 700, 700, 86, + 86, 86, 132, 497, 133, 114, 134, 115, 700, 135, + 136, 188, 129, 116, 117, 499, 130, 494, 199, 118, + 86, 86, 86, 700, 471, 131, 700, 189, 405, 86, + 86, 86, 132, 497, 133, 137, 134, 700, 138, 135, + 700, 139, 86, 86, 86, 499, 120, 172, 199, 173, + 121, 495, 700, 122, 192, 471, 123, 124, 485, 174, + + 125, 511, 86, 86, 86, 137, 174, 221, 138, 700, + 498, 139, 206, 140, 86, 86, 86, 120, 86, 86, + 86, 121, 495, 122, 141, 192, 123, 124, 142, 485, + 125, 511, 86, 86, 86, 86, 86, 86, 700, 512, + 154, 498, 143, 206, 144, 700, 700, 155, 700, 513, + 165, 335, 336, 166, 156, 141, 514, 157, 167, 142, + 86, 86, 86, 86, 86, 86, 700, 700, 168, 224, + 512, 154, 143, 700, 144, 86, 86, 86, 155, 513, + 165, 335, 336, 166, 156, 700, 514, 157, 700, 167, + 86, 86, 86, 190, 86, 86, 86, 145, 168, 224, + + 191, 146, 500, 515, 147, 700, 211, 700, 148, 180, + 530, 180, 149, 86, 86, 86, 150, 151, 501, 152, + 531, 153, 700, 190, 74, 74, 74, 700, 145, 218, + 191, 700, 146, 500, 515, 147, 211, 181, 148, 700, + 530, 182, 149, 182, 700, 700, 150, 151, 501, 152, + 531, 153, 86, 86, 86, 517, 183, 183, 183, 218, + 75, 248, 75, 700, 76, 86, 86, 86, 181, 184, + 86, 86, 86, 77, 160, 78, 78, 78, 161, 700, + 445, 162, 163, 86, 86, 86, 517, 533, 79, 700, + 700, 164, 700, 86, 86, 86, 193, 86, 86, 86, + + 184, 86, 86, 86, 207, 160, 194, 532, 557, 161, + 195, 700, 162, 163, 523, 700, 196, 533, 197, 79, + 198, 164, 86, 86, 86, 200, 562, 193, 201, 700, + 534, 203, 552, 208, 202, 578, 194, 204, 532, 557, + 195, 86, 86, 86, 555, 523, 196, 209, 197, 700, + 198, 86, 86, 86, 700, 700, 200, 562, 700, 201, + 534, 203, 552, 208, 202, 210, 578, 204, 86, 86, + 86, 213, 582, 212, 555, 215, 700, 700, 209, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 700, 558, 221, 214, 210, 205, 86, 86, 86, + + 700, 700, 213, 582, 212, 216, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 700, 700, 219, 217, 86, + 86, 86, 558, 225, 559, 214, 220, 560, 226, 700, + 86, 86, 86, 228, 700, 451, 216, 222, 223, 86, + 86, 86, 317, 227, 318, 231, 229, 219, 217, 86, + 86, 86, 230, 225, 559, 700, 220, 560, 585, 226, + 232, 86, 86, 86, 228, 233, 561, 222, 223, 566, + 234, 700, 317, 227, 318, 231, 229, 569, 239, 235, + 700, 528, 230, 236, 590, 237, 86, 86, 86, 585, + 232, 86, 86, 86, 700, 233, 561, 238, 571, 566, + + 234, 86, 86, 86, 86, 86, 86, 569, 239, 700, + 235, 528, 240, 700, 236, 590, 237, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 242, 238, 571, 243, + 700, 572, 241, 86, 86, 86, 86, 86, 86, 252, + 86, 86, 700, 240, 86, 86, 86, 86, 86, 86, + 573, 244, 86, 86, 86, 700, 700, 242, 700, 574, + 243, 572, 241, 575, 245, 246, 700, 86, 86, 86, + 249, 86, 86, 86, 247, 577, 579, 251, 700, 253, + 573, 244, 254, 700, 580, 250, 86, 86, 86, 574, + 86, 86, 86, 575, 245, 246, 86, 86, 86, 700, + + 700, 249, 700, 700, 247, 577, 579, 251, 255, 253, + 86, 86, 86, 254, 580, 250, 263, 86, 86, 86, + 581, 256, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 264, 86, 86, 86, 186, 186, 186, 255, 86, + 86, 86, 700, 266, 267, 700, 700, 263, 268, 270, + 581, 256, 86, 86, 86, 86, 86, 86, 586, 700, + 265, 264, 86, 86, 86, 269, 591, 700, 275, 700, + 86, 86, 86, 266, 257, 267, 86, 86, 86, 268, + 270, 271, 700, 596, 274, 700, 258, 259, 586, 260, + 265, 272, 261, 262, 700, 700, 269, 591, 275, 273, + + 285, 86, 86, 86, 598, 257, 700, 86, 86, 86, + 700, 700, 271, 596, 700, 274, 258, 259, 277, 260, + 597, 272, 261, 262, 276, 86, 86, 86, 599, 700, + 273, 285, 600, 278, 598, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 700, 86, 86, + 86, 597, 86, 86, 86, 276, 86, 86, 86, 599, + 279, 280, 700, 600, 278, 601, 700, 281, 282, 604, + 283, 286, 700, 287, 288, 700, 284, 289, 290, 700, + 700, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 279, 280, 86, 86, 86, 291, 601, 281, 282, 604, + + 283, 700, 286, 287, 700, 288, 284, 292, 289, 290, + 296, 298, 296, 298, 605, 297, 297, 297, 303, 86, + 86, 86, 294, 293, 700, 291, 183, 183, 183, 300, + 302, 300, 302, 700, 301, 301, 301, 700, 292, 299, + 86, 86, 86, 700, 605, 186, 186, 186, 700, 303, + 700, 700, 294, 293, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 700, + 299, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 305, 602, 307, 700, 304, 700, 700, + 306, 86, 86, 86, 86, 86, 86, 700, 311, 86, + + 86, 86, 86, 86, 86, 567, 308, 86, 86, 86, + 309, 568, 606, 96, 305, 602, 307, 304, 86, 86, + 86, 306, 86, 86, 86, 700, 310, 312, 86, 86, + 86, 700, 313, 315, 608, 567, 308, 86, 86, 86, + 309, 568, 314, 606, 96, 86, 86, 86, 321, 86, + 86, 86, 86, 86, 86, 316, 310, 700, 312, 700, + 86, 86, 86, 313, 315, 608, 609, 325, 700, 319, + 612, 320, 314, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 322, 700, 700, 316, 86, 86, 86, 323, + 332, 700, 324, 700, 86, 86, 86, 609, 325, 319, + + 326, 612, 320, 700, 615, 331, 334, 86, 86, 328, + 86, 86, 86, 322, 327, 86, 86, 86, 700, 323, + 700, 330, 324, 86, 86, 86, 86, 86, 86, 700, + 326, 86, 86, 86, 333, 615, 331, 610, 700, 328, + 86, 86, 86, 700, 327, 86, 86, 86, 86, 86, + 86, 330, 339, 86, 86, 86, 700, 337, 611, 338, + 86, 86, 86, 614, 617, 333, 700, 610, 340, 86, + 86, 86, 86, 86, 86, 700, 700, 86, 86, 86, + 86, 86, 86, 339, 86, 86, 86, 337, 611, 338, + 86, 86, 86, 614, 617, 341, 86, 86, 86, 340, + + 700, 700, 342, 343, 86, 86, 86, 86, 86, 86, + 700, 86, 86, 86, 344, 347, 700, 542, 348, 583, + 700, 345, 584, 700, 346, 341, 618, 543, 349, 86, + 86, 86, 342, 700, 343, 700, 700, 351, 86, 86, + 86, 350, 700, 700, 344, 700, 347, 542, 619, 348, + 583, 345, 352, 584, 346, 353, 618, 543, 349, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 351, 700, + 700, 350, 86, 86, 86, 86, 86, 86, 619, 86, + 86, 86, 352, 700, 700, 86, 86, 86, 86, 86, + 86, 355, 354, 86, 86, 86, 86, 86, 86, 362, + + 86, 86, 86, 86, 86, 616, 620, 86, 86, 86, + 86, 86, 86, 356, 358, 359, 86, 86, 86, 360, + 621, 700, 355, 354, 86, 86, 86, 363, 86, 86, + 86, 361, 364, 86, 86, 86, 616, 620, 86, 86, + 86, 700, 700, 356, 358, 700, 359, 700, 700, 367, + 360, 621, 86, 86, 86, 86, 86, 86, 363, 700, + 368, 361, 622, 364, 365, 365, 372, 365, 365, 366, + 366, 366, 365, 365, 365, 365, 365, 365, 365, 365, + 369, 365, 86, 86, 86, 365, 365, 365, 365, 365, + 365, 368, 622, 370, 375, 623, 373, 374, 700, 86, + + 86, 86, 86, 86, 86, 86, 86, 86, 371, 700, + 369, 86, 86, 86, 86, 86, 86, 365, 365, 365, + 365, 86, 86, 86, 375, 623, 373, 374, 377, 589, + 629, 378, 86, 86, 86, 86, 86, 86, 631, 371, + 376, 86, 86, 86, 86, 86, 86, 380, 700, 384, + 379, 700, 700, 86, 86, 86, 277, 628, 381, 377, + 629, 700, 378, 86, 86, 86, 86, 86, 86, 631, + 376, 700, 382, 632, 86, 86, 86, 380, 383, 385, + 379, 386, 86, 86, 86, 700, 277, 700, 628, 381, + 86, 86, 86, 388, 700, 86, 86, 86, 86, 86, + + 86, 389, 382, 632, 387, 86, 86, 86, 383, 390, + 385, 386, 86, 86, 86, 86, 86, 86, 391, 86, + 86, 86, 700, 700, 388, 393, 86, 86, 86, 633, + 636, 389, 392, 394, 387, 700, 700, 396, 700, 390, + 86, 86, 86, 86, 86, 86, 395, 635, 391, 86, + 86, 86, 397, 86, 86, 86, 393, 297, 297, 297, + 633, 636, 392, 394, 301, 301, 301, 398, 396, 180, + 400, 180, 86, 86, 86, 700, 395, 635, 700, 401, + 700, 399, 397, 700, 297, 297, 297, 402, 182, 402, + 182, 700, 403, 403, 403, 700, 700, 398, 86, 86, + + 86, 400, 405, 301, 301, 301, 86, 86, 86, 311, + 401, 399, 404, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 700, 638, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 639, + 410, 700, 404, 700, 645, 408, 86, 86, 86, 640, + 411, 641, 406, 412, 700, 407, 86, 86, 86, 321, + 638, 409, 86, 86, 86, 86, 86, 86, 413, 639, + 647, 410, 86, 86, 86, 645, 408, 414, 700, 640, + 411, 641, 406, 700, 412, 407, 642, 415, 643, 416, + 420, 409, 644, 421, 651, 419, 700, 700, 413, 700, + + 422, 647, 700, 423, 86, 86, 86, 414, 86, 86, + 86, 425, 86, 86, 86, 700, 642, 415, 643, 416, + 700, 420, 644, 700, 421, 651, 419, 86, 86, 86, + 422, 424, 430, 423, 426, 653, 86, 86, 86, 700, + 700, 425, 86, 86, 86, 86, 86, 86, 332, 700, + 427, 428, 657, 429, 86, 86, 86, 700, 86, 86, + 86, 658, 424, 646, 700, 426, 653, 431, 86, 86, + 86, 86, 86, 86, 434, 435, 86, 86, 86, 432, + 427, 428, 436, 657, 429, 86, 86, 86, 437, 648, + 649, 438, 658, 646, 442, 86, 86, 86, 431, 433, + + 86, 86, 86, 700, 650, 434, 435, 654, 655, 439, + 432, 700, 700, 436, 86, 86, 86, 700, 437, 648, + 649, 438, 86, 86, 86, 442, 443, 445, 700, 433, + 659, 86, 86, 86, 650, 661, 444, 654, 655, 439, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 353, 662, 450, 700, 450, 443, 86, 86, + 86, 659, 664, 451, 446, 661, 444, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 448, 662, 447, 660, 453, 86, 86, 86, + 449, 663, 664, 454, 446, 455, 86, 86, 86, 526, + + 456, 86, 86, 86, 527, 452, 86, 86, 86, 86, + 86, 86, 448, 700, 447, 457, 660, 453, 700, 700, + 449, 700, 663, 454, 700, 455, 86, 86, 86, 526, + 456, 86, 86, 86, 527, 452, 665, 459, 86, 86, + 86, 86, 86, 86, 666, 457, 700, 86, 86, 86, + 136, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 700, 667, 460, 86, 86, 86, 665, 459, 86, 86, + 86, 86, 86, 86, 666, 462, 463, 86, 86, 86, + 136, 367, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 667, 460, 86, 86, 86, 86, 86, 86, 464, + + 668, 700, 465, 700, 700, 462, 700, 463, 700, 700, + 466, 367, 467, 86, 86, 86, 700, 669, 469, 468, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 464, + 676, 668, 465, 470, 86, 86, 86, 86, 86, 86, + 466, 700, 700, 467, 86, 86, 86, 669, 469, 700, + 468, 86, 86, 86, 86, 86, 86, 700, 472, 672, + 474, 676, 700, 470, 475, 86, 86, 86, 473, 86, + 86, 86, 86, 86, 86, 476, 700, 673, 477, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 472, 672, + 700, 474, 86, 86, 86, 475, 700, 700, 473, 478, + + 480, 700, 479, 86, 86, 86, 476, 673, 298, 477, + 298, 481, 86, 86, 86, 86, 86, 86, 403, 403, + 403, 482, 700, 403, 403, 403, 86, 86, 86, 478, + 700, 480, 479, 86, 86, 86, 700, 674, 483, 86, + 86, 86, 481, 486, 86, 86, 86, 86, 86, 86, + 86, 86, 482, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 700, 484, 674, 700, 483, + 86, 86, 86, 86, 86, 86, 430, 86, 86, 86, + 700, 675, 489, 700, 493, 492, 86, 86, 86, 700, + 700, 86, 86, 86, 490, 491, 484, 496, 86, 86, + + 86, 86, 86, 86, 679, 506, 681, 507, 509, 86, + 86, 675, 489, 502, 504, 493, 492, 700, 700, 503, + 508, 86, 86, 86, 490, 491, 700, 677, 496, 86, + 86, 86, 700, 700, 505, 679, 506, 681, 507, 86, + 86, 86, 700, 502, 682, 504, 86, 86, 86, 503, + 508, 522, 86, 86, 86, 86, 86, 677, 86, 86, + 86, 86, 86, 86, 505, 86, 86, 86, 700, 516, + 700, 510, 86, 86, 86, 682, 700, 86, 86, 86, + 86, 86, 86, 700, 700, 86, 86, 86, 86, 86, + 86, 525, 86, 86, 86, 700, 86, 86, 86, 524, + + 516, 510, 518, 519, 700, 518, 537, 520, 520, 520, + 518, 518, 518, 518, 518, 518, 518, 518, 529, 518, + 535, 678, 525, 518, 518, 518, 518, 518, 518, 524, + 536, 680, 683, 370, 86, 86, 86, 537, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 684, 529, 700, + 535, 678, 86, 86, 86, 518, 518, 518, 518, 700, + 536, 680, 683, 370, 539, 86, 86, 86, 86, 86, + 86, 686, 700, 538, 687, 688, 140, 541, 684, 86, + 86, 86, 86, 86, 86, 540, 86, 86, 86, 86, + 86, 86, 690, 544, 700, 539, 86, 86, 86, 86, + + 86, 86, 686, 538, 687, 688, 140, 700, 541, 545, + 696, 547, 86, 86, 86, 540, 546, 86, 86, 86, + 86, 86, 86, 690, 544, 549, 86, 86, 548, 550, + 86, 86, 551, 86, 86, 86, 86, 86, 86, 700, + 545, 696, 547, 86, 86, 86, 546, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 700, 700, 548, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 700, 86, 86, + 86, 86, 86, 86, 700, 689, 563, 86, 86, 86, + 700, 564, 86, 86, 86, 86, 86, 86, 587, 556, + + 700, 700, 86, 86, 86, 700, 565, 86, 86, 86, + 86, 86, 86, 570, 576, 689, 551, 563, 700, 86, + 86, 86, 564, 86, 86, 86, 589, 685, 692, 556, + 86, 86, 86, 86, 86, 86, 565, 588, 86, 86, + 86, 700, 700, 570, 576, 372, 86, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 692, 594, + 86, 86, 86, 587, 595, 86, 86, 86, 588, 700, + 700, 86, 86, 86, 700, 691, 372, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 693, 592, 699, 594, + 624, 700, 694, 593, 595, 603, 86, 86, 86, 86, + + 86, 86, 86, 86, 86, 691, 625, 626, 86, 86, + 86, 86, 86, 86, 652, 607, 693, 592, 613, 699, + 700, 624, 694, 593, 700, 700, 603, 700, 630, 86, + 86, 86, 86, 86, 86, 698, 625, 626, 86, 86, + 86, 700, 700, 627, 700, 607, 670, 700, 613, 637, + 86, 86, 86, 700, 671, 86, 86, 86, 656, 630, + 700, 700, 700, 700, 700, 698, 700, 700, 700, 700, + 700, 700, 700, 627, 700, 700, 700, 670, 700, 637, + 700, 700, 700, 700, 671, 700, 700, 700, 700, 656, + 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, + + 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, + 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, + 68, 68, 700, 68, 68, 68, 68, 68, 68, 68, + 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, + 87, 700, 87, 87, 87, 87, 169, 169, 700, 169, + 169, 700, 169, 169, 169, 169, 171, 171, 171, 171, + 171, 171, 171, 171, 171, 171, 176, 176, 176, 176, + 176, 176, 176, 176, 176, 176, 178, 178, 174, 174, + 174, 174, 174, 174, 174, 174, 174, 174, 329, 700, + 700, 700, 700, 700, 700, 329, 329, 461, 461, 700, + + 461, 461, 461, 461, 461, 461, 461, 521, 521, 700, + 700, 521, 521, 521, 521, 521, 521, 554, 700, 700, + 700, 700, 554, 554, 554, 554, 518, 518, 700, 700, + 518, 518, 518, 518, 518, 518, 634, 634, 634, 634, + 9, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700 + } ; + +static yyconst flex_int16_t yy_chk[3125] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 3, 3, 5, 3, 4, 4, 6, + 4, 11, 11, 12, 12, 14, 3, 14, 16, 29, + + 4, 29, 25, 3, 25, 16, 25, 4, 23, 23, + 23, 28, 28, 30, 30, 25, 5, 25, 25, 25, + 6, 64, 32, 32, 32, 33, 33, 33, 318, 16, + 25, 34, 34, 34, 693, 16, 39, 39, 39, 41, + 41, 41, 676, 35, 35, 35, 32, 67, 67, 38, + 38, 38, 64, 34, 35, 623, 69, 32, 69, 318, + 34, 25, 32, 553, 34, 35, 70, 34, 70, 35, + 519, 33, 39, 35, 60, 38, 60, 32, 317, 35, + 73, 73, 179, 179, 34, 38, 60, 32, 87, 87, + 87, 34, 32, 60, 34, 487, 35, 34, 295, 215, + + 35, 33, 39, 172, 35, 172, 38, 176, 317, 35, + 36, 36, 36, 173, 170, 38, 37, 37, 37, 90, + 90, 90, 71, 42, 42, 42, 79, 174, 79, 174, + 335, 79, 79, 79, 65, 36, 58, 88, 88, 88, + 44, 44, 44, 36, 248, 36, 37, 31, 36, 36, + 336, 37, 37, 42, 695, 36, 357, 410, 37, 9, + 335, 88, 44, 51, 51, 51, 36, 96, 96, 96, + 8, 695, 44, 36, 248, 36, 44, 37, 36, 36, + 336, 37, 37, 411, 42, 36, 357, 410, 37, 40, + 40, 40, 88, 44, 7, 89, 89, 89, 51, 45, + + 45, 45, 44, 51, 0, 248, 44, 46, 46, 46, + 91, 91, 91, 411, 40, 0, 40, 97, 97, 97, + 89, 45, 0, 40, 40, 45, 100, 417, 51, 40, + 100, 100, 100, 51, 384, 45, 91, 0, 0, 47, + 47, 47, 46, 420, 46, 40, 46, 40, 0, 46, + 47, 89, 45, 40, 40, 422, 45, 417, 97, 40, + 43, 43, 43, 0, 384, 45, 0, 91, 405, 93, + 93, 93, 46, 420, 46, 47, 46, 0, 47, 46, + 0, 47, 101, 101, 101, 422, 43, 171, 97, 171, + 43, 418, 0, 43, 93, 384, 43, 43, 405, 171, + + 43, 434, 48, 48, 48, 47, 171, 221, 47, 0, + 421, 47, 101, 48, 53, 53, 53, 43, 50, 50, + 50, 43, 418, 43, 48, 93, 43, 43, 48, 405, + 43, 434, 54, 54, 54, 113, 113, 113, 0, 435, + 50, 421, 48, 101, 48, 0, 0, 50, 0, 436, + 53, 221, 221, 53, 50, 48, 437, 50, 54, 48, + 92, 92, 92, 104, 104, 104, 0, 0, 54, 113, + 435, 50, 48, 0, 48, 49, 49, 49, 50, 436, + 53, 221, 221, 53, 50, 0, 437, 50, 0, 54, + 109, 109, 109, 92, 115, 115, 115, 49, 54, 113, + + 92, 49, 423, 438, 49, 0, 104, 0, 49, 74, + 453, 74, 49, 118, 118, 118, 49, 49, 423, 49, + 454, 49, 0, 92, 74, 74, 74, 0, 49, 109, + 92, 0, 49, 423, 438, 49, 104, 74, 49, 0, + 453, 77, 49, 77, 0, 0, 49, 49, 423, 49, + 454, 49, 52, 52, 52, 440, 77, 77, 77, 109, + 78, 132, 78, 0, 78, 132, 132, 132, 74, 77, + 94, 94, 94, 78, 52, 78, 78, 78, 52, 0, + 445, 52, 52, 95, 95, 95, 440, 456, 78, 0, + 0, 52, 0, 102, 102, 102, 94, 99, 99, 99, + + 77, 98, 98, 98, 102, 52, 94, 455, 494, 52, + 94, 0, 52, 52, 445, 0, 95, 456, 95, 78, + 95, 52, 103, 103, 103, 98, 501, 94, 98, 0, + 458, 99, 485, 102, 98, 526, 94, 99, 455, 494, + 94, 106, 106, 106, 488, 445, 95, 103, 95, 0, + 95, 105, 105, 105, 0, 0, 98, 501, 0, 98, + 458, 99, 485, 102, 98, 103, 526, 99, 107, 107, + 107, 106, 531, 105, 488, 108, 0, 0, 103, 108, + 108, 108, 110, 110, 110, 111, 111, 111, 114, 114, + 114, 0, 495, 112, 107, 103, 205, 112, 112, 112, + + 0, 0, 106, 531, 105, 108, 116, 116, 116, 117, + 117, 117, 119, 119, 119, 0, 0, 110, 108, 120, + 120, 120, 495, 114, 497, 107, 111, 499, 116, 0, + 121, 121, 121, 117, 0, 451, 108, 112, 112, 124, + 124, 124, 205, 116, 205, 119, 117, 110, 108, 122, + 122, 122, 117, 114, 497, 0, 111, 499, 533, 116, + 120, 123, 123, 123, 117, 121, 500, 112, 112, 506, + 121, 0, 205, 116, 205, 119, 117, 508, 124, 122, + 0, 451, 117, 123, 542, 123, 125, 125, 125, 533, + 120, 126, 126, 126, 0, 121, 500, 123, 511, 506, + + 121, 127, 127, 127, 128, 128, 128, 508, 124, 0, + 122, 451, 125, 0, 123, 542, 123, 129, 129, 129, + 130, 130, 130, 134, 134, 134, 127, 123, 511, 128, + 0, 512, 126, 131, 131, 131, 135, 135, 135, 136, + 136, 136, 0, 125, 133, 133, 133, 137, 137, 137, + 513, 129, 138, 138, 138, 0, 0, 127, 0, 514, + 128, 512, 126, 515, 130, 130, 0, 139, 139, 139, + 133, 140, 140, 140, 131, 523, 527, 135, 0, 137, + 513, 129, 138, 0, 528, 133, 141, 141, 141, 514, + 143, 143, 143, 515, 130, 130, 144, 144, 144, 0, + + 0, 133, 0, 0, 131, 523, 527, 135, 139, 137, + 146, 146, 146, 138, 528, 133, 143, 145, 145, 145, + 530, 141, 147, 147, 147, 149, 149, 149, 153, 153, + 153, 144, 156, 156, 156, 185, 185, 185, 139, 148, + 148, 148, 0, 146, 147, 0, 0, 143, 147, 149, + 530, 141, 142, 142, 142, 150, 150, 150, 534, 0, + 145, 144, 152, 152, 152, 148, 543, 0, 153, 0, + 159, 159, 159, 146, 142, 147, 151, 151, 151, 147, + 149, 150, 0, 552, 152, 0, 142, 142, 534, 142, + 145, 150, 142, 142, 0, 0, 148, 543, 153, 151, + + 159, 154, 154, 154, 557, 142, 0, 155, 155, 155, + 0, 0, 150, 552, 0, 152, 142, 142, 155, 142, + 555, 150, 142, 142, 154, 157, 157, 157, 558, 0, + 151, 159, 559, 155, 557, 158, 158, 158, 161, 161, + 161, 160, 160, 160, 162, 162, 162, 0, 164, 164, + 164, 555, 163, 163, 163, 154, 165, 165, 165, 558, + 157, 157, 0, 559, 155, 560, 0, 157, 158, 567, + 158, 160, 0, 161, 162, 0, 158, 163, 164, 0, + 0, 166, 166, 166, 167, 167, 167, 168, 168, 168, + 157, 157, 187, 187, 187, 165, 560, 157, 158, 567, + + 158, 0, 160, 161, 0, 162, 158, 166, 163, 164, + 181, 183, 181, 183, 568, 181, 181, 181, 187, 188, + 188, 188, 168, 167, 0, 165, 183, 183, 183, 184, + 186, 184, 186, 0, 184, 184, 184, 0, 166, 183, + 189, 189, 189, 0, 568, 186, 186, 186, 0, 187, + 0, 0, 168, 167, 190, 190, 190, 191, 191, 191, + 192, 192, 192, 193, 193, 193, 194, 194, 194, 0, + 183, 195, 195, 195, 196, 196, 196, 197, 197, 197, + 198, 198, 198, 191, 561, 193, 0, 190, 0, 0, + 192, 199, 199, 199, 200, 200, 200, 0, 201, 203, + + 203, 203, 201, 201, 201, 507, 194, 202, 202, 202, + 196, 507, 569, 199, 191, 561, 193, 190, 204, 204, + 204, 192, 207, 207, 207, 0, 198, 201, 206, 206, + 206, 0, 201, 202, 571, 507, 194, 210, 210, 210, + 196, 507, 201, 569, 199, 208, 208, 208, 209, 211, + 211, 211, 209, 209, 209, 204, 198, 0, 201, 0, + 212, 212, 212, 201, 202, 571, 572, 210, 0, 206, + 575, 208, 201, 213, 213, 213, 214, 214, 214, 217, + 217, 217, 209, 0, 0, 204, 216, 216, 216, 209, + 218, 0, 209, 0, 218, 218, 218, 572, 210, 206, + + 212, 575, 208, 0, 578, 217, 220, 220, 220, 214, + 219, 219, 219, 209, 213, 222, 222, 222, 0, 209, + 0, 216, 209, 223, 223, 223, 224, 224, 224, 0, + 212, 225, 225, 225, 219, 578, 217, 573, 0, 214, + 226, 226, 226, 0, 213, 227, 227, 227, 228, 228, + 228, 216, 224, 229, 229, 229, 0, 222, 574, 223, + 230, 230, 230, 577, 580, 219, 0, 573, 226, 231, + 231, 231, 232, 232, 232, 0, 0, 233, 233, 233, + 234, 234, 234, 224, 235, 235, 235, 222, 574, 223, + 236, 236, 236, 577, 580, 229, 237, 237, 237, 226, + + 0, 0, 231, 233, 238, 238, 238, 239, 239, 239, + 0, 240, 240, 240, 233, 236, 0, 471, 237, 532, + 0, 234, 532, 0, 235, 229, 581, 471, 237, 243, + 243, 243, 231, 0, 233, 0, 0, 239, 245, 245, + 245, 238, 0, 0, 233, 0, 236, 471, 582, 237, + 532, 234, 240, 532, 235, 241, 581, 471, 237, 241, + 241, 241, 242, 242, 242, 244, 244, 244, 239, 0, + 0, 238, 246, 246, 246, 247, 247, 247, 582, 249, + 249, 249, 240, 0, 0, 250, 250, 250, 251, 251, + 251, 244, 242, 253, 253, 253, 254, 254, 254, 255, + + 255, 255, 256, 256, 256, 579, 583, 257, 257, 257, + 264, 264, 264, 246, 249, 250, 270, 270, 270, 253, + 584, 0, 244, 242, 276, 276, 276, 256, 277, 277, + 277, 254, 257, 279, 279, 279, 579, 583, 259, 259, + 259, 0, 0, 246, 249, 0, 250, 0, 0, 259, + 253, 584, 262, 262, 262, 261, 261, 261, 256, 0, + 259, 254, 585, 257, 258, 258, 261, 258, 258, 258, + 258, 258, 258, 258, 258, 258, 258, 258, 258, 258, + 259, 258, 260, 260, 260, 258, 258, 258, 258, 258, + 258, 259, 585, 260, 262, 586, 261, 261, 0, 263, + + 263, 263, 265, 265, 265, 266, 266, 266, 260, 0, + 259, 267, 267, 267, 268, 268, 268, 258, 258, 258, + 258, 278, 278, 278, 262, 586, 261, 261, 265, 589, + 591, 266, 269, 269, 269, 271, 271, 271, 594, 260, + 263, 272, 272, 272, 274, 274, 274, 268, 0, 273, + 267, 0, 0, 273, 273, 273, 278, 589, 269, 265, + 591, 0, 266, 275, 275, 275, 280, 280, 280, 594, + 263, 0, 271, 595, 281, 281, 281, 268, 272, 273, + 267, 274, 282, 282, 282, 0, 278, 0, 589, 269, + 283, 283, 283, 280, 0, 284, 284, 284, 285, 285, + + 285, 280, 271, 595, 275, 286, 286, 286, 272, 281, + 273, 274, 287, 287, 287, 291, 291, 291, 282, 288, + 288, 288, 0, 0, 280, 284, 289, 289, 289, 596, + 602, 280, 283, 285, 275, 0, 0, 287, 0, 281, + 290, 290, 290, 292, 292, 292, 286, 600, 282, 293, + 293, 293, 288, 294, 294, 294, 284, 296, 296, 296, + 596, 602, 283, 285, 300, 300, 300, 289, 287, 297, + 292, 297, 303, 303, 303, 0, 286, 600, 0, 294, + 0, 290, 288, 0, 297, 297, 297, 299, 301, 299, + 301, 0, 299, 299, 299, 0, 0, 289, 304, 304, + + 304, 292, 305, 301, 301, 301, 305, 305, 305, 311, + 294, 290, 303, 306, 306, 306, 307, 307, 307, 308, + 308, 308, 309, 309, 309, 310, 310, 310, 0, 605, + 312, 312, 312, 313, 313, 313, 314, 314, 314, 608, + 311, 0, 303, 0, 615, 308, 315, 315, 315, 609, + 311, 610, 306, 312, 0, 307, 316, 316, 316, 321, + 605, 309, 319, 319, 319, 320, 320, 320, 313, 608, + 617, 311, 323, 323, 323, 615, 308, 314, 0, 609, + 311, 610, 306, 0, 312, 307, 611, 315, 612, 316, + 321, 309, 614, 321, 622, 320, 0, 0, 313, 0, + + 321, 617, 0, 321, 322, 322, 322, 314, 324, 324, + 324, 323, 325, 325, 325, 0, 611, 315, 612, 316, + 0, 321, 614, 0, 321, 622, 320, 326, 326, 326, + 321, 322, 327, 321, 324, 624, 327, 327, 327, 0, + 0, 323, 328, 328, 328, 329, 329, 329, 332, 0, + 324, 325, 628, 326, 330, 330, 330, 0, 331, 331, + 331, 631, 322, 616, 0, 324, 624, 328, 333, 333, + 333, 337, 337, 337, 332, 332, 338, 338, 338, 330, + 324, 325, 332, 628, 326, 339, 339, 339, 332, 618, + 619, 332, 631, 616, 337, 341, 341, 341, 328, 331, + + 340, 340, 340, 0, 621, 332, 332, 625, 626, 333, + 330, 0, 0, 332, 342, 342, 342, 0, 332, 618, + 619, 332, 344, 344, 344, 337, 340, 343, 0, 331, + 632, 343, 343, 343, 621, 636, 341, 625, 626, 333, + 345, 345, 345, 346, 346, 346, 347, 347, 347, 348, + 348, 348, 353, 638, 349, 0, 450, 340, 349, 349, + 349, 632, 640, 350, 344, 636, 341, 350, 350, 350, + 351, 351, 351, 352, 352, 352, 354, 354, 354, 355, + 355, 355, 348, 638, 346, 635, 353, 356, 356, 356, + 348, 639, 640, 353, 344, 353, 358, 358, 358, 450, + + 353, 359, 359, 359, 450, 351, 360, 360, 360, 361, + 361, 361, 348, 0, 346, 354, 635, 353, 0, 0, + 348, 0, 639, 353, 0, 353, 363, 363, 363, 450, + 353, 364, 364, 364, 450, 351, 642, 359, 367, 367, + 367, 368, 368, 368, 643, 354, 0, 369, 369, 369, + 361, 370, 370, 370, 371, 371, 371, 372, 372, 372, + 0, 644, 363, 373, 373, 373, 642, 359, 374, 374, + 374, 375, 375, 375, 643, 368, 371, 376, 376, 376, + 361, 369, 377, 377, 377, 380, 380, 380, 378, 378, + 378, 644, 363, 379, 379, 379, 381, 381, 381, 373, + + 646, 0, 374, 0, 0, 368, 0, 371, 0, 0, + 375, 369, 378, 382, 382, 382, 0, 647, 380, 379, + 383, 383, 383, 385, 385, 385, 386, 386, 386, 373, + 658, 646, 374, 381, 387, 387, 387, 388, 388, 388, + 375, 0, 0, 378, 389, 389, 389, 647, 380, 0, + 379, 390, 390, 390, 391, 391, 391, 0, 385, 653, + 387, 658, 0, 381, 388, 392, 392, 392, 385, 393, + 393, 393, 394, 394, 394, 390, 0, 654, 391, 395, + 395, 395, 396, 396, 396, 397, 397, 397, 385, 653, + 0, 387, 398, 398, 398, 388, 0, 0, 385, 392, + + 394, 0, 393, 400, 400, 400, 390, 654, 403, 391, + 403, 397, 399, 399, 399, 401, 401, 401, 402, 402, + 402, 398, 0, 403, 403, 403, 404, 404, 404, 392, + 0, 394, 393, 406, 406, 406, 0, 655, 399, 407, + 407, 407, 397, 408, 408, 408, 409, 409, 409, 412, + 412, 412, 398, 413, 413, 413, 414, 414, 414, 415, + 415, 415, 416, 416, 416, 0, 404, 655, 0, 399, + 419, 419, 419, 424, 424, 424, 430, 425, 425, 425, + 0, 657, 412, 0, 416, 415, 426, 426, 426, 0, + 0, 427, 427, 427, 413, 414, 404, 419, 428, 428, + + 428, 429, 429, 429, 662, 430, 671, 430, 431, 431, + 431, 657, 412, 425, 427, 416, 415, 0, 0, 426, + 430, 432, 432, 432, 413, 414, 0, 659, 419, 433, + 433, 433, 0, 0, 428, 662, 430, 671, 430, 439, + 439, 439, 0, 425, 672, 427, 442, 442, 442, 426, + 430, 444, 444, 444, 447, 447, 447, 659, 446, 446, + 446, 448, 448, 448, 428, 449, 449, 449, 0, 439, + 0, 433, 457, 457, 457, 672, 0, 452, 452, 452, + 462, 462, 462, 0, 0, 459, 459, 459, 469, 469, + 469, 449, 463, 463, 463, 0, 460, 460, 460, 446, + + 439, 433, 443, 443, 0, 443, 462, 443, 443, 443, + 443, 443, 443, 443, 443, 443, 443, 443, 452, 443, + 459, 660, 449, 443, 443, 443, 443, 443, 443, 446, + 460, 670, 674, 463, 464, 464, 464, 462, 465, 465, + 465, 466, 466, 466, 467, 467, 467, 675, 452, 0, + 459, 660, 468, 468, 468, 443, 443, 443, 443, 0, + 460, 670, 674, 463, 465, 470, 470, 470, 472, 472, + 472, 677, 0, 464, 678, 679, 466, 468, 675, 473, + 473, 473, 474, 474, 474, 467, 475, 475, 475, 476, + 476, 476, 681, 472, 0, 465, 477, 477, 477, 478, + + 478, 478, 677, 464, 678, 679, 466, 0, 468, 473, + 694, 476, 479, 479, 479, 467, 474, 480, 480, 480, + 481, 481, 481, 681, 472, 482, 482, 482, 477, 483, + 483, 483, 484, 489, 489, 489, 484, 484, 484, 0, + 473, 694, 476, 490, 490, 490, 474, 491, 491, 491, + 492, 492, 492, 493, 493, 493, 0, 0, 477, 496, + 496, 496, 502, 502, 502, 503, 503, 503, 504, 504, + 504, 505, 505, 505, 510, 510, 510, 0, 516, 516, + 516, 521, 521, 521, 0, 680, 502, 524, 524, 524, + 0, 503, 525, 525, 525, 529, 529, 529, 535, 493, + + 0, 0, 535, 535, 535, 0, 505, 536, 536, 536, + 537, 537, 537, 510, 516, 680, 551, 502, 0, 538, + 538, 538, 503, 539, 539, 539, 540, 685, 688, 493, + 540, 540, 540, 541, 541, 541, 505, 536, 544, 544, + 544, 0, 0, 510, 516, 538, 545, 545, 545, 546, + 546, 546, 547, 547, 547, 548, 548, 548, 688, 551, + 556, 556, 556, 587, 551, 563, 563, 563, 536, 0, + 0, 564, 564, 564, 0, 685, 538, 565, 565, 565, + 570, 570, 570, 576, 576, 576, 689, 545, 698, 551, + 587, 0, 691, 547, 551, 564, 588, 588, 588, 592, + + 592, 592, 593, 593, 593, 685, 587, 587, 603, 603, + 603, 607, 607, 607, 652, 570, 689, 545, 576, 698, + 0, 587, 691, 547, 0, 0, 564, 0, 593, 613, + 613, 613, 627, 627, 627, 696, 587, 587, 630, 630, + 630, 0, 0, 588, 0, 570, 652, 0, 576, 603, + 637, 637, 637, 0, 652, 656, 656, 656, 627, 593, + 0, 0, 0, 0, 0, 696, 0, 0, 0, 0, + 0, 0, 0, 588, 0, 0, 0, 652, 0, 603, + 0, 0, 0, 0, 652, 0, 0, 0, 0, 627, + 701, 701, 701, 701, 701, 701, 701, 701, 701, 701, + + 702, 702, 702, 702, 702, 702, 702, 702, 702, 702, + 703, 703, 703, 703, 703, 703, 703, 703, 703, 703, + 704, 704, 0, 704, 704, 704, 704, 704, 704, 704, + 705, 705, 705, 705, 705, 705, 705, 705, 705, 705, + 706, 0, 706, 706, 706, 706, 707, 707, 0, 707, + 707, 0, 707, 707, 707, 707, 708, 708, 708, 708, + 708, 708, 708, 708, 708, 708, 709, 709, 709, 709, + 709, 709, 709, 709, 709, 709, 710, 710, 711, 711, + 711, 711, 711, 711, 711, 711, 711, 711, 712, 0, + 0, 0, 0, 0, 0, 712, 712, 713, 713, 0, + + 713, 713, 713, 713, 713, 713, 713, 714, 714, 0, + 0, 714, 714, 714, 714, 714, 714, 715, 0, 0, + 0, 0, 715, 715, 715, 715, 716, 716, 0, 0, + 716, 716, 716, 716, 716, 716, 717, 717, 717, 717, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700, 700, 700, 700, 700, 700, 700, + 700, 700, 700, 700 + } ; + +static yy_state_type yy_last_accepting_state; +static char *yy_last_accepting_cpos; + +extern int yy_flex_debug; +int yy_flex_debug = 0; + +/* The intent behind this definition is that it'll catch + * any uses of REJECT which flex missed. + */ +#define REJECT reject_used_but_not_detected +#define yymore() yymore_used_but_not_detected +#define YY_MORE_ADJ 0 +#define YY_RESTORE_YY_MORE_OFFSET +char *yytext; +#line 1 "token.l" +/* Tokens and token sequence arrays. */ +#line 3 "token.l" +/* #includes */ /*{{{C}}}*//*{{{*/ +#include <nuttx/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" + +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 */ /*{{{*/ + +/*}}}*/ +#line 1463 "<stdout>" + +#define INITIAL 0 +#define DATAINPUT 1 +#define ELSEIF 2 +#define IMAGEFMT 3 + +#ifndef YY_NO_UNISTD_H +/* Special case for "unistd.h", since it is non-ANSI. We include it way + * down here because we want the user's section 1 to have been scanned first. + * The user has a chance to override it with an option. + */ +#include <unistd.h> +#endif + +#ifndef YY_EXTRA_TYPE +#define YY_EXTRA_TYPE void * +#endif + +static int yy_init_globals (void ); + +/* Accessor methods to globals. + These are made visible to non-reentrant scanners for convenience. */ + +int yylex_destroy (void ); + +int yyget_debug (void ); + +void yyset_debug (int debug_flag ); + +YY_EXTRA_TYPE yyget_extra (void ); + +void yyset_extra (YY_EXTRA_TYPE user_defined ); + +FILE *yyget_in (void ); + +void yyset_in (FILE * in_str ); + +FILE *yyget_out (void ); + +void yyset_out (FILE * out_str ); + +yy_size_t yyget_leng (void ); + +char *yyget_text (void ); + +int yyget_lineno (void ); + +void yyset_lineno (int line_number ); + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef YY_SKIP_YYWRAP +#ifdef __cplusplus +extern "C" int yywrap (void ); +#else +extern int yywrap (void ); +#endif +#endif + +#ifndef yytext_ptr +static void yy_flex_strncpy (char *,yyconst char *,int ); +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * ); +#endif + +#ifndef YY_NO_INPUT + +#ifdef __cplusplus +static int yyinput (void ); +#else +static int input (void ); +#endif + +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef YY_READ_BUF_SIZE +#ifdef __ia64__ +/* On IA-64, the buffer size is 16k, not 8k */ +#define YY_READ_BUF_SIZE 16384 +#else +#define YY_READ_BUF_SIZE 8192 +#endif /* __ia64__ */ +#endif + +/* Copy whatever the last rule matched to the standard output. */ +#ifndef ECHO +/* This used to be an fputs(), but since the string might contain NUL's, + * we now use fwrite(). + */ +#define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, + * is returned in "result". + */ +#ifndef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ + { \ + int c = '*'; \ + size_t n; \ + for ( n = 0; n < max_size && \ + (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( yyin ) ) \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else \ + { \ + errno=0; \ + while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \ + { \ + if( errno != EINTR) \ + { \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + break; \ + } \ + errno=0; \ + clearerr(yyin); \ + } \ + }\ +\ + +#endif + +/* No semi-colon after return; correct usage is to write "yyterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef yyterminate +#define yyterminate() return YY_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef YY_START_STACK_INCR +#define YY_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) +#endif + +/* end tables serialization structures and prototypes */ + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef YY_DECL +#define YY_DECL_IS_OURS 1 + +extern int yylex (void); + +#define YY_DECL int yylex (void) +#endif /* !YY_DECL */ + +/* Code executed at the beginning of each rule, after yytext and yyleng + * have been set up. + */ +#ifndef YY_USER_ACTION +#define YY_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef YY_BREAK +#define YY_BREAK break; +#endif + +#define YY_RULE_SETUP \ + YY_USER_ACTION + +/** The main scanner function which does all the work. + */ +YY_DECL +{ + register yy_state_type yy_current_state; + register char *yy_cp, *yy_bp; + register int yy_act; + + if ( !(yy_init) ) + { + (yy_init) = 1; + +#ifdef YY_USER_INIT + YY_USER_INIT; +#endif + + if ( ! (yy_start) ) + (yy_start) = 1; /* first start state */ + + if ( ! yyin ) + yyin = stdin; + + if ( ! yyout ) + yyout = stdout; + + if ( ! YY_CURRENT_BUFFER ) { + yyensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer(yyin,YY_BUF_SIZE ); + } + + yy_load_buffer_state( ); + } + + { +#line 102 "token.l" + + /* flex rules */ /*{{{*/ + if (matchdata) BEGIN(DATAINPUT); + +#line 1683 "<stdout>" + + while ( 1 ) /* loops until end-of-file is reached */ + { + yy_cp = (yy_c_buf_p); + + /* Support of yytext. */ + *yy_cp = (yy_hold_char); + + /* yy_bp points to the position in yy_ch_buf of the start of + * the current run. + */ + yy_bp = yy_cp; + + yy_current_state = (yy_start); +yy_match: + do + { + register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 701 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + ++yy_cp; + } + while ( yy_base[yy_current_state] != 3041 ); + +yy_find_action: + yy_act = yy_accept[yy_current_state]; + if ( yy_act == 0 ) + { /* have to back up */ + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + yy_act = yy_accept[yy_current_state]; + } + + YY_DO_BEFORE_ACTION; + +do_action: /* This label is used only to access EOF actions. */ + + switch ( yy_act ) + { /* beginning of action switch */ + case 0: /* must back up */ + /* undo the effects of YY_DO_BEFORE_ACTION */ + *yy_cp = (yy_hold_char); + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + goto yy_find_action; + +case 1: +YY_RULE_SETUP +#line 106 "token.l" +return T_CHANNEL; + YY_BREAK +case 2: +YY_RULE_SETUP +#line 107 "token.l" +{ + 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; + } + YY_BREAK +case 3: +YY_RULE_SETUP +#line 121 "token.l" +{ + 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; + } + YY_BREAK +case 4: +YY_RULE_SETUP +#line 143 "token.l" +{ + 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; + } + YY_BREAK +case 5: +YY_RULE_SETUP +#line 157 "token.l" +{ + 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; + } + YY_BREAK +case 6: +/* rule 6 can match eol */ +YY_RULE_SETUP +#line 171 "token.l" +string(yytext); return T_STRING; + YY_BREAK +case 7: +/* rule 7 can match eol */ +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +YY_LINENO_REWIND_TO(yy_cp - 1); +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 172 "token.l" +string2(); return T_STRING; + YY_BREAK +case 8: +YY_RULE_SETUP +#line 173 "token.l" +return T_OP; + YY_BREAK +case 9: +YY_RULE_SETUP +#line 174 "token.l" +return T_CP; + YY_BREAK +case 10: +YY_RULE_SETUP +#line 175 "token.l" +return T_MULT; + YY_BREAK +case 11: +YY_RULE_SETUP +#line 176 "token.l" +return T_PLUS; + YY_BREAK +case 12: +YY_RULE_SETUP +#line 177 "token.l" +return T_MINUS; + YY_BREAK +case 13: +YY_RULE_SETUP +#line 178 "token.l" +return T_COMMA; + YY_BREAK +case 14: +YY_RULE_SETUP +#line 179 "token.l" +return T_DIV; + YY_BREAK +case 15: +YY_RULE_SETUP +#line 180 "token.l" +{ + if (backslash_colon) + { + if (cur) cur->statement=stmt_COLON_EOL; + return T_COLON; + } + return T_IDIV; + } + YY_BREAK +case 16: +YY_RULE_SETUP +#line 188 "token.l" +{ + if (cur) + { + cur->statement=stmt_COLON_EOL; + } + return T_COLON; + } + YY_BREAK +case 17: +YY_RULE_SETUP +#line 195 "token.l" +return T_SEMICOLON; + YY_BREAK +case 18: +YY_RULE_SETUP +#line 196 "token.l" +return T_LT; + YY_BREAK +case 19: +YY_RULE_SETUP +#line 197 "token.l" +return T_LE; + YY_BREAK +case 20: +YY_RULE_SETUP +#line 198 "token.l" +return T_LE; + YY_BREAK +case 21: +YY_RULE_SETUP +#line 199 "token.l" +return T_NE; + YY_BREAK +case 22: +YY_RULE_SETUP +#line 200 "token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_EQ; + } + YY_BREAK +case 23: +YY_RULE_SETUP +#line 207 "token.l" +return T_GT; + YY_BREAK +case 24: +YY_RULE_SETUP +#line 208 "token.l" +return T_GE; + YY_BREAK +case 25: +YY_RULE_SETUP +#line 209 "token.l" +return T_GE; + YY_BREAK +case 26: +YY_RULE_SETUP +#line 210 "token.l" +return T_POW; + YY_BREAK +case 27: +YY_RULE_SETUP +#line 211 "token.l" +return T_ACCESS_READ; + YY_BREAK +case 28: +YY_RULE_SETUP +#line 212 "token.l" +return T_ACCESS_READ_WRITE; + YY_BREAK +case 29: +YY_RULE_SETUP +#line 213 "token.l" +return T_ACCESS_WRITE; + YY_BREAK +case 30: +YY_RULE_SETUP +#line 214 "token.l" +return T_AND; + YY_BREAK +case 31: +YY_RULE_SETUP +#line 215 "token.l" +return T_AS; + YY_BREAK +case 32: +YY_RULE_SETUP +#line 216 "token.l" +{ + if (cur) + { + cur->statement=stmt_CALL; + } + return T_CALL; + } + YY_BREAK +case 33: +YY_RULE_SETUP +#line 223 "token.l" +{ + if (cur) + { + cur->statement=stmt_CASE; + cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEELSE; + } + YY_BREAK +case 34: +YY_RULE_SETUP +#line 231 "token.l" +{ + if (cur) + { + cur->statement=stmt_CASE; + cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEVALUE; + } + YY_BREAK +case 35: +YY_RULE_SETUP +#line 239 "token.l" +{ + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_CHDIR; + } + YY_BREAK +case 36: +YY_RULE_SETUP +#line 246 "token.l" +{ + if (cur) + { + cur->statement=stmt_CLEAR; + } + return T_CLEAR; + } + YY_BREAK +case 37: +YY_RULE_SETUP +#line 253 "token.l" +{ + if (cur) + { + cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } + YY_BREAK +case 38: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 5; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 260 "token.l" +{ + if (cur) + { + cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } + YY_BREAK +case 39: +YY_RULE_SETUP +#line 267 "token.l" +{ + if (cur) + { + cur->statement=stmt_CLS; + } + return T_CLS; + } + YY_BREAK +case 40: +YY_RULE_SETUP +#line 274 "token.l" +{ + if (cur) + { + cur->statement=stmt_COLOR; + } + return T_COLOR; + } + YY_BREAK +case 41: +YY_RULE_SETUP +#line 281 "token.l" +return T_CON; + YY_BREAK +case 42: +YY_RULE_SETUP +#line 282 "token.l" +{ + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_COPY; + } + YY_BREAK +case 43: +YY_RULE_SETUP +#line 289 "token.l" +{ + BEGIN(DATAINPUT); + if (cur) + { + cur->statement=stmt_DATA; + } + return T_DATA; + } + YY_BREAK +case 44: +/* rule 44 can match eol */ +YY_RULE_SETUP +#line 297 "token.l" +string(yytext); return T_STRING; + YY_BREAK +case 45: +/* rule 45 can match eol */ +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +YY_LINENO_REWIND_TO(yy_cp - 1); +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 298 "token.l" +string2(); return T_STRING; + YY_BREAK +case 46: +YY_RULE_SETUP +#line 299 "token.l" +return T_COMMA; + YY_BREAK +case 47: +YY_RULE_SETUP +#line 300 "token.l" +{ + if (cur) cur->u.datainput=strcpy(malloc(strlen(yytext)+1),yytext); + return T_DATAINPUT; + } + YY_BREAK +case 48: +YY_RULE_SETUP +#line 304 "token.l" + + YY_BREAK +case 49: +/* rule 49 can match eol */ +YY_RULE_SETUP +#line 305 "token.l" +BEGIN(INITIAL); + YY_BREAK +case 50: +YY_RULE_SETUP +#line 306 "token.l" +BEGIN(INITIAL); return T_COLON; + YY_BREAK +case 51: +YY_RULE_SETUP +#line 307 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_DEC; + } + YY_BREAK +case 52: +YY_RULE_SETUP +#line 314 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFDBL; + } + YY_BREAK +case 53: +YY_RULE_SETUP +#line 321 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFINT; + } + YY_BREAK +case 54: +YY_RULE_SETUP +#line 328 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFSTR; + } + YY_BREAK +case 55: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 335 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFFN; + } + YY_BREAK +case 56: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 343 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFPROC; + } + YY_BREAK +case 57: +YY_RULE_SETUP +#line 351 "token.l" +{ + if (cur) + { + cur->statement=stmt_DELETE; + } + return T_DELETE; + } + YY_BREAK +case 58: +YY_RULE_SETUP +#line 358 "token.l" +{ + if (cur) + { + cur->statement=stmt_DIM; + } + return T_DIM; + } + YY_BREAK +case 59: +YY_RULE_SETUP +#line 365 "token.l" +{ + if (cur) + { + cur->statement=stmt_DISPLAY; + } + return T_DISPLAY; + } + YY_BREAK +case 60: +YY_RULE_SETUP +#line 372 "token.l" +{ + if (cur) + { + cur->statement=stmt_DO; + } + return T_DO; + } + YY_BREAK +case 61: +YY_RULE_SETUP +#line 379 "token.l" +{ + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOUNTIL; + } + YY_BREAK +case 62: +YY_RULE_SETUP +#line 386 "token.l" +{ + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOWHILE; + } + YY_BREAK +case 63: +YY_RULE_SETUP +#line 393 "token.l" +{ + if (cur) + { + cur->statement=stmt_EDIT; + } + return T_EDIT; + } + YY_BREAK +case 64: +YY_RULE_SETUP +#line 400 "token.l" +{ + if (cur) + { + cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSE; + } + YY_BREAK +case 65: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 4; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 407 "token.l" +{ + BEGIN(ELSEIF); + if (cur) + { + cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSEIFELSE; + } + YY_BREAK +case 66: +YY_RULE_SETUP +#line 415 "token.l" +{ + BEGIN(INITIAL); + if (cur) + { + cur->statement=stmt_IF_ELSEIFIF; + } + return T_ELSEIFIF; + } + YY_BREAK +case 67: +YY_RULE_SETUP +#line 423 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDFN; + } + return T_ENDFN; + } + YY_BREAK +case 68: +YY_RULE_SETUP +#line 430 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDIF; + } + return T_ENDIF; + } + YY_BREAK +case 69: +YY_RULE_SETUP +#line 437 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_ENDPROC; + } + YY_BREAK +case 70: +YY_RULE_SETUP +#line 444 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDSELECT; + } + return T_ENDSELECT; + } + YY_BREAK +case 71: +YY_RULE_SETUP +#line 451 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } + YY_BREAK +case 72: +YY_RULE_SETUP +#line 458 "token.l" +{ + if (cur) + { + cur->statement=stmt_END; + } + return T_END; + } + YY_BREAK +case 73: +YY_RULE_SETUP +#line 465 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENVIRON; + } + return T_ENVIRON; + } + YY_BREAK +case 74: +YY_RULE_SETUP +#line 472 "token.l" +{ + if (cur) + { + cur->statement=stmt_ERASE; + } + return T_ERASE; + } + YY_BREAK +case 75: +YY_RULE_SETUP +#line 479 "token.l" +return T_EQV; + YY_BREAK +case 76: +YY_RULE_SETUP +#line 480 "token.l" +{ + if (cur) + { + cur->statement=stmt_EXITDO; + } + return T_EXITDO; + } + YY_BREAK +case 77: +YY_RULE_SETUP +#line 487 "token.l" +{ + if (cur) + { + cur->statement=stmt_EXITFOR; + } + return T_EXITFOR; + } + YY_BREAK +case 78: +YY_RULE_SETUP +#line 494 "token.l" +{ + if (cur) + { + cur->statement=stmt_FNEXIT; + } + return T_FNEXIT; + } + YY_BREAK +case 79: +YY_RULE_SETUP +#line 501 "token.l" +{ + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } + YY_BREAK +case 80: +YY_RULE_SETUP +#line 508 "token.l" +{ + if (cur) + { + cur->statement=stmt_FIELD; + } + return T_FIELD; + } + YY_BREAK +case 81: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 5; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 515 "token.l" +{ + if (cur) + { + cur->statement=stmt_FIELD; + } + return T_FIELD; + } + YY_BREAK +case 82: +YY_RULE_SETUP +#line 522 "token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNEND; + } + YY_BREAK +case 83: +YY_RULE_SETUP +#line 529 "token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNRETURN; + } + YY_BREAK +case 84: +YY_RULE_SETUP +#line 536 "token.l" +{ + if (cur) + { + cur->statement=stmt_FOR; + } + return T_FOR; + } + YY_BREAK +case 85: +YY_RULE_SETUP +#line 543 "token.l" +return T_FOR_INPUT; + YY_BREAK +case 86: +YY_RULE_SETUP +#line 544 "token.l" +return T_FOR_OUTPUT; + YY_BREAK +case 87: +YY_RULE_SETUP +#line 545 "token.l" +return T_FOR_APPEND; + YY_BREAK +case 88: +YY_RULE_SETUP +#line 546 "token.l" +return T_FOR_RANDOM; + YY_BREAK +case 89: +YY_RULE_SETUP +#line 547 "token.l" +return T_FOR_BINARY; + YY_BREAK +case 90: +YY_RULE_SETUP +#line 548 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_FUNCTION; + } + YY_BREAK +case 91: +YY_RULE_SETUP +#line 556 "token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_GET; + } + YY_BREAK +case 92: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 563 "token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_GET; + } + YY_BREAK +case 93: +YY_RULE_SETUP +#line 570 "token.l" +{ + if (cur) + { + cur->statement=stmt_GOSUB; + } + return T_GOSUB; + } + YY_BREAK +case 94: +YY_RULE_SETUP +#line 577 "token.l" +{ + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_GOTO; + } + YY_BREAK +case 95: +YY_RULE_SETUP +#line 584 "token.l" +return T_IDN; + YY_BREAK +case 96: +YY_RULE_SETUP +#line 585 "token.l" +{ + if (cur) + { + cur->statement=stmt_IF_ELSEIFIF; + } + return T_IF; + } + YY_BREAK +case 97: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 592 "token.l" +{ + BEGIN(IMAGEFMT); + if (cur) + { + cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } + YY_BREAK +case 98: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 600 "token.l" +{ + 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; + } + YY_BREAK +case 99: +YY_RULE_SETUP +#line 613 "token.l" +{ + if (cur) + { + cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } + YY_BREAK +case 100: +YY_RULE_SETUP +#line 620 "token.l" +return T_IMP; + YY_BREAK +case 101: +YY_RULE_SETUP +#line 621 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_INC; + } + YY_BREAK +case 102: +YY_RULE_SETUP +#line 628 "token.l" +{ + if (cur) + { + cur->statement=stmt_INPUT; + } + return T_INPUT; + } + YY_BREAK +case 103: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 5; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 635 "token.l" +{ + if (cur) + { + cur->statement=stmt_INPUT; + } + return T_INPUT; + } + YY_BREAK +case 104: +YY_RULE_SETUP +#line 642 "token.l" +return T_INV; + YY_BREAK +case 105: +YY_RULE_SETUP +#line 643 "token.l" +return T_IS; + YY_BREAK +case 106: +YY_RULE_SETUP +#line 644 "token.l" +{ + if (cur) + { + cur->statement=stmt_KILL; + } + return T_KILL; + } + YY_BREAK +case 107: +YY_RULE_SETUP +#line 651 "token.l" +{ + if (cur) + { + cur->statement=stmt_LET; + } + return T_LET; + } + YY_BREAK +case 108: +YY_RULE_SETUP +#line 658 "token.l" +{ + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LIST; + } + YY_BREAK +case 109: +YY_RULE_SETUP +#line 665 "token.l" +{ + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LLIST; + } + YY_BREAK +case 110: +YY_RULE_SETUP +#line 672 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOAD; + } + return T_LOAD; + } + YY_BREAK +case 111: +YY_RULE_SETUP +#line 679 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOCAL; + } + return T_LOCAL; + } + YY_BREAK +case 112: +YY_RULE_SETUP +#line 686 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOCATE; + } + return T_LOCATE; + } + YY_BREAK +case 113: +YY_RULE_SETUP +#line 693 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_LOCK; + } + YY_BREAK +case 114: +YY_RULE_SETUP +#line 700 "token.l" +return T_LOCK_READ; + YY_BREAK +case 115: +YY_RULE_SETUP +#line 701 "token.l" +return T_LOCK_WRITE; + YY_BREAK +case 116: +YY_RULE_SETUP +#line 702 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOOP; + } + return T_LOOP; + } + YY_BREAK +case 117: +YY_RULE_SETUP +#line 709 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOOPUNTIL; + } + return T_LOOPUNTIL; + } + YY_BREAK +case 118: +YY_RULE_SETUP +#line 716 "token.l" +{ + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_LPRINT; + } + YY_BREAK +case 119: +YY_RULE_SETUP +#line 723 "token.l" +{ + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_LSET; + } + YY_BREAK +case 120: +YY_RULE_SETUP +#line 730 "token.l" +{ + if (cur) + { + cur->statement=stmt_MATINPUT; + } + return T_MATINPUT; + } + YY_BREAK +case 121: +YY_RULE_SETUP +#line 737 "token.l" +{ + if (cur) + { + cur->statement=stmt_MATPRINT; + } + return T_MATPRINT; + } + YY_BREAK +case 122: +YY_RULE_SETUP +#line 744 "token.l" +{ + if (cur) + { + cur->statement=stmt_MATREAD; + } + return T_MATREAD; + } + YY_BREAK +case 123: +YY_RULE_SETUP +#line 751 "token.l" +{ + if (cur) + { + cur->statement=stmt_MATREDIM; + } + return T_MATREDIM; + } + YY_BREAK +case 124: +YY_RULE_SETUP +#line 758 "token.l" +{ + if (cur) + { + cur->statement=stmt_MATWRITE; + } + return T_MATWRITE; + } + YY_BREAK +case 125: +YY_RULE_SETUP +#line 765 "token.l" +{ + if (cur) + { + cur->statement=stmt_MAT; + } + return T_MAT; + } + YY_BREAK +case 126: +YY_RULE_SETUP +#line 772 "token.l" +{ + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_MKDIR; + } + YY_BREAK +case 127: +YY_RULE_SETUP +#line 779 "token.l" +return T_MOD; + YY_BREAK +case 128: +YY_RULE_SETUP +#line 780 "token.l" +{ + if (cur) + { + cur->statement=stmt_NEW; + } + return T_NEW; + } + YY_BREAK +case 129: +YY_RULE_SETUP +#line 787 "token.l" +{ + if (cur) + { + cur->statement=stmt_NAME; + } + return T_NAME; + } + YY_BREAK +case 130: +YY_RULE_SETUP +#line 794 "token.l" +{ + if (cur) + { + cur->statement=stmt_NEXT; + cur->u.next=malloc(sizeof(struct Next)); + } + return T_NEXT; + } + YY_BREAK +case 131: +YY_RULE_SETUP +#line 802 "token.l" +return T_NOT; + YY_BREAK +case 132: +YY_RULE_SETUP +#line 803 "token.l" +{ + if (cur) + { + cur->statement=stmt_ONERROROFF; + } + return T_ONERROROFF; + } + YY_BREAK +case 133: +YY_RULE_SETUP +#line 810 "token.l" +{ + if (cur) + { + cur->statement=stmt_ONERRORGOTO0; + } + return T_ONERRORGOTO0; + } + YY_BREAK +case 134: +YY_RULE_SETUP +#line 817 "token.l" +{ + if (cur) + { + cur->statement=stmt_ONERROR; + } + return T_ONERROR; + } + YY_BREAK +case 135: +YY_RULE_SETUP +#line 824 "token.l" +{ + if (cur) + { + cur->statement=stmt_ON; + cur->u.on.pcLength=1; + cur->u.on.pc=(struct Pc*)0; + } + return T_ON; + } + YY_BREAK +case 136: +YY_RULE_SETUP +#line 833 "token.l" +{ + if (cur) + { + cur->statement=stmt_OPEN; + } + return T_OPEN; + } + YY_BREAK +case 137: +YY_RULE_SETUP +#line 840 "token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONBASE; + } + return T_OPTIONBASE; + } + YY_BREAK +case 138: +YY_RULE_SETUP +#line 847 "token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONRUN; + } + return T_OPTIONRUN; + } + YY_BREAK +case 139: +YY_RULE_SETUP +#line 854 "token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONSTOP; + } + return T_OPTIONSTOP; + } + YY_BREAK +case 140: +YY_RULE_SETUP +#line 861 "token.l" +return T_OR; + YY_BREAK +case 141: +YY_RULE_SETUP +#line 862 "token.l" +{ + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_OUT; + } + YY_BREAK +case 142: +YY_RULE_SETUP +#line 869 "token.l" +{ + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } + YY_BREAK +case 143: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 876 "token.l" +{ + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } + YY_BREAK +case 144: +YY_RULE_SETUP +#line 883 "token.l" +{ + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_POKE; + } + YY_BREAK +case 145: +YY_RULE_SETUP +#line 890 "token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_PUT; + } + YY_BREAK +case 146: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 897 "token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_PUT; + } + YY_BREAK +case 147: +YY_RULE_SETUP +#line 904 "token.l" +{ + if (cur) + { + cur->statement=stmt_RANDOMIZE; + } + return T_RANDOMIZE; + } + YY_BREAK +case 148: +YY_RULE_SETUP +#line 911 "token.l" +{ + if (cur) + { + cur->statement=stmt_READ; + } + return T_READ; + } + YY_BREAK +case 149: +YY_RULE_SETUP +#line 918 "token.l" +{ + if (cur) + { + cur->statement=stmt_RENUM; + } + return T_RENUM; + } + YY_BREAK +case 150: +YY_RULE_SETUP +#line 925 "token.l" +{ + if (cur) + { + cur->statement=stmt_REPEAT; + } + return T_REPEAT; + } + YY_BREAK +case 151: +YY_RULE_SETUP +#line 932 "token.l" +{ + if (cur) + { + cur->statement=stmt_RESTORE; + } + return T_RESTORE; + } + YY_BREAK +case 152: +YY_RULE_SETUP +#line 939 "token.l" +{ + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_RESUME; + } + YY_BREAK +case 153: +YY_RULE_SETUP +#line 946 "token.l" +{ + if (cur) + { + cur->statement=stmt_RETURN; + } + return T_RETURN; + } + YY_BREAK +case 154: +YY_RULE_SETUP +#line 953 "token.l" +{ + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_RSET; + } + YY_BREAK +case 155: +YY_RULE_SETUP +#line 960 "token.l" +{ + if (cur) + { + cur->statement=stmt_RUN; + } + return T_RUN; + } + YY_BREAK +case 156: +YY_RULE_SETUP +#line 967 "token.l" +{ + if (cur) + { + cur->statement=stmt_SAVE; + } + return T_SAVE; + } + YY_BREAK +case 157: +YY_RULE_SETUP +#line 974 "token.l" +{ + if (cur) + { + cur->statement=stmt_SELECTCASE; + cur->u.selectcase=malloc(sizeof(struct Selectcase)); + } + return T_SELECTCASE; + } + YY_BREAK +case 158: +YY_RULE_SETUP +#line 982 "token.l" +return T_SHARED; + YY_BREAK +case 159: +YY_RULE_SETUP +#line 983 "token.l" +{ + if (cur) + { + cur->statement=stmt_SHELL; + } + return T_SHELL; + } + YY_BREAK +case 160: +YY_RULE_SETUP +#line 990 "token.l" +{ + if (cur) + { + cur->statement=stmt_SLEEP; + } + return T_SLEEP; + } + YY_BREAK +case 161: +YY_RULE_SETUP +#line 997 "token.l" +return T_SPC; + YY_BREAK +case 162: +YY_RULE_SETUP +#line 998 "token.l" +return T_STEP; + YY_BREAK +case 163: +YY_RULE_SETUP +#line 999 "token.l" +{ + if (cur) + { + cur->statement=stmt_STOP; + } + return T_STOP; + } + YY_BREAK +case 164: +YY_RULE_SETUP +#line 1006 "token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } + YY_BREAK +case 165: +YY_RULE_SETUP +#line 1013 "token.l" +{ + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } + YY_BREAK +case 166: +YY_RULE_SETUP +#line 1020 "token.l" +{ + if (cur) + { + cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + cur->u.localSyms=(struct Symbol*)0; + } + return T_SUB; + } + YY_BREAK +case 167: +YY_RULE_SETUP +#line 1028 "token.l" +{ + if (cur) + { + cur->statement=stmt_SWAP; + } + return T_SWAP; + } + YY_BREAK +case 168: +YY_RULE_SETUP +#line 1035 "token.l" +{ + if (cur) + { + cur->statement=stmt_SYSTEM; + } + return T_SYSTEM; + } + YY_BREAK +case 169: +YY_RULE_SETUP +#line 1042 "token.l" +return T_THEN; + YY_BREAK +case 170: +YY_RULE_SETUP +#line 1043 "token.l" +return T_TAB; + YY_BREAK +case 171: +YY_RULE_SETUP +#line 1044 "token.l" +return T_TO; + YY_BREAK +case 172: +YY_RULE_SETUP +#line 1045 "token.l" +return T_TRN; + YY_BREAK +case 173: +YY_RULE_SETUP +#line 1046 "token.l" +{ + if (cur) + { + cur->statement=stmt_TROFF; + } + return T_TROFF; + } + YY_BREAK +case 174: +YY_RULE_SETUP +#line 1053 "token.l" +{ + if (cur) + { + cur->statement=stmt_TRON; + } + return T_TRON; + } + YY_BREAK +case 175: +YY_RULE_SETUP +#line 1060 "token.l" +{ + if (cur) + { + cur->statement=stmt_TRUNCATE; + } + return T_TRUNCATE; + } + YY_BREAK +case 176: +YY_RULE_SETUP +#line 1067 "token.l" +{ + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_UNLOCK; + } + YY_BREAK +case 177: +YY_RULE_SETUP +#line 1074 "token.l" +{ + if (cur) + { + cur->statement=stmt_UNNUM; + } + return T_UNNUM; + } + YY_BREAK +case 178: +YY_RULE_SETUP +#line 1081 "token.l" +{ + if (cur) + { + cur->statement=stmt_UNTIL; + } + return T_UNTIL; + } + YY_BREAK +case 179: +YY_RULE_SETUP +#line 1088 "token.l" +return T_USING; + YY_BREAK +case 180: +YY_RULE_SETUP +#line 1089 "token.l" +{ + if (cur) + { + cur->statement=stmt_WAIT; + } + return T_WAIT; + } + YY_BREAK +case 181: +YY_RULE_SETUP +#line 1096 "token.l" +{ + if (cur) + { + cur->statement=stmt_WEND; + cur->u.whilepc=malloc(sizeof(struct Pc)); + } + return T_WEND; + } + YY_BREAK +case 182: +YY_RULE_SETUP +#line 1104 "token.l" +{ + if (cur) + { + cur->statement=stmt_WHILE; + cur->u.afterwend=malloc(sizeof(struct Pc)); + } + return T_WHILE; + } + YY_BREAK +case 183: +YY_RULE_SETUP +#line 1112 "token.l" +{ + if (cur) + { + cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } + YY_BREAK +case 184: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 5; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 1119 "token.l" +{ + if (cur) + { + cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } + YY_BREAK +case 185: +YY_RULE_SETUP +#line 1126 "token.l" +{ + if (cur) + { + cur->statement=stmt_WRITE; + } + return T_WRITE; + } + YY_BREAK +case 186: +*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ +(yy_c_buf_p) = yy_cp = yy_bp + 5; +YY_DO_BEFORE_ACTION; /* set up yytext again */ +YY_RULE_SETUP +#line 1133 "token.l" +{ + if (cur) + { + cur->statement=stmt_WRITE; + } + return T_WRITE; + } + YY_BREAK +case 187: +YY_RULE_SETUP +#line 1140 "token.l" +return T_XOR; + YY_BREAK +case 188: +YY_RULE_SETUP +#line 1141 "token.l" +{ + if (cur) + { + cur->statement=stmt_XREF; + } + return T_XREF; + } + YY_BREAK +case 189: +YY_RULE_SETUP +#line 1148 "token.l" +return T_ZER; + YY_BREAK +case 190: +YY_RULE_SETUP +#line 1149 "token.l" +{ + if (cur) + { + cur->statement=stmt_ZONE; + } + return T_ZONE; + } + YY_BREAK +case 191: +YY_RULE_SETUP +#line 1156 "token.l" +{ + if (cur) + { + cur->statement=stmt_QUOTE_REM; + cur->u.rem=strcpy(malloc(strlen(yytext+3)+1),yytext+3); + } + return T_REM; + } + YY_BREAK +case 192: +YY_RULE_SETUP +#line 1164 "token.l" +{ + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_RENAME; + } + YY_BREAK +case 193: +YY_RULE_SETUP +#line 1171 "token.l" +{ + if (cur) + { + cur->statement=stmt_QUOTE_REM; + strcpy(cur->u.rem=malloc(strlen(yytext+1)+1),yytext+1); + } + return T_QUOTE; + } + YY_BREAK +case 194: +YY_RULE_SETUP +#line 1179 "token.l" +{ + if (cur) + { + cur->statement=stmt_LINEINPUT; + } + return T_LINEINPUT; + } + YY_BREAK +case 195: +YY_RULE_SETUP +#line 1186 "token.l" +{ + 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; + } + YY_BREAK +case 196: +/* rule 196 can match eol */ +YY_RULE_SETUP +#line 1225 "token.l" + + YY_BREAK +case 197: +YY_RULE_SETUP +#line 1226 "token.l" +{ + if (cur) cur->u.junk=yytext[0]; + return T_JUNK; + } + YY_BREAK +/*}}}*/ +case 198: +YY_RULE_SETUP +#line 1231 "token.l" +ECHO; + YY_BREAK +#line 3711 "<stdout>" +case YY_STATE_EOF(INITIAL): +case YY_STATE_EOF(DATAINPUT): +case YY_STATE_EOF(ELSEIF): +case YY_STATE_EOF(IMAGEFMT): + yyterminate(); + + case YY_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; + + /* Undo the effects of YY_DO_BEFORE_ACTION. */ + *yy_cp = (yy_hold_char); + YY_RESTORE_YY_MORE_OFFSET + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed yyin at a new source and called + * yylex(). If so, then we have to assure + * consistency between YY_CURRENT_BUFFER and our + * globals. Here is the right place to do so, because + * this is the first action (other than possibly a + * back-up) that will match for the new input source. + */ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; + } + + /* Note that here we test for yy_c_buf_p "<=" to the position + * of the first EOB in the buffer, since yy_c_buf_p will + * already have been incremented past the NUL character + * (since all states make transitions on EOB to the + * end-of-buffer state). Contrast this with the test + * in input(). + */ + if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + { /* This was really a NUL. */ + yy_state_type yy_next_state; + + (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * yy_get_previous_state() go ahead and do it + * for us because it doesn't know how to deal + * with the possibility of jamming (and we don't + * want to build jamming into it because then it + * will run more slowly). + */ + + yy_next_state = yy_try_NUL_trans( yy_current_state ); + + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + + if ( yy_next_state ) + { + /* Consume the NUL. */ + yy_cp = ++(yy_c_buf_p); + yy_current_state = yy_next_state; + goto yy_match; + } + + else + { + yy_cp = (yy_c_buf_p); + goto yy_find_action; + } + } + + else switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_END_OF_FILE: + { + (yy_did_buffer_switch_on_eof) = 0; + + if ( yywrap( ) ) + { + /* Note: because we've taken care in + * yy_get_next_buffer() to have set up + * yytext, we can now set up + * yy_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * YY_NULL, it'll still work - another + * YY_NULL will get returned. + */ + (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; + + yy_act = YY_STATE_EOF(YY_START); + goto do_action; + } + + else + { + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = + (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_match; + + case EOB_ACT_LAST_MATCH: + (yy_c_buf_p) = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_find_action; + } + break; + } + + default: + YY_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ + } /* end of user's declarations */ +} /* end of yylex */ + +/* yy_get_next_buffer - try to read in a new buffer + * + * Returns a code representing an action: + * EOB_ACT_LAST_MATCH - + * EOB_ACT_CONTINUE_SCAN - continue scanning from current position + * EOB_ACT_END_OF_FILE - end of file + */ +static int yy_get_next_buffer (void) +{ + register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; + register char *source = (yytext_ptr); + register int number_to_move, i; + int ret_val; + + if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) + YY_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) + { + /* We matched a single character, the EOB, so + * treat this as a final EOF. + */ + return EOB_ACT_END_OF_FILE; + } + + else + { + /* We matched some text prior to the EOB, first + * process it. + */ + return EOB_ACT_LAST_MATCH; + } + } + + /* Try to read more data. */ + + /* First move last chars to start of buffer. */ + number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1; + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; + + else + { + yy_size_t num_to_read = + YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ + + /* just a shorter name for the current buffer */ + YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; + + int yy_c_buf_p_offset = + (int) ((yy_c_buf_p) - b->yy_ch_buf); + + if ( b->yy_is_our_buffer ) + { + yy_size_t new_size = b->yy_buf_size * 2; + + if ( new_size <= 0 ) + b->yy_buf_size += b->yy_buf_size / 8; + else + b->yy_buf_size *= 2; + + b->yy_ch_buf = (char *) + /* Include room in for 2 EOB chars. */ + yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 ); + } + else + /* Can't grow it, we don't own it. */ + b->yy_ch_buf = 0; + + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( + "fatal error - scanner input buffer overflow" ); + + (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; + + num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - + number_to_move - 1; + + } + + if ( num_to_read > YY_READ_BUF_SIZE ) + num_to_read = YY_READ_BUF_SIZE; + + /* Read in more data. */ + YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), + (yy_n_chars), num_to_read ); + + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + if ( (yy_n_chars) == 0 ) + { + if ( number_to_move == YY_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + yyrestart(yyin ); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = + YY_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { + /* Extend the array by 50%, plus the number we really need. */ + yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ); + if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); + } + + (yy_n_chars) += number_to_move; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; + + (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; + + return ret_val; +} + +/* yy_get_previous_state - get the state just before the EOB char was reached */ + + static yy_state_type yy_get_previous_state (void) +{ + register yy_state_type yy_current_state; + register char *yy_cp; + + yy_current_state = (yy_start); + + for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) + { + register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 701 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + } + + return yy_current_state; +} + +/* yy_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = yy_try_NUL_trans( current_state ); + */ + static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) +{ + register int yy_is_jam; + register char *yy_cp = (yy_c_buf_p); + + register YY_CHAR yy_c = 1; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 701 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + yy_is_jam = (yy_current_state == 700); + + return yy_is_jam ? 0 : yy_current_state; +} + +#ifndef YY_NO_INPUT +#ifdef __cplusplus + static int yyinput (void) +#else + static int input (void) +#endif + +{ + int c; + + *(yy_c_buf_p) = (yy_hold_char); + + if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) + { + /* yy_c_buf_p now points to the character we want to return. + * If this occurs *before* the EOB characters, then it's a + * valid NUL; if not, then we've hit the end of the buffer. + */ + if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + /* This was really a NUL. */ + *(yy_c_buf_p) = '\0'; + + else + { /* need more input */ + yy_size_t offset = (yy_c_buf_p) - (yytext_ptr); + ++(yy_c_buf_p); + + switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because yy_g_n_b() + * sees that we've accumulated a + * token and flags that we need to + * try matching the token before + * proceeding. But for input(), + * there's no matching to consider. + * So convert the EOB_ACT_LAST_MATCH + * to EOB_ACT_END_OF_FILE. + */ + + /* Reset buffer status. */ + yyrestart(yyin ); + + /*FALLTHROUGH*/ + + case EOB_ACT_END_OF_FILE: + { + if ( yywrap( ) ) + return EOF; + + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; +#ifdef __cplusplus + return yyinput(); +#else + return input(); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = (yytext_ptr) + offset; + break; + } + } + } + + c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ + *(yy_c_buf_p) = '\0'; /* preserve yytext */ + (yy_hold_char) = *++(yy_c_buf_p); + + return c; +} +#endif /* ifndef YY_NO_INPUT */ + +/** Immediately switch to a different input stream. + * @param input_file A readable stream. + * + * @note This function does not reset the start condition to @c INITIAL . + */ + void yyrestart (FILE * input_file ) +{ + + if ( ! YY_CURRENT_BUFFER ){ + yyensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer(yyin,YY_BUF_SIZE ); + } + + yy_init_buffer(YY_CURRENT_BUFFER,input_file ); + yy_load_buffer_state( ); +} + +/** Switch to a different input buffer. + * @param new_buffer The new input buffer. + * + */ + void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) +{ + + /* TODO. We should be able to replace this entire function body + * with + * yypop_buffer_state(); + * yypush_buffer_state(new_buffer); + */ + yyensure_buffer_stack (); + if ( YY_CURRENT_BUFFER == new_buffer ) + return; + + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + YY_CURRENT_BUFFER_LVALUE = new_buffer; + yy_load_buffer_state( ); + + /* We don't actually know whether we did this switch during + * EOF (yywrap()) processing, but the only time this flag + * is looked at is after yywrap() is called, so it's safe + * to go ahead and always set it. + */ + (yy_did_buffer_switch_on_eof) = 1; +} + +static void yy_load_buffer_state (void) +{ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; + yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; + (yy_hold_char) = *(yy_c_buf_p); +} + +/** Allocate and initialize an input buffer state. + * @param file A readable stream. + * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. + * + * @return the allocated buffer state. + */ + YY_BUFFER_STATE yy_create_buffer (FILE * file, int size ) +{ + YY_BUFFER_STATE b; + + b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_buf_size = size; + + /* yy_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 ); + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_is_our_buffer = 1; + + yy_init_buffer(b,file ); + + return b; +} + +/** Destroy the buffer. + * @param b a buffer created with yy_create_buffer() + * + */ + void yy_delete_buffer (YY_BUFFER_STATE b ) +{ + + if ( ! b ) + return; + + if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ + YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; + + if ( b->yy_is_our_buffer ) + yyfree((void *) b->yy_ch_buf ); + + yyfree((void *) b ); +} + +/* Initializes or reinitializes a buffer. + * This function is sometimes called more than once on the same buffer, + * such as during a yyrestart() or at EOF. + */ + +static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file ) +{ + int oerrno = errno; + + yy_flush_buffer(b ); + + b->yy_input_file = file; + b->yy_fill_buffer = 1; + + /* If b is the current buffer, then yy_init_buffer was _probably_ + * called from yyrestart() or through yy_get_next_buffer. + * In that case, we don't want to reset the lineno or column. + */ + + if (b != YY_CURRENT_BUFFER) + { + b->yy_bs_lineno = 1; + b->yy_bs_column = 0; + } + +#ifdef CONFIG_SERIAL_TERMIOS + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; +#else + b->yy_is_interactive = 1; +#endif + + errno = oerrno; +} + +/** Discard all buffered characters. On the next scan, YY_INPUT will be called. + * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. + * + */ + void yy_flush_buffer (YY_BUFFER_STATE b ) +{ + if ( ! b ) + return; + + b->yy_n_chars = 0; + + /* We always need two end-of-buffer characters. The first causes + * a transition to the end-of-buffer state. The second causes + * a jam in that state. + */ + b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; + b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; + + b->yy_buf_pos = &b->yy_ch_buf[0]; + + b->yy_at_bol = 1; + b->yy_buffer_status = YY_BUFFER_NEW; + + if ( b == YY_CURRENT_BUFFER ) + yy_load_buffer_state( ); +} + +/** Pushes the new state onto the stack. The new state becomes + * the current state. This function will allocate the stack + * if necessary. + * @param new_buffer The new state. + * + */ +void yypush_buffer_state (YY_BUFFER_STATE new_buffer ) +{ + if (new_buffer == NULL) + return; + + yyensure_buffer_stack(); + + /* This block is copied from yy_switch_to_buffer. */ + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + /* Only push if top exists. Otherwise, replace top. */ + if (YY_CURRENT_BUFFER) + (yy_buffer_stack_top)++; + YY_CURRENT_BUFFER_LVALUE = new_buffer; + + /* copied from yy_switch_to_buffer. */ + yy_load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; +} + +/** Removes and deletes the top of the stack, if present. + * The next element becomes the new top. + * + */ +void yypop_buffer_state (void) +{ + if (!YY_CURRENT_BUFFER) + return; + + yy_delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + if ((yy_buffer_stack_top) > 0) + --(yy_buffer_stack_top); + + if (YY_CURRENT_BUFFER) { + yy_load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; + } +} + +/* Allocates the stack if it does not exist. + * Guarantees space for at least one push. + */ +static void yyensure_buffer_stack (void) +{ + yy_size_t num_to_alloc; + + if (!(yy_buffer_stack)) { + + /* First allocation is just for 2 elements, since we don't know if this + * scanner will even need a stack. We use 2 instead of 1 to avoid an + * immediate realloc on the next call. + */ + num_to_alloc = 1; + (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc + (num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); + + (yy_buffer_stack_max) = num_to_alloc; + (yy_buffer_stack_top) = 0; + return; + } + + if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ + + /* Increase the buffer to prepare for a possible push. */ + int grow_size = 8 /* arbitrary grow size */; + + num_to_alloc = (yy_buffer_stack_max) + grow_size; + (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc + ((yy_buffer_stack), + num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + /* zero only the new slots.*/ + memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); + (yy_buffer_stack_max) = num_to_alloc; + } +} + +/** Setup the input buffer state to scan directly from a user-specified character buffer. + * @param base the character buffer + * @param size the size in bytes of the character buffer + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size ) +{ + YY_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != YY_END_OF_BUFFER_CHAR || + base[size-1] != YY_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return 0; + + b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); + + b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ + b->yy_buf_pos = b->yy_ch_buf = base; + b->yy_is_our_buffer = 0; + b->yy_input_file = 0; + b->yy_n_chars = b->yy_buf_size; + b->yy_is_interactive = 0; + b->yy_at_bol = 1; + b->yy_fill_buffer = 0; + b->yy_buffer_status = YY_BUFFER_NEW; + + yy_switch_to_buffer(b ); + + return b; +} + +/** Setup the input buffer state to scan a string. The next call to yylex() will + * scan from a @e copy of @a str. + * @param yystr a NUL-terminated string to scan + * + * @return the newly allocated buffer state object. + * @note If you want to scan bytes that may contain NUL values, then use + * yy_scan_bytes() instead. + */ +YY_BUFFER_STATE yy_scan_string (yyconst char * yystr ) +{ + + return yy_scan_bytes(yystr,strlen(yystr) ); +} + +/** Setup the input buffer state to scan the given bytes. The next call to yylex() will + * scan from a @e copy of @a bytes. + * @param yybytes the byte buffer to scan + * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len ) +{ + YY_BUFFER_STATE b; + char *buf; + yy_size_t n; + yy_size_t i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = _yybytes_len + 2; + buf = (char *) yyalloc(n ); + if ( ! buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); + + for ( i = 0; i < _yybytes_len; ++i ) + buf[i] = yybytes[i]; + + buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; + + b = yy_scan_buffer(buf,n ); + if ( ! b ) + YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->yy_is_our_buffer = 1; + + return b; +} + +#ifndef YY_EXIT_FAILURE +#define YY_EXIT_FAILURE 2 +#endif + +static void yy_fatal_error (yyconst char* msg ) +{ + (void) fprintf( stderr, "%s\n", msg ); + exit( YY_EXIT_FAILURE ); +} + +/* Redefine yyless() so it works in section 3 code. */ + +#undef yyless +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + yytext[yyleng] = (yy_hold_char); \ + (yy_c_buf_p) = yytext + yyless_macro_arg; \ + (yy_hold_char) = *(yy_c_buf_p); \ + *(yy_c_buf_p) = '\0'; \ + yyleng = yyless_macro_arg; \ + } \ + while ( 0 ) + +/* Accessor methods (get/set functions) to struct members. */ + +/** Get the current line number. + * + */ +int yyget_lineno (void) +{ + + return yylineno; +} + +/** Get the input stream. + * + */ +FILE *yyget_in (void) +{ + return yyin; +} + +/** Get the output stream. + * + */ +FILE *yyget_out (void) +{ + return yyout; +} + +/** Get the length of the current token. + * + */ +yy_size_t yyget_leng (void) +{ + return yyleng; +} + +/** Get the current token. + * + */ + +char *yyget_text (void) +{ + return yytext; +} + +/** Set the current line number. + * @param line_number + * + */ +void yyset_lineno (int line_number ) +{ + + yylineno = line_number; +} + +/** Set the input stream. This does not discard the current + * input buffer. + * @param in_str A readable stream. + * + * @see yy_switch_to_buffer + */ +void yyset_in (FILE * in_str ) +{ + yyin = in_str ; +} + +void yyset_out (FILE * out_str ) +{ + yyout = out_str ; +} + +int yyget_debug (void) +{ + return yy_flex_debug; +} + +void yyset_debug (int bdebug ) +{ + yy_flex_debug = bdebug ; +} + +static int yy_init_globals (void) +{ + /* Initialization is the same as for the non-reentrant scanner. + * This function is called from yylex_destroy(), so don't allocate here. + */ + + (yy_buffer_stack) = 0; + (yy_buffer_stack_top) = 0; + (yy_buffer_stack_max) = 0; + (yy_c_buf_p) = (char *) 0; + (yy_init) = 0; + (yy_start) = 0; + +/* Defined in main.c */ +#ifdef YY_STDINIT + yyin = stdin; + yyout = stdout; +#else + yyin = (FILE *) 0; + yyout = (FILE *) 0; +#endif + + /* For future reference: Set errno on error, since we are called by + * yylex_init() + */ + return 0; +} + +/* yylex_destroy is for both reentrant and non-reentrant scanners. */ +int yylex_destroy (void) +{ + + /* Pop the buffer stack, destroying each element. */ + while(YY_CURRENT_BUFFER){ + yy_delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + yypop_buffer_state(); + } + + /* Destroy the stack itself. */ + yyfree((yy_buffer_stack) ); + (yy_buffer_stack) = NULL; + + /* Reset the globals. This is important in a non-reentrant scanner so the next time + * yylex() is called, initialization will occur. */ + yy_init_globals( ); + + return 0; +} + +/* + * Internal utility routines. + */ + +#ifndef yytext_ptr +static void yy_flex_strncpy (char* s1, yyconst char * s2, int n ) +{ + register int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; +} +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * s ) +{ + register int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; +} +#endif + +void *yyalloc (yy_size_t size ) +{ + return (void *) malloc( size ); +} + +void *yyrealloc (void * ptr, yy_size_t size ) +{ + /* The cast to (char *) in the following accommodates both + * implementations that use char* generic pointers, and those + * that use void* generic pointers. It works with the latter + * because both ANSI C and C++ allow castless assignment from + * any pointer type to void*, and deal with argument conversions + * as though doing an assignment. + */ + return (void *) realloc( (char *) ptr, size ); +} + +void yyfree (void * ptr ) +{ + free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ +} + +#define YYTABLES_NAME "yytables" + +#line 1230 "token.l" + + + +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/token.h b/apps/interpreters/bas/token.h new file mode 100644 index 000000000..b6f24cec8 --- /dev/null +++ b/apps/interpreters/bas/token.h @@ -0,0 +1,546 @@ +/**************************************************************************** + * apps/interpreters/bas/token.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_TOKEN_H +#define __APPS_EXAMPLES_BAS_TOKEN_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "autotypes.h" +#include "value.h" +#include "var.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#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)) + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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; +}; + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +extern int Token_property[]; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Token *Token_newCode(const char *ln); +struct Token *Token_newData(const char *ln); +void Token_destroy(struct Token *token); +struct String *Token_toString(struct Token *token, struct Token *spaceto, + struct String *s, int *indent, int full); +void Token_init(int backslash_colon, int uppercase); + +#endif /* __APPS_EXAMPLES_BAS_TOKEN_H */ 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..db2ed1130 --- /dev/null +++ b/apps/interpreters/bas/value.c @@ -0,0 +1,2098 @@ +/**************************************************************************** + * apps/interpreters/bas/value.c + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <assert.h> +#include <ctype.h> +#include <errno.h> +#include <float.h> +#include <limits.h> +#include <math.h> +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "error.h" +#include "value.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +static const char *typestr[] = +{ + (const char *)0, + (const char *)0, + "integer", + (const char *)0, + "real", + "string", + "void" +}; + +/* for xgettext */ + +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 } +}; + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +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; + } + } + } + } +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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; +} + +long int lrint(double d) +{ + return d; +} diff --git a/apps/interpreters/bas/value.h b/apps/interpreters/bas/value.h new file mode 100644 index 000000000..56e62a01e --- /dev/null +++ b/apps/interpreters/bas/value.h @@ -0,0 +1,182 @@ +/**************************************************************************** + * apps/interpreters/bas/value.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_VALUE_H +#define __APPS_EXAMPLES_BAS_VALUE_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "str.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#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; + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +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; +}; + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +extern const enum ValueType Value_commonType[V_VOID+1][V_VOID+1]; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +long int lrint(double d); +double Value_trunc(double d); +double Value_round(double d); +long int Value_toi(double d, int *overflow); +long int Value_vali(const char *s, char **end, int *overflow); +double Value_vald(const char *s, char **end, int *overflow); + +struct Value *Value_new_NIL(struct Value *this); +struct Value *Value_new_ERROR(struct Value *this, int code, + const char *error, ...); +struct Value *Value_new_INTEGER(struct Value *this, int n); +struct Value *Value_new_REAL(struct Value *this, double n); +struct Value *Value_new_STRING(struct Value *this); +struct Value *Value_new_VOID(struct Value *this); +struct Value *Value_new_null(struct Value *this, enum ValueType type); +int Value_isNull(const struct Value *this); +void Value_destroy(struct Value *this); +void Value_errorPrefix(struct Value *this, const char *prefix); +void Value_errorSuffix(struct Value *this, const char *suffix); +struct Value *Value_new_typeError(struct Value *this, enum ValueType t1, + enum ValueType t2); +struct Value *Value_retype(struct Value *this, enum ValueType type); +struct Value *Value_clone(struct Value *this, const struct Value *original); +struct Value *Value_uplus(struct Value *this, int calc); +struct Value *Value_uneg(struct Value *this, int calc); +struct Value *Value_unot(struct Value *this, int calc); +struct Value *Value_add(struct Value *this, struct Value *x, int calc); +struct Value *Value_sub(struct Value *this, struct Value *x, int calc); +struct Value *Value_mult(struct Value *this, struct Value *x, int calc); +struct Value *Value_div(struct Value *this, struct Value *x, int calc); +struct Value *Value_idiv(struct Value *this, struct Value *x, int calc); +struct Value *Value_mod(struct Value *this, struct Value *x, int calc); +struct Value *Value_pow(struct Value *this, struct Value *x, int calc); +struct Value *Value_and(struct Value *this, struct Value *x, int calc); +struct Value *Value_or(struct Value *this, struct Value *x, int calc); +struct Value *Value_xor(struct Value *this, struct Value *x, int calc); +struct Value *Value_eqv(struct Value *this, struct Value *x, int calc); +struct Value *Value_imp(struct Value *this, struct Value *x, int calc); +struct Value *Value_lt(struct Value *this, struct Value *x, int calc); +struct Value *Value_le(struct Value *this, struct Value *x, int calc); +struct Value *Value_eq(struct Value *this, struct Value *s, int calc); +struct Value *Value_ge(struct Value *this, struct Value *x, int calc); +struct Value *Value_gt(struct Value *this, struct Value *x, int calc); +struct Value *Value_ne(struct Value *this, struct Value *x, int calc); +int Value_exitFor(struct Value *this, struct Value *limit, + struct Value *step); +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); +struct Value *Value_toStringUsing(struct Value *this, struct String *s, + struct String *using, size_t *usingpos); +struct String *Value_toWrite(struct Value *this, struct String *s); +struct Value *Value_nullValue(enum ValueType type); + +#endif /* __APPS_EXAMPLES_BAS_VALUE_H */ diff --git a/apps/interpreters/bas/var.c b/apps/interpreters/bas/var.c new file mode 100644 index 000000000..f0fb934b9 --- /dev/null +++ b/apps/interpreters/bas/var.c @@ -0,0 +1,717 @@ +/**************************************************************************** + * apps/interpreters/bas/var.c + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <assert.h> +#include <math.h> +#include <stdlib.h> + +#include "error.h" +#include "var.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +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 + * diagonal */ + { + 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]; + + /* Subtract 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 diagonal */ + { + 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..afec8ba95 --- /dev/null +++ b/apps/interpreters/bas/var.h @@ -0,0 +1,115 @@ +/**************************************************************************** + * apps/interpreters/bas/var.h + * + * 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. + * + * Adapted to NuttX and re-released under a 3-clause BSD license: + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Authors: Alan Carvalho de Assis <Alan Carvalho de Assis> + * 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. + * + ****************************************************************************/ + +#ifndef __APPS_EXAMPLES_BAS_VAR_H +#define __APPS_EXAMPLES_BAS_VAR_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "value.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define VAR_SCALAR_VALUE(this) ((this)->value) + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +struct Var +{ + unsigned int dim; + unsigned int *geometry; + struct Value *value; + unsigned int size; + enum ValueType type; + char base; +}; + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +struct Var *Var_new(struct Var *this, enum ValueType type, unsigned int dim, + const unsigned int *geometry, int base); +struct Var *Var_new_scalar(struct Var *this); +void Var_destroy(struct Var *this); +void Var_retype(struct Var *this, enum ValueType type); +struct Value *Var_value(struct Var *this, unsigned int dim, int idx[], + struct Value *value); +void Var_clear(struct Var *this); +struct Value *Var_mat_assign(struct Var *this, struct Var *x, + struct Value *err, int work); +struct Value *Var_mat_addsub(struct Var *this, struct Var *x, struct Var *y, + int add, struct Value *err, int work); +struct Value *Var_mat_mult(struct Var *this, struct Var *x, struct Var *y, + struct Value *err, int work); +struct Value *Var_mat_scalarMult(struct Var *this, struct Value *factor, + struct Var *x, int work); +void Var_mat_transpose(struct Var *this, struct Var *x); +struct Value *Var_mat_invert(struct Var *this, struct Var *x, + struct Value *det, struct Value *err); +struct Value *Var_mat_redim(struct Var *this, unsigned int dim, + const unsigned int *geometry, + struct Value *err); + +#endif /* __APPS_EXAMPLES_BAS_VAR_H */ diff --git a/apps/interpreters/bas/vt100.c b/apps/interpreters/bas/vt100.c new file mode 100644 index 000000000..45bee9852 --- /dev/null +++ b/apps/interpreters/bas/vt100.c @@ -0,0 +1,319 @@ +/**************************************************************************** + * apps/interpreters/bas/vt100.c + * + * Copyright (C) 2014 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. + * + ****************************************************************************/ + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <sys/stat.h> +#include <stdio.h> + +#include <nuttx/vt100.h> + +#include "fs.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +/* VT100 escape sequences */ + +#if 0 /* Not used */ +static const char g_cursoron[] = VT100_CURSORON; +static const char g_cursoroff[] = VT100_CURSOROFF; +static const char g_cursorhome[] = VT100_CURSORHOME; +static const char g_erasetoeol[] = VT100_CLEAREOL; +#endif +static const char g_clrscreen[] = VT100_CLEARSCREEN; +#if 0 /* Not used */ +static const char g_index[] = VT100_INDEX; +static const char g_revindex[] = VT100_REVINDEX; +static const char g_attriboff[] = VT100_MODESOFF; +static const char g_boldon[] = VT100_BOLD; +static const char g_reverseon[] = VT100_REVERSE; +static const char g_blinkon[] = VT100_BLINK; +static const char g_boldoff[] = VT100_BOLDOFF; +static const char g_reverseoff[] = VT100_REVERSEOFF; +static const char g_blinkoff[] = VT100_BLINKOFF; +#endif + +static const char g_fmtcursorpos[] = VT100_FMT_CURSORPOS; + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +/**************************************************************************** + * Name: vt100_write + * + * Description: + * Write a sequence of bytes to the channel device + * + ****************************************************************************/ + +static void vt100_write(int chn, FAR const char *buffer, size_t buflen) +{ + for (; buflen > 0; buflen--) + { + FS_putChar(chn, *buffer++); + } +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +/**************************************************************************** + * Name: vt100_blinkon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_blinkon(int chn) +{ + /* Send the VT100 BLINKON command */ + + vt100_write(chn, g_blinkon, sizeof(g_blinkon)); +} +#endif + +/**************************************************************************** + * Name: vt100_boldon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_boldon(int chn) +{ + /* Send the VT100 BOLDON command */ + + vt100_write(chn, g_boldon, sizeof(g_boldon)); +} +#endif + +/**************************************************************************** + * Name: vt100_reverseon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_reverseon(int chn) +{ + /* Send the VT100 REVERSON command */ + + vt100_write(chn, g_reverseon, sizeof(g_reverseon)); +} +#endif + +/**************************************************************************** + * Name: + * + * Description: + * Disable all previously selected attributes. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_attriboff(int chn) +{ + /* Send the VT100 ATTRIBOFF command */ + + vt100_write(chn, g_attriboff, sizeof(g_attriboff)); +} +#endif + +/**************************************************************************** + * Name: vt100_cursoron + * + * Description: + * Turn on the cursor + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursoron(int chn) +{ + /* Send the VT100 CURSORON command */ + + vt100_write(chn, g_cursoron, sizeof(g_cursoron)); +} +#endif + +/**************************************************************************** + * Name: vt100_cursoroff + * + * Description: + * Turn off the cursor + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursoroff(int chn) +{ + /* Send the VT100 CURSOROFF command */ + + vt100_write(chn, g_cursoroff, sizeof(g_cursoroff)); +} +#endif + +/**************************************************************************** + * Name: vt100_cursorhome + * + * Description: + * Move the current cursor to the upper left hand corner of the display + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursorhome(int chn) +{ + /* Send the VT100 CURSORHOME command */ + + vt100_write(chn, g_cursorhome, sizeof(g_cursorhome)); +} +#endif + +/**************************************************************************** + * Name: vt100_setcursor + * + * Description: + * Move the current cursor position to position (row,col) + * + ****************************************************************************/ + +void vt100_setcursor(int chn, uint16_t row, uint16_t column) +{ + char buffer[16]; + int len; + + /* Format the cursor position command. The origin is (1,1). */ + + len = snprintf(buffer, 16, g_fmtcursorpos, row + 1, column + 1); + + /* Send the VT100 CURSORPOS command */ + + vt100_write(chn, buffer, len); +} + +/**************************************************************************** + * Name: vt100_clrtoeol + * + * Description: + * Clear the display from the current cursor position to the end of the + * current line. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_clrtoeol(int chn) +{ + /* Send the VT100 ERASETOEOL command */ + + vt100_write(chn, g_erasetoeol, sizeof(g_erasetoeol)); +} +#endif + +/**************************************************************************** + * Name: vt100_clrscreen + * + * Description: + * Clear the entire display + * + ****************************************************************************/ + +void vt100_clrscreen(int chn) +{ + /* Send the VT100 CLRSCREEN command */ + + vt100_write(chn, g_clrscreen, sizeof(g_clrscreen)); +} + +/**************************************************************************** + * Name: vt100_scrollup + * + * Description: + * Scroll the display up 'nlines' by sending the VT100 INDEX command. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_scrollup(int chn, uint16_t nlines) +{ + /* Scroll for the specified number of lines */ + + for (; nlines; nlines--) + { + /* Send the VT100 INDEX command */ + + vt100_write(chn, g_index, sizeof(g_index)); + } +} +#endif + +/**************************************************************************** + * Name: vt100_scrolldown + * + * Description: + * Scroll the display down 'nlines' by sending the VT100 REVINDEX command. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_scrolldown(int chn, uint16_t nlines) +{ + /* Scroll for the specified number of lines */ + + for (; nlines; nlines--) + { + /* Send the VT100 REVINDEX command */ + + vt100_write(chn, g_revindex, sizeof(g_revindex)); + } +#endif diff --git a/apps/interpreters/bas/vt100.h b/apps/interpreters/bas/vt100.h new file mode 100644 index 000000000..28fb227ed --- /dev/null +++ b/apps/interpreters/bas/vt100.h @@ -0,0 +1,217 @@ +/**************************************************************************** + * apps/interpreters/bas/vt100.h + * + * Copyright (C) 2014 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. + * + ****************************************************************************/ + +#ifndef __APPS_INTERPRETERS_BAS_VT100_H +#define __APPS_INTERPRETERS_BAS_VT100_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include <nuttx/config.h> + +#include <stdint.h> + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +/**************************************************************************** + * Public Types + ****************************************************************************/ + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +#ifdef __cplusplus +#define EXTERN extern "C" +extern "C" +{ +#else +#define EXTERN extern +#endif + +/**************************************************************************** + * Public Function Prototypes + ****************************************************************************/ + +/**************************************************************************** + * Name: vt100_blinkon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_blinkon(int chn); +#endif + +/**************************************************************************** + * Name: vt100_boldon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_boldon(int chn); +#endif + +/**************************************************************************** + * Name: vt100_reverseon + * + * Description: + * Enable the blinking attribute at the current cursor location + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_reverseon(int chn); +#endif + +/**************************************************************************** + * Name: + * + * Description: + * Disable all previously selected attributes. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_attriboff(int chn); +#endif + +/**************************************************************************** + * Name: vt100_cursoron + * + * Description: + * Turn on the cursor + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursoron(int chn); +#endif + +/**************************************************************************** + * Name: vt100_cursoroff + * + * Description: + * Turn off the cursor + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursoroff(int chn); +#endif + +/**************************************************************************** + * Name: vt100_cursorhome + * + * Description: + * Move the current cursor to the upper left hand corner of the display + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_cursorhome(int chn); +#endif + +/**************************************************************************** + * Name: vt100_setcursor + * + * Description: + * Move the current cursor position to position (row,col) + * + ****************************************************************************/ + +void vt100_setcursor(int chn, uint16_t row, uint16_t column); + +/**************************************************************************** + * Name: vt100_clrtoeol + * + * Description: + * Clear the display from the current cursor position to the end of the + * current line. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_clrtoeol(int chn); +#endif + +/**************************************************************************** + * Name: vt100_clrscreen + * + * Description: + * Clear the entire display + * + ****************************************************************************/ + +void vt100_clrscreen(int chn); + +/**************************************************************************** + * Name: vt100_scrollup + * + * Description: + * Scroll the display up 'nlines' by sending the VT100 INDEX command. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_scrollup(int chn, uint16_t nlines); +#endif + +/**************************************************************************** + * Name: vt100_scrolldown + * + * Description: + * Scroll the display down 'nlines' by sending the VT100 REVINDEX command. + * + ****************************************************************************/ + +#if 0 /* Not used */ +void vt100_scrolldown(int chn, uint16_t nlines); +#endif + +#undef EXTERN +#ifdef __cplusplus +} +#endif + +#endif /* __APPS_INTERPRETERS_BAS_VT100_H */ |