From 2487d2b4d89578d6503e613bfff210ab0b89a3cc Mon Sep 17 00:00:00 2001 From: Gregory Nutt Date: Tue, 11 Nov 2014 12:34:00 -0600 Subject: Rename all C files in apps/interpreters/bas to begin with bas_ in order to avoid future name collisions in libapps.a --- apps/interpreters/bas/Makefile | 6 +- apps/interpreters/bas/auto.c | 375 -- apps/interpreters/bas/auto.h | 133 - apps/interpreters/bas/autotypes.h | 107 - apps/interpreters/bas/bas.c | 16 +- apps/interpreters/bas/bas.h | 2 +- apps/interpreters/bas/bas_auto.c | 375 ++ apps/interpreters/bas/bas_auto.h | 133 + apps/interpreters/bas/bas_autotypes.h | 107 + apps/interpreters/bas/bas_error.h | 188 + apps/interpreters/bas/bas_fs.c | 1909 +++++++++ apps/interpreters/bas/bas_fs.h | 198 + apps/interpreters/bas/bas_global.c | 2469 ++++++++++++ apps/interpreters/bas/bas_global.h | 111 + apps/interpreters/bas/bas_main.c | 204 + apps/interpreters/bas/bas_program.c | 1126 ++++++ apps/interpreters/bas/bas_program.h | 114 + apps/interpreters/bas/bas_programtypes.h | 99 + apps/interpreters/bas/bas_statement.c | 6354 ++++++++++++++++++++++++++++++ apps/interpreters/bas/bas_statement.h | 166 + apps/interpreters/bas/bas_str.c | 457 +++ apps/interpreters/bas/bas_str.h | 115 + apps/interpreters/bas/bas_token.c | 5388 +++++++++++++++++++++++++ apps/interpreters/bas/bas_token.h | 546 +++ apps/interpreters/bas/bas_token.l | 1938 +++++++++ apps/interpreters/bas/bas_value.c | 2098 ++++++++++ apps/interpreters/bas/bas_value.h | 182 + apps/interpreters/bas/bas_var.c | 717 ++++ apps/interpreters/bas/bas_var.h | 115 + apps/interpreters/bas/bas_vt100.c | 368 ++ apps/interpreters/bas/bas_vt100.h | 235 ++ apps/interpreters/bas/error.h | 188 - apps/interpreters/bas/fs.c | 1909 --------- apps/interpreters/bas/fs.h | 198 - apps/interpreters/bas/global.c | 2469 ------------ apps/interpreters/bas/global.h | 111 - apps/interpreters/bas/main.c | 204 - apps/interpreters/bas/program.c | 1126 ------ apps/interpreters/bas/program.h | 114 - apps/interpreters/bas/programtypes.h | 99 - apps/interpreters/bas/statement.c | 6354 ------------------------------ apps/interpreters/bas/statement.h | 166 - apps/interpreters/bas/str.c | 457 --- apps/interpreters/bas/str.h | 115 - apps/interpreters/bas/token.c | 5388 ------------------------- apps/interpreters/bas/token.h | 546 --- apps/interpreters/bas/token.l | 1944 --------- apps/interpreters/bas/value.c | 2098 ---------- apps/interpreters/bas/value.h | 182 - apps/interpreters/bas/var.c | 717 ---- apps/interpreters/bas/var.h | 115 - apps/interpreters/bas/vt100.c | 367 -- apps/interpreters/bas/vt100.h | 235 -- 53 files changed, 25724 insertions(+), 25729 deletions(-) delete mode 100644 apps/interpreters/bas/auto.c delete mode 100644 apps/interpreters/bas/auto.h delete mode 100644 apps/interpreters/bas/autotypes.h create mode 100644 apps/interpreters/bas/bas_auto.c create mode 100644 apps/interpreters/bas/bas_auto.h create mode 100644 apps/interpreters/bas/bas_autotypes.h create mode 100644 apps/interpreters/bas/bas_error.h create mode 100644 apps/interpreters/bas/bas_fs.c create mode 100644 apps/interpreters/bas/bas_fs.h create mode 100644 apps/interpreters/bas/bas_global.c create mode 100644 apps/interpreters/bas/bas_global.h create mode 100644 apps/interpreters/bas/bas_main.c create mode 100644 apps/interpreters/bas/bas_program.c create mode 100644 apps/interpreters/bas/bas_program.h create mode 100644 apps/interpreters/bas/bas_programtypes.h create mode 100644 apps/interpreters/bas/bas_statement.c create mode 100644 apps/interpreters/bas/bas_statement.h create mode 100644 apps/interpreters/bas/bas_str.c create mode 100644 apps/interpreters/bas/bas_str.h create mode 100644 apps/interpreters/bas/bas_token.c create mode 100644 apps/interpreters/bas/bas_token.h create mode 100644 apps/interpreters/bas/bas_token.l create mode 100644 apps/interpreters/bas/bas_value.c create mode 100644 apps/interpreters/bas/bas_value.h create mode 100644 apps/interpreters/bas/bas_var.c create mode 100644 apps/interpreters/bas/bas_var.h create mode 100644 apps/interpreters/bas/bas_vt100.c create mode 100644 apps/interpreters/bas/bas_vt100.h delete mode 100644 apps/interpreters/bas/error.h delete mode 100644 apps/interpreters/bas/fs.c delete mode 100644 apps/interpreters/bas/fs.h delete mode 100644 apps/interpreters/bas/global.c delete mode 100644 apps/interpreters/bas/global.h delete mode 100644 apps/interpreters/bas/main.c delete mode 100644 apps/interpreters/bas/program.c delete mode 100644 apps/interpreters/bas/program.h delete mode 100644 apps/interpreters/bas/programtypes.h delete mode 100644 apps/interpreters/bas/statement.c delete mode 100644 apps/interpreters/bas/statement.h delete mode 100644 apps/interpreters/bas/str.c delete mode 100644 apps/interpreters/bas/str.h delete mode 100644 apps/interpreters/bas/token.c delete mode 100644 apps/interpreters/bas/token.h delete mode 100644 apps/interpreters/bas/token.l delete mode 100644 apps/interpreters/bas/value.c delete mode 100644 apps/interpreters/bas/value.h delete mode 100644 apps/interpreters/bas/var.c delete mode 100644 apps/interpreters/bas/var.h delete mode 100644 apps/interpreters/bas/vt100.c delete mode 100644 apps/interpreters/bas/vt100.h (limited to 'apps/interpreters') diff --git a/apps/interpreters/bas/Makefile b/apps/interpreters/bas/Makefile index 819a69d0e..9414d820a 100644 --- a/apps/interpreters/bas/Makefile +++ b/apps/interpreters/bas/Makefile @@ -40,11 +40,11 @@ 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 +CSRCS = bas.c bas_auto.c bas_fs.c bas_global.c bas_main.c bas_program.c +CSRCS += bas_str.c bas_token.c bas_value.c bas_var.c ifeq ($(CONFIG_INTERPREPTER_BAS_VT100),y) -CSRCS += vt100.c +CSRCS += bas_vt100.c endif DEPPATH = --dep-path . diff --git a/apps/interpreters/bas/auto.c b/apps/interpreters/bas/auto.c deleted file mode 100644 index 5a807bc93..000000000 --- a/apps/interpreters/bas/auto.c +++ /dev/null @@ -1,375 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include - -#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 deleted file mode 100644 index 841ea5380..000000000 --- a/apps/interpreters/bas/auto.h +++ /dev/null @@ -1,133 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index ce736ca37..000000000 --- a/apps/interpreters/bas/autotypes.h +++ /dev/null @@ -1,107 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 index 0ab8eaf3d..fdbe67e14 100644 --- a/apps/interpreters/bas/bas.c +++ b/apps/interpreters/bas/bas.c @@ -79,14 +79,14 @@ #include #include -#include "auto.h" +#include "bas_auto.h" #include "bas.h" -#include "error.h" -#include "fs.h" -#include "global.h" -#include "program.h" -#include "value.h" -#include "var.h" +#include "bas_error.h" +#include "bas_fs.h" +#include "bas_global.h" +#include "bas_program.h" +#include "bas_value.h" +#include "bas_var.h" /**************************************************************************** * Pre-processor Definitions @@ -2256,7 +2256,7 @@ static struct Value *dataread(struct Value *value, struct Value *l) } static struct Value more_statements; -#include "statement.c" +#include "bas_statement.c" static struct Value *statements(struct Value *value) { more: diff --git a/apps/interpreters/bas/bas.h b/apps/interpreters/bas/bas.h index bf1700a96..ecea33cff 100644 --- a/apps/interpreters/bas/bas.h +++ b/apps/interpreters/bas/bas.h @@ -1,5 +1,5 @@ /**************************************************************************** - * apps/interpreters/bas/fs.h + * apps/interpreters/bas/bas.h * * Copyright (c) 1999-2014 Michael Haardt * diff --git a/apps/interpreters/bas/bas_auto.c b/apps/interpreters/bas/bas_auto.c new file mode 100644 index 000000000..016596c1e --- /dev/null +++ b/apps/interpreters/bas/bas_auto.c @@ -0,0 +1,375 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include + +#include "bas_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/bas_auto.h b/apps/interpreters/bas/bas_auto.h new file mode 100644 index 000000000..8d137bc57 --- /dev/null +++ b/apps/interpreters/bas/bas_auto.h @@ -0,0 +1,133 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_AUTO_H +#define __APPS_EXAMPLES_BAS_BAS_AUTO_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_programtypes.h" +#include "bas_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 "bas_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_BAS_AUTO_H */ diff --git a/apps/interpreters/bas/bas_autotypes.h b/apps/interpreters/bas/bas_autotypes.h new file mode 100644 index 000000000..815c8baf2 --- /dev/null +++ b/apps/interpreters/bas/bas_autotypes.h @@ -0,0 +1,107 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_BAS_AUTO_H + * then there are compile errors! Those compile errors occur because this + * function defines some of the same structures as does bas_auto.h. BUT, the + * definitions ARE NOT THE SAME. What is up with this? + */ + +#ifndef __APPS_EXAMPLES_BAS_BAS_AUTO_H +#define __APPS_EXAMPLES_BAS_BAS_AUTO_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_program.h" +#include "bas_var.h" +#include "bas_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_BAS_AUTO_H */ diff --git a/apps/interpreters/bas/bas_error.h b/apps/interpreters/bas/bas_error.h new file mode 100644 index 000000000..a39801ac6 --- /dev/null +++ b/apps/interpreters/bas/bas_error.h @@ -0,0 +1,188 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_ERROR_H +#define __APPS_EXAMPLES_BAS_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_BAS_ERROR_H */ diff --git a/apps/interpreters/bas/bas_fs.c b/apps/interpreters/bas/bas_fs.c new file mode 100644 index 000000000..51eb324d9 --- /dev/null +++ b/apps/interpreters/bas/bas_fs.c @@ -0,0 +1,1909 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#include "bas_vt100.h" +#include "bas_fs.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define LINEWIDTH 80 +#define COLWIDTH 14 + +#define _(String) String + +/**************************************************************************** + * Private Data + ****************************************************************************/ + +static struct FileStream **g_file; +static int g_capacity; +static int g_used; +static const int g_open_mode[4] = { 0, O_RDONLY, O_WRONLY, O_RDWR }; +static char g_errmsgbuf[80]; + +#ifdef CONFIG_INTERPREPTER_BAS_VT100 +static const uint8_t g_vt100_colormap[8] = +{ + VT100_BLACK, VT100_BLUE, VT100_GREEN, VT100_CYAN, + VT100_RED, VT100_MAGENTA, VT100_YELLOW, VT100_WHITE +}; +#endif + +/**************************************************************************** + * Public Data + ****************************************************************************/ + +const char *FS_errmsg; + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +static int size(int dev) +{ + if (dev >= g_capacity) + { + int i; + struct FileStream **n; + + n = (struct FileStream **) + realloc(g_file, (dev + 1) * sizeof(struct FileStream *)); + if (n == (struct FileStream **)0) + { + FS_errmsg = strerror(errno); + return -1; + } + + g_file = n; + for (i = g_capacity; i <= dev; ++i) + { + g_file[i] = (struct FileStream *)0; + } + + g_capacity = dev + 1; + } + + return 0; +} + +static int opened(int dev, int mode) +{ + int fd = -1; + + if (dev < 0 || dev >= g_capacity || g_file[dev] == (struct FileStream *)0) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), _("channel #%d not open"), + dev); + FS_errmsg = g_errmsgbuf; + return -1; + } + + if (mode == -1) + { + return 0; + } + + switch (mode) + { + case 0: + { + fd = g_file[dev]->outfd; + if (fd == -1) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), + _("channel #%d not opened for writing"), dev); + } + break; + } + + case 1: + { + fd = g_file[dev]->infd; + if (fd == -1) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), + _("channel #%d not opened for reading"), dev); + } + break; + } + + case 2: + { + fd = g_file[dev]->randomfd; + if (fd == -1) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), + _("channel #%d not opened for random access"), dev); + } + break; + } + + case 3: + { + fd = g_file[dev]->binaryfd; + if (fd == -1) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), + _("channel #%d not opened for binary access"), dev); + } + break; + } + + case 4: + { + fd = (g_file[dev]->randomfd != -1 ? g_file[dev]->randomfd : g_file[dev]->binaryfd); + if (fd == -1) + { + snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), + _("channel #%d not opened for random or binary access"), + dev); + } + break; + } + + default: + assert(0); + } + + if (fd == -1) + { + FS_errmsg = g_errmsgbuf; + return -1; + } + else + { + return 0; + } +} + +static int refill(int dev) +{ + struct FileStream *f; + ssize_t len; + + f = g_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 = g_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; + } + + /* Check for backspace + * + * There are several notions of backspace, for an elaborate summary see + * http://www.ibb.net/~anne/keyboard.html. There is no clean solution. + * Here both DEL and backspace are treated like backspace here. The + * Unix/Linux screen terminal by default outputs DEL (0x7f) when the + * backspace key is pressed. + */ + + if (ch == ASCII_BS || ch == ASCII_DEL) + { + 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); + vt100_cursorhome(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 + if (foreground >= 0) + { + vt100_foreground_color(chn, foreground); + } + + if (background >= 0) + { + vt100_background_color(chn, background); + } + + return 0; +#else + FS_errmsg = _("Set color operation no implemented"); + return -1; +#endif +} + +static int resetcolour(int chn) +{ +#ifdef CONFIG_INTERPREPTER_BAS_VT100 + vt100_foreground_color(chn, VT100_DEFAULT); + vt100_background_color(chn, VT100_DEFAULT); +#endif + return 0; +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +int FS_opendev(int chn, int infd, int outfd) +{ + if (size(chn) == -1) + { + return -1; + } + + if (g_file[chn] != (struct FileStream *)0) + { + FS_errmsg = _("channel already open"); + return -1; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->dev = 1; +#ifdef CONFIG_SERIAL_TERMIOS + g_file[chn]->tty = (infd == 0 ? isatty(infd) && isatty(outfd) : 0); +#else + g_file[chn]->tty = 1; +#endif + g_file[chn]->recLength = 1; + g_file[chn]->infd = infd; + g_file[chn]->inSize = 0; + g_file[chn]->inCapacity = 0; + g_file[chn]->outfd = outfd; + g_file[chn]->outPos = 0; + g_file[chn]->outLineWidth = LINEWIDTH; + g_file[chn]->outColWidth = COLWIDTH; + g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); + g_file[chn]->outSize = 0; + g_file[chn]->outforeground = -1; + g_file[chn]->outbackground = -1; + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 < g_capacity; ++chn) + { + if (g_file[chn] == (struct FileStream *)0) + { + break; + } + } + + if (size(chn) == -1) + { + return -1; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = 1; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = fd; + g_file[chn]->inSize = 0; + g_file[chn]->inCapacity = 0; + g_file[chn]->outfd = -1; + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 (g_file[chn] != (struct FileStream *)0) + { + FS_errmsg = _("channel already open"); + return -1; + } + + fl = g_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; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = 1; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = fd; + g_file[chn]->inSize = 0; + g_file[chn]->inCapacity = 0; + g_file[chn]->outfd = -1; + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 < g_capacity; ++chn) + { + if (g_file[chn] == (struct FileStream *)0) + { + break; + } + } + + if (size(chn) == -1) + { + return -1; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = 1; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = -1; + g_file[chn]->outfd = fd; + g_file[chn]->outPos = 0; + g_file[chn]->outLineWidth = LINEWIDTH; + g_file[chn]->outColWidth = COLWIDTH; + g_file[chn]->outSize = 0; + g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 (g_file[chn] != (struct FileStream *)0) + { + FS_errmsg = _("channel already open"); + return -1; + } + + fl = g_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; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = 1; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = -1; + g_file[chn]->outfd = fd; + g_file[chn]->outPos = 0; + g_file[chn]->outLineWidth = LINEWIDTH; + g_file[chn]->outColWidth = COLWIDTH; + g_file[chn]->outSize = 0; + g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 (g_file[chn] != (struct FileStream *)0) + { + FS_errmsg = _("channel already open"); + return -1; + } + + if ((fd = open(name, g_open_mode[mode] | O_CREAT, 0666)) == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = recLength; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = -1; + g_file[chn]->outfd = -1; + g_file[chn]->randomfd = fd; + g_file[chn]->recBuf = malloc(recLength); + memset(g_file[chn]->recBuf, 0, recLength); + StringField_new(&g_file[chn]->field); + g_file[chn]->binaryfd = -1; + FS_errmsg = (const char *)0; + ++g_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 (g_file[chn] != (struct FileStream *)0) + { + FS_errmsg = _("channel already open"); + return -1; + } + + if ((fd = open(name, g_open_mode[mode] | O_CREAT, 0666)) == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + + g_file[chn] = malloc(sizeof(struct FileStream)); + g_file[chn]->recLength = 1; + g_file[chn]->dev = 0; + g_file[chn]->tty = 0; + g_file[chn]->infd = -1; + g_file[chn]->outfd = -1; + g_file[chn]->randomfd = -1; + g_file[chn]->binaryfd = fd; + FS_errmsg = (const char *)0; + ++g_used; + return chn; +} + +int FS_freechn(void) +{ + int i; + + for (i = 0; i < g_capacity && g_file[i]; ++i); + if (size(i) == -1) + { + return -1; + } + + return i; +} + +int FS_flush(int dev) +{ + ssize_t written; + size_t offset; + + if (g_file[dev] == (struct FileStream *)0) + { + FS_errmsg = _("channel not open"); + return -1; + } + + offset = 0; + while (offset < g_file[dev]->outSize) + { + written = + write(g_file[dev]->outfd, g_file[dev]->outBuf + offset, + g_file[dev]->outSize - offset); + if (written == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + else + { + offset += written; + } + } + + g_file[dev]->outSize = 0; + FS_errmsg = (const char *)0; + return 0; +} + +int FS_close(int dev) +{ + if (g_file[dev] == (struct FileStream *)0) + { + FS_errmsg = _("channel not open"); + return -1; + } + + if (g_file[dev]->outfd >= 0) + { + if (g_file[dev]->tty && + (g_file[dev]->outforeground != -1 || g_file[dev]->outbackground != -1)) + { + resetcolour(dev); + } + + FS_flush(dev); + close(g_file[dev]->outfd); + } + + if (g_file[dev]->randomfd >= 0) + { + StringField_destroy(&g_file[dev]->field); + free(g_file[dev]->recBuf); + close(g_file[dev]->randomfd); + } + + if (g_file[dev]->binaryfd >= 0) + { + close(g_file[dev]->binaryfd); + } + + if (g_file[dev]->infd >= 0) + { + close(g_file[dev]->infd); + } + + free(g_file[dev]); + g_file[dev] = (struct FileStream *)0; + FS_errmsg = (const char *)0; + if (--g_used == 0) + { + free(g_file); + g_file = (struct FileStream **)0; + g_capacity = 0; + } + + return 0; +} + +#ifdef CONFIG_SERIAL_TERMIOS +int FS_istty(int chn) +{ + return (g_file[chn] && g_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 (g_file[chn] == (struct FileStream *)0) + { + FS_errmsg = _("channel not open"); + return -1; + } + + if ((fd = g_file[chn]->infd) == -1) + { + if ((fd = g_file[chn]->outfd) == -1) + { + if ((fd = g_file[chn]->randomfd) == -1) + { + if ((fd = g_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 (g_file[chn] == (struct FileStream *)0) + { + FS_errmsg = _("channel not open"); + return -1; + } + + if ((fd = g_file[chn]->infd) == -1) + { + if ((fd = g_file[chn]->outfd) == -1) + { + if ((fd = g_file[chn]->randomfd) == -1) + { + if ((fd = g_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 < g_file[chn]->recLength) + { + written = + write(g_file[chn]->randomfd, g_file[chn]->recBuf + offset, + g_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 = g_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 = g_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(g_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(g_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(g_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(g_file[chn]->binaryfd, s->character, s->length)) != s->length) + { + if (len == -1) + { + FS_errmsg = strerror(errno); + } + else + { + FS_errmsg = _("End of g_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(g_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(g_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 = g_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 = g_file[dev]; + if (f->outPos && FS_putChar(dev, '\n') == -1) + { + return -1; + } + + return 0; +} + +int FS_tab(int dev, int position) +{ + struct FileStream *f = g_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; + } + + g_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; + } + + g_file[dev]->outColWidth = zone; + return 0; +} + +int FS_cls(int chn) +{ + struct FileStream *f; + + if (opened(chn, 0) == -1) + { + return -1; + } + + f = g_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 = g_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 = g_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 = g_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 < g_file[chn]->recLength) + { + rd = + read(g_file[chn]->randomfd, g_file[chn]->recBuf + offset, + g_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 = g_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 = g_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 (g_file[chn]->infd != -1) + { + fd = g_file[chn]->infd; + offset = -g_file[chn]->inCapacity + g_file[chn]->inSize; + } + else if (g_file[chn]->outfd != -1) + { + fd = g_file[chn]->outfd; + offset = g_file[chn]->outSize; + } + else if (g_file[chn]->randomfd != -1) + { + fd = g_file[chn]->randomfd; + } + else + { + fd = g_file[chn]->binaryfd; + } + + assert(fd != -1); + if ((cur = lseek(fd, 0, SEEK_CUR)) == -1) + { + FS_errmsg = strerror(errno); + return -1; + } + + return (cur + offset) / g_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 (g_file[chn]->infd != -1) + { + fd = g_file[chn]->infd; + } + else if (g_file[chn]->outfd != -1) + { + fd = g_file[chn]->outfd; + } + else if (g_file[chn]->randomfd != -1) + { + fd = g_file[chn]->randomfd; + } + else + { + fd = g_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 / g_file[chn]->recLength); +} + +long int FS_recLength(int chn) +{ + if (opened(chn, 2) == -1) + { + return -1; + } + + return g_file[chn]->recLength; +} + +void FS_field(int chn, struct String *s, long int position, long int length) +{ + assert(g_file[chn]); + String_joinField(s, &g_file[chn]->field, g_file[chn]->recBuf + position, length); +} + +int FS_seek(int chn, long int record) +{ + if (opened(chn, 2) != -1) + { + if (lseek + (g_file[chn]->randomfd, (off_t) record * g_file[chn]->recLength, + SEEK_SET) != -1) + { + return 0; + } + + FS_errmsg = strerror(errno); + } + else if (opened(chn, 4) != -1) + { + if (lseek(g_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 = g_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; + + /* Example each entry in the g_files[] arrary */ + + for (i = 0; i < g_capacity; ++i) + { + /* Has this entry been allocated? Is it a file? Or a device? */ + + if (g_file[i] && !g_file[i]->dev) + { + /* It is an open file, close it */ + + FS_close(i); + } + } +} + +int FS_charpos(int chn) +{ + if (g_file[chn] == (struct FileStream *)0) + { + FS_errmsg = _("channel not open"); + return -1; + } + + return (g_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/bas_fs.h b/apps/interpreters/bas/bas_fs.h new file mode 100644 index 000000000..06324466d --- /dev/null +++ b/apps/interpreters/bas/bas_fs.h @@ -0,0 +1,198 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_FS_H +#define __APPS_EXAMPLES_BAS_BAS_FS_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include +#include "bas_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_BAS_FS_H */ diff --git a/apps/interpreters/bas/bas_global.c b/apps/interpreters/bas/bas_global.c new file mode 100644 index 000000000..934bd5f69 --- /dev/null +++ b/apps/interpreters/bas/bas_global.c @@ -0,0 +1,2469 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "bas_auto.h" +#include "bas.h" +#include "bas_error.h" +#include "bas_fs.h" +#include "bas_global.h" +#include "bas_var.h" + +#include + +/**************************************************************************** + * 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 < g_bas_argc; ++i) + { + if (i) + { + String_appendChar(&v->u.string, ' '); + } + + String_appendChars(&v->u.string, g_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 (g_bas_argv0 != (char *)0) + { + String_appendChars(&v->u.string, g_bas_argv0); + } + } + else if (a <= g_bas_argc) + { + String_appendChars(&v->u.string, g_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 (g_bas_argv0 != (char *)0) + { + String_appendChars(&v->u.string, g_bas_argv0); + } + } + else if (a <= g_bas_argc) + { + String_appendChars(&v->u.string, g_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/bas_global.h b/apps/interpreters/bas/bas_global.h new file mode 100644 index 000000000..6fc1c9caf --- /dev/null +++ b/apps/interpreters/bas/bas_global.h @@ -0,0 +1,111 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_GLOBAL_H +#define __APPS_EXAMPLES_BAS_BAS_GLOBAL_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_token.h" +#include "bas_value.h" +#include "bas_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_BAS_GLOBAL_H */ diff --git a/apps/interpreters/bas/bas_main.c b/apps/interpreters/bas/bas_main.c new file mode 100644 index 000000000..f0062aa8b --- /dev/null +++ b/apps/interpreters/bas/bas_main.c @@ -0,0 +1,204 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include +#include +#include + +#include "bas_fs.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); + } + + g_bas_argc = argc - optind; + g_bas_argv = &argv[optind]; + g_bas_argv0 = runFile; + g_bas_end = false; + + bas_init(backslash_colon, restricted, uppercase, lpfd); + if (runFile) + { + bas_runFile(runFile); + } + else + { + bas_interpreter(); + } + + /* Terminate the output stream with a newline BEFORE closing devices */ + + FS_putChar(STDCHANNEL, '\n'); + + /* Release resouces and close files and devices */ + + bas_exit(); + return 0; +} diff --git a/apps/interpreters/bas/bas_program.c b/apps/interpreters/bas/bas_program.c new file mode 100644 index 000000000..ead14e52f --- /dev/null +++ b/apps/interpreters/bas/bas_program.c @@ -0,0 +1,1126 @@ +/**************************************************************************** + * apps/interpreters/bas/bas_program.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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include +#include + +#include "bas_auto.h" +#include "bas_error.h" +#include "bas_fs.h" +#include "bas_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/bas_program.h b/apps/interpreters/bas/bas_program.h new file mode 100644 index 000000000..42bf8abca --- /dev/null +++ b/apps/interpreters/bas/bas_program.h @@ -0,0 +1,114 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_PROGRAM_H +#define __APPS_EXAMPLES_BAS_BAS_PROGRAM_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_programtypes.h" +#include "bas_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_BAS_PROGRAM_H */ diff --git a/apps/interpreters/bas/bas_programtypes.h b/apps/interpreters/bas/bas_programtypes.h new file mode 100644 index 000000000..a22b181bc --- /dev/null +++ b/apps/interpreters/bas/bas_programtypes.h @@ -0,0 +1,99 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_PROGRAMTYPES_H +#define __APPS_EXAMPLES_BAS_BAS_PROGRAMTYPES_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_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_BAS_PROGRAMTYPES_H */ diff --git a/apps/interpreters/bas/bas_statement.c b/apps/interpreters/bas/bas_statement.c new file mode 100644 index 000000000..08bf46c65 --- /dev/null +++ b/apps/interpreters/bas/bas_statement.c @@ -0,0 +1,6354 @@ +/**************************************************************************** + * apps/interpreters/bas/bas_statement.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 + * Gregory Nutt + * + * 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 + +#include + +#include "bas_statement.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define _(String) String + +/**************************************************************************** + * Private Functions + ****************************************************************************/ + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +struct Value *stmt_CALL(struct Value *value) +{ + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGPROCIDENT); + } + + if (g_pass == DECLARE) + { + if (func(value)->type == V_ERROR) + { + return value; + } + else + { + Value_destroy(value); + } + } + else + { + if (g_pass == COMPILE) + { + if (Global_find + (&g_globals, g_pc.token->u.identifier, + (g_pc.token + 1)->type == T_OP) == 0) + { + return Value_new_ERROR(value, UNDECLARED); + } + } + + if (g_pc.token->u.identifier->sym->type != USERFUNCTION && + g_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 = g_pc; + + if (g_pass == DECLARE || g_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 = g_pc; + if (g_pass == COMPILE) + { + g_pc.token->u.casevalue->endselect = + selectcase->token->u.selectcase->endselect; + } + + g_pc.token->u.casevalue->nextcasevalue.line = -1; + ++g_pc.token; + switch (statementpc.token->type) + { + case T_CASEELSE: + break; + + case T_CASEVALUE: + { + struct Pc exprpc; + + do + { + if (g_pc.token->type == T_IS) + { + ++g_pc.token; + switch (g_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); + } + + ++g_pc.token; + exprpc = g_pc; + if (eval(value, "`is'")->type == V_ERROR) + { + return value; + } + + if (Value_retype + (value, + selectcase->token->u.selectcase->type)->type == + V_ERROR) + { + g_pc = exprpc; + return value; + } + + Value_destroy(value); + } + + else /* value or range */ + { + exprpc = g_pc; + if (eval(value, "`case'")->type == V_ERROR) + { + return value; + } + + if (Value_retype + (value, + selectcase->token->u.selectcase->type)->type == + V_ERROR) + { + g_pc = exprpc; + return value; + } + + Value_destroy(value); + if (g_pc.token->type == T_TO) + { + ++g_pc.token; + exprpc = g_pc; + if (eval(value, "`case'")->type == V_ERROR) + { + return value; + } + + if (Value_retype + (value, + selectcase->token->u.selectcase->type)->type == + V_ERROR) + { + g_pc = exprpc; + return value; + } + + Value_destroy(value); + } + + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + while (1); + + break; + } + + default: + assert(0); + } + } + else + { + g_pc = g_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 = g_pc; + + ++g_pc.token; + dirpc = g_pc; + if (eval(value, _("directory"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (g_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 (g_pass == INTERPRET && res == -1) + { + g_pc = dirpc; + return Value_new_ERROR(value, IOERROR, strerror(err)); + } + + return (struct Value *)0; +} + +struct Value *stmt_CLEAR(struct Value *value) +{ + if (g_pass == INTERPRET) + { + Global_clear(&g_globals); + FS_closefiles(); + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_CLOSE(struct Value *value) +{ + int hasargs = 0; + struct Pc chnpc; + + ++g_pc.token; + while (1) + { + chnpc = g_pc; + if (g_pc.token->type == T_CHANNEL) + { + hasargs = 1; + ++g_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 (g_pass == INTERPRET && FS_close(value->u.integer) == -1) + { + Value_destroy(value); + g_pc = chnpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (!hasargs && g_pass == INTERPRET) + { + FS_closefiles(); + } + + return (struct Value *)0; +} + +struct Value *stmt_CLS(struct Value *value) +{ + struct Pc statementpc = g_pc; + + ++g_pc.token; + if (g_pass == INTERPRET && FS_cls(STDCHANNEL) == -1) + { + g_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 = g_pc; + + ++g_pc.token; + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + foreground = value->u.integer; + if (foreground < 0 || foreground > 15) + { + Value_destroy(value); + g_pc = statementpc; + return Value_new_ERROR(value, OUTOFRANGE, _("foreground colour")); + } + } + + Value_destroy(value); + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + background = value->u.integer; + if (background < 0 || background > 15) + { + Value_destroy(value); + g_pc = statementpc; + return Value_new_ERROR(value, OUTOFRANGE, _("background colour")); + } + } + + Value_destroy(value); + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (eval(value, (const char *)0)) + { + int bordercolour = -1; + + if (value->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + bordercolour = value->u.integer; + if (bordercolour < 0 || bordercolour > 15) + { + Value_destroy(value); + g_pc = statementpc; + return Value_new_ERROR(value, OUTOFRANGE, _("border colour")); + } + } + + Value_destroy(value); + } + } + + if (g_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 (g_pass == DECLARE) + { + *g_lastdata = g_pc; + (g_lastdata = &(g_pc.token->u.nextdata))->line = -1; + } + + ++g_pc.token; + while (1) + { + if (g_pc.token->type != T_STRING && g_pc.token->type != T_DATAINPUT) + { + return Value_new_ERROR(value, MISSINGDATAINPUT); + } + + ++g_pc.token; + if (g_pc.token->type != T_COMMA) + { + break; + } + else + { + ++g_pc.token; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value) +{ + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Pc statementpc = g_pc; + struct Identifier *fn; + int proc; + int args = 0; + + if (DIRECTMODE) + { + return Value_new_ERROR(value, NOTINDIRECTMODE); + } + + proc = (g_pc.token->type == T_DEFPROC || g_pc.token->type == T_SUB); + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + if (proc) + { + return Value_new_ERROR(value, MISSINGPROCIDENT); + } + else + { + return Value_new_ERROR(value, MISSINGFUNCIDENT); + } + } + + fn = g_pc.token->u.identifier; + if (proc) + { + fn->defaultType = V_VOID; + } + + ++g_pc.token; + if (findLabel(L_FUNC)) + { + g_pc = statementpc; + return Value_new_ERROR(value, NESTEDDEFINITION); + } + + Auto_variable(&g_stack, fn); + if (g_pc.token->type == T_OP) /* arguments */ + { + ++g_pc.token; + while (1) + { + if (g_pc.token->type != T_IDENTIFIER) + { + Auto_funcEnd(&g_stack); + return Value_new_ERROR(value, MISSINGFORMIDENT); + } + + if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0) + { + Auto_funcEnd(&g_stack); + return Value_new_ERROR(value, ALREADYDECLARED); + } + + ++args; + ++g_pc.token; + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (g_pc.token->type != T_CP) + { + Auto_funcEnd(&g_stack); + return Value_new_ERROR(value, MISSINGCP); + } + + ++g_pc.token; + } + + if (g_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(&g_stack, i); + } + + if (Global_function + (&g_globals, fn, fn->defaultType, &g_pc, &statementpc, args, t) == 0) + { + free(t); + Auto_funcEnd(&g_stack); + g_pc = statementpc; + return Value_new_ERROR(value, REDECLARATION); + } + + Program_addScope(&g_program, &fn->sym->u.sub.u.def.scope); + } + + pushLabel(L_FUNC, &statementpc); + if (g_pc.token->type == T_EQ) + { + return stmt_EQ_FNRETURN_FNEND(value); + } + } + else + { + g_pc = (g_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 = (g_pc.token->type == T_DEC ? -1 : 1); + ++g_pc.token; + while (1) + { + struct Value *l, stepValue; + struct Pc lvaluepc; + + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGDECINCIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 + { + g_pc = lvaluepc; + return Value_new_ERROR(value, TYPEMISMATCH5); + } + + if (g_pass == INTERPRET) + { + Value_add(l, &stepValue, 1); + } + + Value_destroy(&stepValue); + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value) +{ + enum ValueType dsttype = V_NIL; + + switch (g_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); + } + + ++g_pc.token; + while (1) + { + struct Identifier *ident; + + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (g_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 = g_pc.token->u.identifier; + ++g_pc.token; + if (g_pc.token->type == T_MINUS) + { + struct Identifier i; + + if (strlen(ident->name) != 1) + { + return Value_new_ERROR(value, BADRANGE); + } + + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (strlen(g_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(g_pc.token->u.identifier->name[0]); + ++i.name[0]) + { + Global_variable(&g_globals, &i, dsttype, GLOBALVAR, 1); + } + + ++g_pc.token; + } + else + { + Global_variable(&g_globals, ident, dsttype, GLOBALVAR, 1); + } + + if (g_pc.token->type == T_COMMA) + { + ++g_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 (g_pass == INTERPRET && !DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == INTERPRET && + Program_goLine(&g_program, g_pc.token->u.integer, + &from) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + f = 1; + ++g_pc.token; + } + + if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == INTERPRET && + Program_goLine(&g_program, g_pc.token->u.integer, + &to) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + t = 1; + ++g_pc.token; + } + } + else if (f == 1) + { + to = from; + t = 1; + } + + if (!f && !t) + { + return Value_new_ERROR(value, MISSINGLINENUMBER); + } + + if (g_pass == INTERPRET) + { + Program_delete(&g_program, f ? &from : (struct Pc *)0, + t ? &to : (struct Pc *)0); + } + + return (struct Value *)0; +} + +struct Value *stmt_DIM(struct Value *value) +{ + ++g_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 (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGARRIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + if (g_pass == INTERPRET && var->dim) + { + return Value_new_ERROR(value, REDIM); + } + + vartype = var->type; + ++g_pc.token; + if (g_pc.token->type != T_OP) + { + return Value_new_ERROR(value, MISSINGOP); + } + + ++g_pc.token; + dim = 0; + while (1) + { + dimpc = g_pc; + if (eval(value, _("dimension"))->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + if (capacity) + { + free(geometry); + } + + return value; + } + + if (g_pass == INTERPRET && value->u.integer < g_optionbase) /* error */ + { + Value_destroy(value); + Value_new_ERROR(value, OUTOFRANGE, _("dimension")); + } + + if (value->type == V_ERROR) /* abort */ + { + if (capacity) + { + free(geometry); + } + + g_pc = dimpc; + return value; + } + + if (g_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 - g_optionbase + 1; + ++dim; + } + + Value_destroy(value); + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (g_pc.token->type != T_CP) /* abort */ + { + if (capacity) + { + free(geometry); + } + + return Value_new_ERROR(value, MISSINGCP); + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + struct Var newarray; + + assert(capacity); + if (Var_new(&newarray, vartype, dim, geometry, g_optionbase) == + (struct Var *)0) + { + free(geometry); + return Value_new_ERROR(value, OUTOFMEMORY); + } + + Var_destroy(var); + *var = newarray; + free(geometry); + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; /* advance to next var */ + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_DISPLAY(struct Value *value) +{ + struct Pc statementpc = g_pc; + + ++g_pc.token; + if (eval(value, _("file name"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) + { + return value; + } + + if (g_pass == INTERPRET && cat(value->u.string.character) == -1) + { + const char *msg = strerror(errno); + + Value_destroy(value); + g_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 (g_pass == DECLARE || g_pass == COMPILE) + { + pushLabel(L_DO, &g_pc); + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_DOcondition(struct Value *value) +{ + struct Pc dowhilepc = g_pc; + int negate = (g_pc.token->type == T_DOUNTIL); + + if (g_pass == DECLARE || g_pass == COMPILE) + { + pushLabel(L_DOcondition, &g_pc); + } + + ++g_pc.token; + if (eval(value, "condition")->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + int condition; + + condition = Value_isNull(value); + if (negate) + { + condition = !condition; + } + + if (condition) + { + g_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 = g_pc; + int status; + + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + struct Pc where; + + if (g_program.numbered) + { + if (Program_goLine(&g_program, g_pc.token->u.integer, &where) == + (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + line = where.line + 1; + } + else + { + if (!Program_end(&g_program, &where)) + { + return Value_new_ERROR(value, NOPROGRAM); + } + + line = g_pc.token->u.integer; + if (line < 1 || line > (where.line + 1)) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + } + ++g_pc.token; + } + else + { + line = 1; + } + + if (g_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) + { + g_pc = statementpc; + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + if ((name = tmpnam(NULL)) == (char *)0) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, + _("generating temporary file name failed")); + } + + if ((chn = FS_openout(name)) == -1) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERRORCREATE, name, FS_errmsg); + } + + FS_width(chn, 0); + if (Program_list(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value)) + { + g_pc = statementpc; + return value; + } + + if (FS_close(chn) == -1) + { + g_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) + { + g_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); + g_pc = statementpc; + return value; + } + + FS_close(chn); + Program_setname(&newProgram, g_program.name.character); + Program_destroy(&g_program); + g_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 (g_pass == INTERPRET) + { + g_pc = g_pc.token->u.endifpc; + } + + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Pc elsepc = g_pc; + struct Pc *ifinstr; + int elseifelse = (g_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 = g_pc; + } + + ++g_pc.token; + ifinstr->token->u.elsepc = g_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 (g_pass == INTERPRET) + { + g_pc = g_pc.token->u.endpc; + g_bas_end = true; + } + + if (g_pass == DECLARE || g_pass == COMPILE) + { + if (Program_end(&g_program, &g_pc.token->u.endpc)) + { + ++g_pc.token; + } + else + { + struct Token *eol; + + for (eol = g_pc.token; eol->type != T_EOL; ++eol); + + g_pc.token->u.endpc = g_pc; + g_pc.token->u.endpc.token = eol; + ++g_pc.token; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_ENDIF(struct Value *value) +{ + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Pc endifpc = g_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 = g_pc; + } + } + else if ((elsepc = popLabel(L_ELSE))) + { + elsepc->token->u.endifpc = endifpc; + } + else + { + return Value_new_ERROR(value, STRAYENDIF); + } + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_ENDFN(struct Value *value) +{ + struct Pc *curfn = (struct Pc *)0; + struct Pc eqpc = g_pc; + + if (g_pass == DECLARE || g_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); + } + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + return Value_clone(value, + Var_value(Auto_local(&g_stack, 0), 0, (int *)0, + (struct Value *)0)); + } + else + { + if (g_pass == DECLARE) + { + Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc); + } + Auto_funcEnd(&g_stack); + } + + return (struct Value *)0; +} + +struct Value *stmt_ENDPROC_SUBEND(struct Value *value) +{ + struct Pc *curfn = (struct Pc *)0; + + if (g_pass == DECLARE || g_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()); + } + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + return Value_new_VOID(value); + } + else + { + if (g_pass == DECLARE) + { + Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc); + } + + Auto_funcEnd(&g_stack); + } + + return (struct Value *)0; +} + +struct Value *stmt_ENDSELECT(struct Value *value) +{ + struct Pc statementpc = g_pc; + + ++g_pc.token; + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Pc *selectcasepc; + + if ((selectcasepc = popLabel(L_SELECTCASE))) + { + selectcasepc->token->u.selectcase->endselect = g_pc; + } + else + { + g_pc = statementpc; + return Value_new_ERROR(value, STRAYENDSELECT); + } + } + + return (struct Value *)0; +} + +struct Value *stmt_ENVIRON(struct Value *value) +{ + struct Pc epc = g_pc; + + ++g_pc.token; + if (eval(value, _("environment variable"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET && value->u.string.character) + { + if (putenv(value->u.string.character) == -1) + { + Value_destroy(value); + g_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 (g_pass == DECLARE || g_pass == COMPILE) + { + if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 || + (curfn->token + 1)->u.identifier->defaultType == V_VOID) + { + return Value_new_ERROR(value, STRAYFNEXIT); + } + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + return Value_clone(value, + Var_value(Auto_local(&g_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) +{ + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value) +{ + struct Pc *curfn = (struct Pc *)0; + struct Pc eqpc = g_pc; + enum TokenType t = g_pc.token->type; + + if (g_pass == DECLARE || g_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); + } + } + } + + ++g_pc.token; + if (eval(value, _("return"))->type == V_ERROR || + Value_retype(value, eqpc.token->u.type)->type == V_ERROR) + { + if (g_pass != INTERPRET) + { + Auto_funcEnd(&g_stack); + } + + g_pc = eqpc; + return value; + } + + if (g_pass == INTERPRET) + { + return value; + } + else + { + Value_destroy(value); + if (t == T_EQ || t == T_FNEND) + { + if (g_pass == DECLARE) + { + Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, + &g_pc); + } + + Auto_funcEnd(&g_stack); + } + } + + return (struct Value *)0; +} + +struct Value *stmt_ERASE(struct Value *value) +{ + ++g_pc.token; + while (1) + { + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGARRIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + if (g_pass == INTERPRET) + { + Var_destroy(&g_pc.token->u.identifier->sym->u.var); + } + + ++g_pc.token; + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_EXITDO(struct Value *value) +{ + if (g_pass == INTERPRET) + { + g_pc = g_pc.token->u.exitdo; + } + else + { + if (g_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); + } + + g_pc.token->u.exitdo = exitdo->token->u.exitdo; + } + + ++g_pc.token; + } + + return (struct Value *)0; +} + +struct Value *stmt_EXITFOR(struct Value *value) +{ + if (g_pass == INTERPRET) + { + g_pc = g_pc.token->u.exitfor; + } + else + { + if (g_pass == COMPILE) + { + struct Pc *exitfor; + + if ((exitfor = findLabel(L_FOR)) == (struct Pc *)0) + { + return Value_new_ERROR(value, STRAYEXITFOR); + } + + g_pc.token->u.exitfor = exitfor->token->u.exitfor; + } + + ++g_pc.token; + } + + return (struct Value *)0; +} + +struct Value *stmt_FIELD(struct Value *value) +{ + long int chn, offset, recLength = -1; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pass == INTERPRET && (recLength = FS_recLength(chn)) == -1) + { + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + if (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_pc.token; + offset = 0; + while (1) + { + struct Pc curpc; + struct Value *l; + long int width; + + curpc = g_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 (g_pass == INTERPRET && offset + width > recLength) + { + g_pc = curpc; + return Value_new_ERROR(value, OUTOFRANGE, _("field width")); + } + + if (g_pc.token->type != T_AS) + { + return Value_new_ERROR(value, MISSINGAS); + } + + ++g_pc.token; + curpc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 (g_pass != DECLARE && l->type != V_STRING) + { + g_pc = curpc; + return Value_new_ERROR(value, TYPEMISMATCH4); + } + + if (g_pass == INTERPRET) + { + FS_field(chn, &l->u.string, offset, width); + } + + offset += width; + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_FOR(struct Value *value) +{ + struct Pc forpc = g_pc; + struct Pc varpc; + struct Pc limitpc; + struct Value limit, stepValue; + + ++g_pc.token; + varpc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGLOOPIDENT); + } + + if (assign(value)->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + ++g_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 (g_pc.token->type == T_STEP) /* STEP x */ + { + struct Pc stepPc; + + ++g_pc.token; + stepPc = g_pc; + if (eval(&stepValue, "`step'")->type == V_ERROR) + { + Value_destroy(value); + *value = stepValue; + g_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)) + { + g_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 (g_pc.token->type != T_TO) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGTO); + } + + ++g_pc.token; + pushLabel(L_FOR_LIMIT, &g_pc); + limitpc = g_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 (g_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(&g_stack, + sym))->type + == V_ERROR) + { + Value_destroy(value); + *value = limit; + g_pc = limitpc; + return value; + } + } + + Value_destroy(&limit); + if (g_pc.token->type == T_STEP) /* STEP x */ + { + struct Pc stepPc; + + ++g_pc.token; + stepPc = g_pc; + if (eval(&stepValue, "`step'")->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(&stepValue, value->type)->type == V_ERROR)) + { + Value_destroy(value); + *value = stepValue; + g_pc = stepPc; + return value; + } + } + else /* implicit numeric STEP */ + { + VALUE_NEW_INTEGER(&stepValue, 1); + if (g_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, &g_pc); + Value_destroy(&stepValue); + Value_destroy(value); + } + + return (struct Value *)0; +} + +struct Value *stmt_GET_PUT(struct Value *value) +{ + struct Pc statementpc = g_pc; + int put = g_pc.token->type == T_PUT; + long int chn; + struct Pc errpc; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + errpc = g_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 (g_pass == INTERPRET) + { + if (rec < 1) + { + g_pc = errpc; + return Value_new_ERROR(value, OUTOFRANGE, _("record number")); + } + + if (FS_seek((int)chn, rec - 1) == -1) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + } + } + + } + + if (g_pc.token->type == T_COMMA) /* BINARY mode get/put */ + { + int res = -1; + + ++g_pc.token; + if (put) + { + if (eval(value, _("`put'/`get' data"))->type == V_ERROR) + { + return value; + } + + if (g_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 (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGPROCIDENT); + } + + if (g_pass == DECLARE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 (g_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 (g_pass == INTERPRET && res == -1) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + } + else if (g_pass == INTERPRET && ((put ? FS_put : FS_get) (chn)) == -1) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + return (struct Value *)0; +} + +struct Value *stmt_GOSUB(struct Value *value) +{ + if (g_pass == INTERPRET) + { + if (!g_program.runnable && + compileProgram(value, !DIRECTMODE)->type == V_ERROR) + { + return value; + } + + g_pc.token += 2; + Auto_pushGosubRet(&g_stack, &g_pc); + g_pc = (g_pc.token - 2)->u.gosubpc; + Program_trace(&g_program, &g_pc, 0, 1); + } + + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Token *gosubpc = g_pc.token; + + ++g_pc.token; + if (g_pc.token->type != T_INTEGER) + { + return Value_new_ERROR(value, MISSINGLINENUMBER); + } + + if (Program_goLine(&g_program, g_pc.token->u.integer, &gosubpc->u.gosubpc) == + (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + if (g_pass == COMPILE && + Program_scopeCheck(&g_program, &gosubpc->u.gosubpc, findLabel(L_FUNC))) + { + return Value_new_ERROR(value, OUTOFSCOPE); + } + + ++g_pc.token; + } + + return (struct Value *)0; +} + +struct Value *stmt_RESUME_GOTO(struct Value *value) +{ + if (g_pass == INTERPRET) + { + if (!g_program.runnable && + compileProgram(value, !DIRECTMODE)->type == V_ERROR) + { + return value; + } + + if (g_pc.token->type == T_RESUME) + { + if (!g_stack.resumeable) + { + return Value_new_ERROR(value, STRAYRESUME); + } + + g_stack.resumeable = 0; + } + + g_pc = g_pc.token->u.gotopc; + Program_trace(&g_program, &g_pc, 0, 1); + } + else if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Token *gotopc = g_pc.token; + + ++g_pc.token; + if (g_pc.token->type != T_INTEGER) + { + return Value_new_ERROR(value, MISSINGLINENUMBER); + } + + if (Program_goLine(&g_program, g_pc.token->u.integer, &gotopc->u.gotopc) == + (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + if (g_pass == COMPILE && + Program_scopeCheck(&g_program, &gotopc->u.gotopc, findLabel(L_FUNC))) + { + return Value_new_ERROR(value, OUTOFSCOPE); + } + + ++g_pc.token; + } + + return (struct Value *)0; +} + +struct Value *stmt_KILL(struct Value *value) +{ + struct Pc statementpc = g_pc; + + ++g_pc.token; + if (eval(value, _("file name"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) + { + return value; + } + + if (g_pass == INTERPRET && unlink(value->u.string.character) == -1) + { + const char *msg = strerror(errno); + + Value_destroy(value); + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, msg); + } + else + { + Value_destroy(value); + } + + return (struct Value *)0; +} + +struct Value *stmt_LET(struct Value *value) +{ + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (assign(value)->type == V_ERROR) + { + return value; + } + + if (g_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; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + else + { + ++g_pc.token; + } + } + + /* prompt */ + + if (g_pc.token->type == T_STRING) + { + if (g_pass == INTERPRET && channel == 0) + { + FS_putString(channel, g_pc.token->u.string); + } + + ++g_pc.token; + if (g_pc.token->type != T_SEMICOLON && g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGSEMICOMMA); + } + + ++g_pc.token; + } + + if (g_pass == INTERPRET && channel == 0) + { + FS_flush(channel); + } + + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + lpc = g_pc; + if (((l = lvalue(value))->type) == V_ERROR) + { + return value; + } + + if (g_pass == COMPILE && l->type != V_STRING) + { + g_pc = lpc; + return Value_new_ERROR(value, TYPEMISMATCH4); + } + + if (g_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 = (g_pc.token->type == T_LLIST ? LPCHANNEL : STDCHANNEL); + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == INTERPRET && + Program_fromLine(&g_program, g_pc.token->u.integer, + &from) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + f = 1; + ++g_pc.token; + } + else if (g_pc.token->type != T_MINUS && g_pc.token->type != T_COMMA) + { + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + if (g_pass == INTERPRET && + Program_fromLine(&g_program, value->u.integer, + &from) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + f = 1; + Value_destroy(value); + } + } + + if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + (g_pass != DECLARE && + Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + if (g_pass == INTERPRET && + Program_toLine(&g_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 (g_pass == INTERPRET) + { + /* Some implementations do not require direct mode */ + + if (Program_list + (&g_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 (g_pass == INTERPRET && !DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + ++g_pc.token; + loadpc = g_pc; + if (eval(value, _("file name"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + g_pc = loadpc; + return value; + } + + if (g_pass == INTERPRET) + { + int dev; + + new(); + Program_setname(&g_program, value->u.string.character); + if ((dev = FS_openin(value->u.string.character)) == -1) + { + g_pc = loadpc; + Value_destroy(value); + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + FS_width(dev, 0); + Value_destroy(value); + if (Program_merge(&g_program, dev, value)) + { + g_pc = loadpc; + return value; + } + + FS_close(dev); + g_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 (g_pass == DECLARE || g_pass == COMPILE) + { + if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0) + return Value_new_ERROR(value, STRAYLOCAL); + } + + ++g_pc.token; + while (1) + { + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Symbol *fnsym; + + if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0) + return Value_new_ERROR(value, ALREADYLOCAL); + if (g_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] = + g_pc.token->u.identifier->defaultType; + ++fnsym->u.sub.u.def.localLength; + } + } + + ++g_pc.token; + if (g_pc.token->type == T_COMMA) + { + ++g_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 = g_pc; + + ++g_pc.token; + argpc = g_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 (g_pass == INTERPRET && line < 1) + { + g_pc = argpc; + return Value_new_ERROR(value, OUTOFRANGE, _("row")); + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + argpc = g_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 (g_pass == INTERPRET && column < 1) + { + g_pc = argpc; + return Value_new_ERROR(value, OUTOFRANGE, _("column")); + } + + if (g_pass == INTERPRET && FS_locate(STDCHANNEL, line, column) == -1) + { + g_pc = statementpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + return (struct Value *)0; +} + +struct Value *stmt_LOCK_UNLOCK(struct Value *value) +{ + int lock = g_pc.token->type == T_LOCK; + int channel; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_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 = g_pc; + struct Pc *dopc; + + ++g_pc.token; + if (g_pass == INTERPRET) + { + g_pc = looppc.token->u.dopc; + } + + if (g_pass == DECLARE || g_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 = g_pc; + } + + return (struct Value *)0; +} + +struct Value *stmt_LOOPUNTIL(struct Value *value) +{ + struct Pc loopuntilpc = g_pc; + struct Pc *dopc; + + ++g_pc.token; + if (eval(value, _("condition"))->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + if (Value_isNull(value)) + g_pc = loopuntilpc.token->u.dopc; + Value_destroy(value); + } + + if (g_pass == DECLARE || g_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 = g_pc; + } + + return (struct Value *)0; +} + +struct Value *stmt_LSET_RSET(struct Value *value) +{ + struct Value *l; + struct Pc tmppc; + int lset = (g_pc.token->type == T_LSET); + + ++g_pc.token; + if (g_pass == DECLARE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_pc.token + 1)->type == + T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + } + + tmppc = g_pc; + if ((l = lvalue(value))->type == V_ERROR) + { + return value; + } + + if (g_pass == COMPILE && l->type != V_STRING) + { + g_pc = tmppc; + return Value_new_ERROR(value, TYPEMISMATCH4); + } + + if (g_pc.token->type != T_EQ) + { + return Value_new_ERROR(value, MISSINGEQ); + } + + ++g_pc.token; + tmppc = g_pc; + if (eval(value, _("rhs"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, l->type)->type == V_ERROR)) + { + g_pc = tmppc; + return value; + } + + if (g_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 = g_pc; + + if (g_pass == DECLARE) + { + if (func(value)->type == V_ERROR) + { + return value; + } + else + { + Value_destroy(value); + } + + if (g_pc.token->type == T_EQ || g_pc.token->type == T_COMMA) + { + g_pc = here; + if (assign(value)->type == V_ERROR) + { + return value; + } + + Value_destroy(value); + } + } + else + { + if (g_pass == COMPILE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_find(&g_globals, g_pc.token->u.identifier, + (g_pc.token + 1)->type == T_OP) == 0) + { + return Value_new_ERROR(value, UNDECLARED); + } + } + + if (strcasecmp(g_pc.token->u.identifier->name, "mid$") + && (g_pc.token->u.identifier->sym->type == USERFUNCTION || + g_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 (g_pass != INTERPRET) + { + Value_destroy(value); + } + } + } + + return (struct Value *)0; +} + +struct Value *stmt_IF_ELSEIFIF(struct Value *value) +{ + struct Pc ifpc = g_pc; + + ++g_pc.token; + if (eval(value, _("condition"))->type == V_ERROR) + { + return value; + } + + if (g_pc.token->type != T_THEN) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGTHEN); + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + if (Value_isNull(value)) + { + g_pc = ifpc.token->u.elsepc; + } + + Value_destroy(value); + } + else + { + Value_destroy(value); + if (g_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 (g_pc.token->type == T_ELSE) + { + struct Pc elsepc = g_pc; + + ++g_pc.token; + ifpc.token->u.elsepc = g_pc; + if (ifpc.token->type == T_ELSEIFIF) + { + (ifpc.token - 1)->u.elsepc = g_pc; + } + + if (statements(value)->type == V_ERROR) + { + return value; + } + + Value_destroy(value); + elsepc.token->u.endifpc = g_pc; + } + else + { + ifpc.token->u.elsepc = g_pc; + if (ifpc.token->type == T_ELSEIFIF) + { + (ifpc.token - 1)->u.elsepc = g_pc; + } + } + } + + } + + return (struct Value *)0; +} + +struct Value *stmt_IMAGE(struct Value *value) +{ + ++g_pc.token; + if (g_pc.token->type != T_STRING) + { + return Value_new_ERROR(value, MISSINGFMT); + } + + ++g_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; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + else + { + ++g_pc.token; + } + } + + if (g_pc.token->type == T_SEMICOLON) + { + nl = 0; + ++g_pc.token; + } + + /* prompt */ + + if (g_pc.token->type == T_STRING) + { + if (g_pass == INTERPRET && channel == STDCHANNEL) + { + FS_putString(STDCHANNEL, g_pc.token->u.string); + } + + ++g_pc.token; + if (g_pc.token->type == T_COMMA || g_pc.token->type == T_COLON) + { + ++g_pc.token; + extraprompt = 0; + } + else if (g_pc.token->type == T_SEMICOLON) + { + ++g_pc.token; + } + else + { + extraprompt = 0; + } + } + + if (g_pass == INTERPRET && channel == STDCHANNEL && extraprompt) + { + FS_putChars(STDCHANNEL, "? "); + } + +retry: + if (g_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 (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGVARIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_pc.token + 1)->type == + T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + lvaluepc = g_pc; + if (((l = lvalue(value))->type) == V_ERROR) + { + return value; + } + + if (g_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)) + { + g_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 (g_pc.token->type == T_COMMA) + { + if (t->type == T_COMMA) + { + ++t; + } + else + { + Token_destroy(inputdata); + if (channel == STDCHANNEL) + { + FS_putChars(STDCHANNEL, "?? "); + ++g_pc.token; + goto retry; + } + else + { + g_pc = lvaluepc; + return Value_new_ERROR(value, MISSINGINPUTDATA); + } + } + } + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (g_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; + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var1 = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_pc.token->type != T_EQ) + { + return Value_new_ERROR(value, MISSINGEQ); + } + + ++g_pc.token; + if (g_pc.token->type == T_IDENTIFIER) /* a = b [ +|-|* c ] */ + { + if (g_pass == COMPILE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) + return Value_new_ERROR(value, UNDECLARED); + } + + var2 = &g_pc.token->u.identifier->sym->u.var; + if (g_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 (g_pass == COMPILE && + Value_commonType[var1->type][var2->type] == V_ERROR) + { + return Value_new_typeError(value, var2->type, var1->type); + } + + ++g_pc.token; + if (g_pc.token->type == T_PLUS || g_pc.token->type == T_MINUS || + g_pc.token->type == T_MULT) + { + oppc = g_pc; + op = g_pc.token->type; + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGARRIDENT); + } + + if (g_pass == COMPILE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) + { + return Value_new_ERROR(value, UNDECLARED); + } + } + + var3 = &g_pc.token->u.identifier->sym->u.var; + if (g_pass == INTERPRET && + ((var3->dim != 1 && var3->dim != 2) || var3->base < 0 || + var3->base > 1)) + { + return Value_new_ERROR(value, NOMATRIX, var3->dim, var3->base); + } + + ++g_pc.token; + } + + if (g_pass != DECLARE) + { + if (var3 == (struct Var *)0) + { + if (Var_mat_assign(var1, var2, value, g_pass == INTERPRET)) + { + assert(oppc.line != -1); + g_pc = oppc; + return value; + } + } + else if (op == T_MULT) + { + if (Var_mat_mult(var1, var2, var3, value, g_pass == INTERPRET)) + { + assert(oppc.line != -1); + g_pc = oppc; + return value; + } + } + else if (Var_mat_addsub + (var1, var2, var3, op == T_PLUS, value, g_pass == INTERPRET)) + { + assert(oppc.line != -1); + g_pc = oppc; + return value; + } + } + } + else if (g_pc.token->type == T_OP) + { + if (var1->type == V_STRING) + { + return Value_new_ERROR(value, TYPEMISMATCH5); + } + + ++g_pc.token; + if (eval(value, _("factor"))->type == V_ERROR) + { + return value; + } + + if (g_pass == COMPILE && + Value_commonType[var1->type][value->type] == V_ERROR) + { + return Value_new_typeError(value, var1->type, value->type); + } + + if (g_pc.token->type != T_CP) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGCP); + } + + ++g_pc.token; + if (g_pc.token->type != T_MULT) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGMULT); + } + + oppc = g_pc; + ++g_pc.token; + if (g_pass == COMPILE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) + { + Value_destroy(value); + return Value_new_ERROR(value, UNDECLARED); + } + } + + var2 = &g_pc.token->u.identifier->sym->u.var; + if (g_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 (g_pass != DECLARE && + Var_mat_scalarMult(var1, value, var2, g_pass == INTERPRET)) + { + assert(oppc.line != -1); + g_pc = oppc; + return value; + } + + Value_destroy(value); + ++g_pc.token; + } + + else if (g_pc.token->type == T_CON || g_pc.token->type == T_ZER || + g_pc.token->type == T_IDN) + { + op = g_pc.token->type; + if (g_pass == COMPILE && Value_commonType[var1->type][V_INTEGER] == V_ERROR) + { + return Value_new_typeError(value, V_INTEGER, var1->type); + } + + ++g_pc.token; + if (g_pc.token->type == T_OP) + { + unsigned int dim, geometry[2]; + enum ValueType vartype = var1->type; + + ++g_pc.token; + if (evalGeometry(value, &dim, geometry)) + { + return value; + } + + if (g_pass == INTERPRET) + { + Var_destroy(var1); + Var_new(var1, vartype, dim, geometry, g_optionbase); + } + } + + if (g_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 (g_pc.token->type == T_TRN || g_pc.token->type == T_INV) + { + op = g_pc.token->type; + ++g_pc.token; + if (g_pc.token->type != T_OP) + { + return Value_new_ERROR(value, MISSINGOP); + } + + ++g_pc.token; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == COMPILE) + { + if (((g_pc.token + 1)->type == T_OP || + Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && + Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) + { + return Value_new_ERROR(value, UNDECLARED); + } + } + + var2 = &g_pc.token->u.identifier->sym->u.var; + if (g_pass == COMPILE && + Value_commonType[var1->type][var2->type] == V_ERROR) + { + return Value_new_typeError(value, var2->type, var1->type); + } + + if (g_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, &g_stack.lastdet, value)) + { + return value; + } + + break; + + default: + assert(0); + } + } + + ++g_pc.token; + if (g_pc.token->type != T_CP) + { + return Value_new_ERROR(value, MISSINGCP); + } + + ++g_pc.token; + } + else + { + return Value_new_ERROR(value, MISSINGEXPR, _("matrix")); + } + + return (struct Value *)0; +} + +struct Value *stmt_MATINPUT(struct Value *value) +{ + int channel = STDCHANNEL; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + else + { + ++g_pc.token; + } + } + + while (1) + { + struct Pc lvaluepc; + struct Var *var; + + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_pc.token->type == T_OP) + { + unsigned int dim, geometry[2]; + enum ValueType vartype = var->type; + + ++g_pc.token; + if (evalGeometry(value, &dim, geometry)) + { + return value; + } + + if (g_pass == INTERPRET) + { + Var_destroy(var); + Var_new(var, vartype, dim, geometry, g_optionbase); + } + } + + if (g_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); + g_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 (g_pc.token->type == T_COMMA) + { + ++g_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; + + ++g_pc.token; + if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + } + + if (g_pc.token->type == T_USING) + { + struct Pc usingpc; + + usingpc = g_pc; + printusing = 1; + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == COMPILE && + Program_imageLine(&g_program, g_pc.token->u.integer, + &usingpc.token->u.image) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHIMAGELINE); + } + else if (g_pass == INTERPRET) + { + using = usingpc.token->u.image.token->u.string; + } + + Value_new_STRING(&usingval); + ++g_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 (g_pc.token->type != T_SEMICOLON) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, MISSINGSEMICOLON); + } + + ++g_pc.token; + } + else + { + Value_new_STRING(&usingval); + using = &usingval.u.string; + } + while (1) + { + struct Var *var; + int zoned = 1; + + if (g_pc.token->type != T_IDENTIFIER) + { + if (notfirst) + { + break; + } + + Value_destroy(&usingval); + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_pc.token->type == T_SEMICOLON) + { + zoned = 0; + } + + if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) + { + ++g_pc.token; + } + else + { + break; + } + + notfirst = 1; + } + + Value_destroy(&usingval); + if (g_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) +{ + ++g_pc.token; + while (1) + { + struct Pc lvaluepc; + struct Var *var; + + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_pc.token->type == T_OP) + { + unsigned int dim, geometry[2]; + enum ValueType vartype = var->type; + + ++g_pc.token; + if (evalGeometry(value, &dim, geometry)) + { + return value; + } + + if (g_pass == INTERPRET) + { + Var_destroy(var); + Var_new(var, vartype, dim, geometry, g_optionbase); + } + } + + if (g_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]))) + { + g_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]))) + { + g_pc = lvaluepc; + return value; + } + } + } + } + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_MATREDIM(struct Value *value) +{ + ++g_pc.token; + while (1) + { + struct Var *var; + unsigned int dim, geometry[2]; + + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_pc.token->type != T_OP) + { + return Value_new_ERROR(value, MISSINGOP); + } + + ++g_pc.token; + if (evalGeometry(value, &dim, geometry)) + { + return value; + } + + if (g_pass == INTERPRET && + Var_mat_redim(var, dim, geometry, value) != (struct Value *)0) + { + return value; + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_MATWRITE(struct Value *value) +{ + int chn = STDCHANNEL; + int notfirst = 0; + int comma = 0; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + } + + while (1) + { + struct Var *var; + + if (g_pc.token->type != T_IDENTIFIER) + { + if (notfirst) + { + break; + } + + return Value_new_ERROR(value, MISSINGMATIDENT); + } + + notfirst = 1; + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, GLOBALARRAY, + 0) == 0) + { + return Value_new_ERROR(value, REDECLARATION); + } + + var = &g_pc.token->u.identifier->sym->u.var; + ++g_pc.token; + if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (g_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 = g_pc; + struct Value old; + int res = -1, reserrno = -1; + + ++g_pc.token; + if (eval(value, _("file name"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (g_pc.token->type != T_AS) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGAS); + } + + old = *value; + ++g_pc.token; + if (eval(value, _("file name"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + Value_destroy(&old); + return value; + } + + if (g_pass == INTERPRET) + { + res = rename(old.u.string.character, value->u.string.character); + reserrno = errno; + } + + Value_destroy(&old); + Value_destroy(value); + if (g_pass == INTERPRET && res == -1) + { + g_pc = namepc; + return Value_new_ERROR(value, IOERROR, strerror(reserrno)); + } + + return (struct Value *)0; +} + +struct Value *stmt_NEW(struct Value *value) +{ + if (g_pass == INTERPRET) + { + if (!DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + new(); + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_NEXT(struct Value *value) +{ + struct Next **next = &g_pc.token->u.next; + int level = 0; + + if (g_pass == INTERPRET) + { + struct Value *l, inc; + struct Pc savepc; + + ++g_pc.token; + while (1) + { + /* get variable lvalue */ + + savepc = g_pc; + g_pc = (*next)[level].var; + if ((l = lvalue(value))->type == V_ERROR) + { + return value; + } + + g_pc = savepc; + + /* get limit value and increment */ + + savepc = g_pc; + g_pc = (*next)[level].limit; + if (eval(value, _("limit"))->type == V_ERROR) + { + return value; + } + + Value_retype(value, l->type); + assert(value->type != V_ERROR); + if (g_pc.token->type == T_STEP) + { + ++g_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); + g_pc = savepc; + + Value_add(l, &inc, 1); + if (Value_exitFor(l, value, &inc)) + { + Value_destroy(value); + Value_destroy(&inc); + if (g_pc.token->type == T_IDENTIFIER) + { + if (lvalue(value)->type == V_ERROR) + { + return value; + } + + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + ++level; + } + else + { + break; + } + } + else + { + break; + } + } + else + { + g_pc = (*next)[level].body; + Value_destroy(value); + Value_destroy(&inc); + break; + } + } + } + else + { + struct Pc *body; + + ++g_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 (g_pc.token->type == T_IDENTIFIER) + { + if (cistrcmp + (g_pc.token->u.identifier->name, + (*next)[level].var.token->u.identifier->name)) + { + return Value_new_ERROR(value, FORMISMATCH); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + ++level; + } + else + { + break; + } + } + else + { + break; + } + } + + while (level >= 0) + { + (*next)[level--].fr.token->u.exitfor = g_pc; + } + } + + return (struct Value *)0; +} + +struct Value *stmt_ON(struct Value *value) +{ + struct On *on = &g_pc.token->u.on; + + ++g_pc.token; + if (eval(value, _("selector"))->type == V_ERROR) + { + return value; + } + + if (Value_retype(value, V_INTEGER)->type == V_ERROR) + { + return value; + } + + if (g_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 (g_pc.token->type == T_GOTO) + { + g_pc = newpc; + } + else + { + g_pc = on->pc[0]; + Auto_pushGosubRet(&g_stack, &g_pc); + g_pc = newpc; + } + + Program_trace(&g_program, &g_pc, 0, 1); + } + else if (g_pass == DECLARE || g_pass == COMPILE) + { + Value_destroy(value); + if (g_pc.token->type != T_GOTO && g_pc.token->type != T_GOSUB) + { + return Value_new_ERROR(value, MISSINGGOTOSUB); + } + + ++g_pc.token; + on->pcLength = 1; + while (1) + { + on->pc = realloc(on->pc, sizeof(struct Pc) * ++on->pcLength); + if (g_pc.token->type != T_INTEGER) + { + return Value_new_ERROR(value, MISSINGLINENUMBER); + } + + if (Program_goLine + (&g_program, g_pc.token->u.integer, + &on->pc[on->pcLength - 1]) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + if (g_pass == COMPILE && + Program_scopeCheck(&g_program, &on->pc[on->pcLength - 1], + findLabel(L_FUNC))) + { + return Value_new_ERROR(value, OUTOFSCOPE); + } + + ++g_pc.token; + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + break; + } + } + + on->pc[0] = g_pc; + } + + return (struct Value *)0; +} + +struct Value *stmt_ONERROR(struct Value *value) +{ + if (DIRECTMODE) + { + return Value_new_ERROR(value, NOTINDIRECTMODE); + } + + ++g_pc.token; + if (g_pass == INTERPRET) + { + g_stack.onerror = g_pc; + Program_nextLine(&g_program, &g_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 (g_pass == INTERPRET) + { + g_stack.onerror.line = -1; + if (g_stack.resumeable) + { + g_pc = g_stack.erpc; + return Value_clone(value, &g_stack.err); + } + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_ONERROROFF(struct Value *value) +{ + if (DIRECTMODE) + { + return Value_new_ERROR(value, NOTINDIRECTMODE); + } + + if (g_pass == INTERPRET) + { + g_stack.onerror.line = -1; + } + + ++g_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 = g_pc; + + ++g_pc.token; + errpc = g_pc; + if (eval(value, _("mode or file"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (g_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 (g_pass == INTERPRET && inout == -1) + { + g_pc = errpc; + return Value_new_ERROR(value, BADMODE); + } + + if (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_pc.token; + } + + errpc = g_pc; + if (eval(value, _("channel"))->type == V_ERROR || + Value_retype(value, V_INTEGER)->type == V_ERROR) + { + g_pc = errpc; + return value; + } + + channel = value->u.integer; + Value_destroy(value); + if (g_pass == INTERPRET && channel < 0) + { + return Value_new_ERROR(value, OUTOFRANGE, _("channel")); + } + + if (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_pc.token; + if (eval(value, _("file name"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (inout == 3) + { + if (g_pc.token->type != T_COMMA) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_pc.token; + errpc = g_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 (g_pass == INTERPRET && recLength <= 0) + { + Value_destroy(value); + g_pc = errpc; + return Value_new_ERROR(value, OUTOFRANGE, _("record length")); + } + } + } + else /* parse ANSI syntax */ + { + struct Value channelValue; + int newMode; + + switch (g_pc.token->type) + { + case T_FOR_INPUT: + inout = 0; + mode = FS_ACCESS_READ; + ++g_pc.token; + break; + + case T_FOR_OUTPUT: + inout = 1; + mode = FS_ACCESS_WRITE; + ++g_pc.token; + break; + + case T_FOR_APPEND: + inout = 1; + mode = FS_ACCESS_WRITE; + append = 1; + ++g_pc.token; + break; + + case T_FOR_RANDOM: + inout = 3; + mode = FS_ACCESS_READWRITE; + ++g_pc.token; + break; + + case T_FOR_BINARY: + inout = 4; + mode = FS_ACCESS_READWRITE; + ++g_pc.token; + break; + + default: + inout = 3; + mode = FS_ACCESS_READWRITE; + break; + } + + switch (g_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; + ++g_pc.token; + } + + switch (g_pc.token->type) + { + case T_SHARED: + lock = FS_LOCK_NONE; + ++g_pc.token; + break; + + case T_LOCK_READ: + lock = FS_LOCK_SHARED; + ++g_pc.token; + break; + + case T_LOCK_WRITE: + lock = FS_LOCK_EXCLUSIVE; + ++g_pc.token; + break; + + default:; + } + + if (g_pc.token->type != T_AS) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGAS); + } + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_pc.token; + } + + errpc = g_pc; + if (eval(&channelValue, _("channel"))->type == V_ERROR || + Value_retype(&channelValue, V_INTEGER)->type == V_ERROR) + { + g_pc = errpc; + Value_destroy(value); + *value = channelValue; + return value; + } + + channel = channelValue.u.integer; + Value_destroy(&channelValue); + if (inout == 3) + { + if (g_pc.token->type == T_IDENTIFIER) + { + if (cistrcmp(g_pc.token->u.identifier->name, "len")) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGLEN); + } + + ++g_pc.token; + if (g_pc.token->type != T_EQ) + { + Value_destroy(value); + return Value_new_ERROR(value, MISSINGEQ); + } + + ++g_pc.token; + errpc = g_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 (g_pass == INTERPRET && recLength <= 0) + { + Value_destroy(value); + g_pc = errpc; + return Value_new_ERROR(value, OUTOFRANGE, _("record length")); + } + } + else + { + recLength = 1; + } + } + } + + /* open file with name value */ + if (g_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) + { + g_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) + { + g_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) +{ + ++g_pc.token; + if (eval(value, _("array subscript base"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) + { + return value; + } + + if (g_pass == INTERPRET) + { + g_optionbase = value->u.integer; + } + + Value_destroy(value); + return (struct Value *)0; +} + +struct Value *stmt_OPTIONRUN(struct Value *value) +{ + ++g_pc.token; + if (g_pass == INTERPRET) + { + FS_xonxoff(STDCHANNEL, 0); + } + + return (struct Value *)0; +} + +struct Value *stmt_OPTIONSTOP(struct Value *value) +{ + ++g_pc.token; + if (g_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 = (g_pc.token->type == T_OUT); + lpc = g_pc; + ++g_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 (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_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 (g_pass == INTERPRET) + { + if ((out ? FS_portOutput : FS_memOutput) (address, val) == -1) + { + g_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 = (g_pc.token->type == T_PRINT ? STDCHANNEL : LPCHANNEL); + int printusing = 0; + struct Value usingval; + struct String *using = (struct String *)0; + size_t usingpos = 0; + + ++g_pc.token; + if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + } + + if (g_pc.token->type == T_USING) + { + struct Pc usingpc; + + usingpc = g_pc; + printusing = 1; + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == COMPILE && + Program_imageLine(&g_program, g_pc.token->u.integer, + &usingpc.token->u.image) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHIMAGELINE); + } + else if (g_pass == INTERPRET) + { + using = usingpc.token->u.image.token->u.string; + } + + Value_new_STRING(&usingval); + ++g_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 (g_pc.token->type != T_SEMICOLON) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, MISSINGSEMICOLON); + } + + ++g_pc.token; + } + else + { + Value_new_STRING(&usingval); + using = &usingval.u.string; + } + + while (1) + { + struct Pc valuepc; + + valuepc = g_pc; + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR) + { + Value_destroy(&usingval); + return value; + } + + if (g_pass == INTERPRET) + { + struct String s; + + String_new(&s); + if (Value_toStringUsing(value, &s, using, &usingpos)->type == + V_ERROR) + { + Value_destroy(&usingval); + String_destroy(&s); + g_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 (g_pc.token->type == T_TAB || g_pc.token->type == T_SPC) + { + int tab = g_pc.token->type == T_TAB; + + ++g_pc.token; + if (g_pc.token->type != T_OP) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, MISSINGOP); + } + + ++g_pc.token; + if (eval(value, _("count"))->type == V_ERROR || + Value_retype(value, V_INTEGER)->type == V_ERROR) + { + Value_destroy(&usingval); + return value; + } + + if (g_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 (g_pc.token->type != T_CP) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, MISSINGCP); + } + + ++g_pc.token; + nl = 1; + } + + else if (g_pc.token->type == T_SEMICOLON) + { + ++g_pc.token; + nl = 0; + } + + else if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (g_pass == INTERPRET && !printusing) + { + FS_nextcol(chn); + } + + nl = 0; + } + + else + { + break; + } + + if (g_pass == INTERPRET && FS_flush(chn) == -1) + { + Value_destroy(&usingval); + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + } + + Value_destroy(&usingval); + if (g_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; + + ++g_pc.token; + argpc = g_pc; + if (eval(value, (const char *)0)) + { + Value_retype(value, V_INTEGER); + if (value->type == V_ERROR) + { + g_pc = argpc; + Value_destroy(value); + return Value_new_ERROR(value, MISSINGEXPR, + _("random number generator seed")); + } + + if (g_pass == INTERPRET) + { + srand(g_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) +{ + ++g_pc.token; + while (1) + { + struct Value *l; + struct Pc lvaluepc; + + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGREADIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 (g_pass == INTERPRET && dataread(value, l)) + { + g_pc = lvaluepc; + return value; + } + + if (g_pc.token->type == T_COMMA) + { + ++g_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 = g_pc; + + ++g_pc.token; + argpc = g_pc; + if (eval(&from, _("source file"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(&from, V_STRING)->type == V_ERROR)) + { + g_pc = argpc; + *value = from; + return value; + } + + if (g_pc.token->type != T_TO) + { + Value_destroy(&from); + return Value_new_ERROR(value, MISSINGTO); + } + + ++g_pc.token; + argpc = g_pc; + if (eval(value, _("destination file"))->type == V_ERROR || + (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) + { + g_pc = argpc; + return value; + } + + if (g_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); + g_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; + + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + first = g_pc.token->u.integer; + ++g_pc.token; + if (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + if (g_pc.token->type != T_INTEGER) + return Value_new_ERROR(value, MISSINGINCREMENT); + inc = g_pc.token->u.integer; + ++g_pc.token; + } + } + + if (g_pass == INTERPRET) + { + if (!DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + Program_renum(&g_program, first, inc); + } + + return (struct Value *)0; +} + +struct Value *stmt_REPEAT(struct Value *value) +{ + if (g_pass == DECLARE || g_pass == COMPILE) + { + pushLabel(L_REPEAT, &g_pc); + } + + ++g_pc.token; + return (struct Value *)0; +} + +struct Value *stmt_RESTORE(struct Value *value) +{ + struct Token *restorepc = g_pc.token; + + if (g_pass == INTERPRET) + { + g_curdata = g_pc.token->u.restore; + } + + ++g_pc.token; + if (g_pc.token->type == T_INTEGER) + { + if (g_pass == COMPILE && + Program_dataLine(&g_program, g_pc.token->u.integer, + &restorepc->u.restore) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHDATALINE); + } + + ++g_pc.token; + } + else if (g_pass == COMPILE) + { + restorepc->u.restore = g_stack.begindata; + } + + return (struct Value *)0; +} + +struct Value *stmt_RETURN(struct Value *value) +{ + if (g_pass == DECLARE || g_pass == COMPILE) + { + ++g_pc.token; + } + + if (g_pass == INTERPRET) + { + if (Auto_gosubReturn(&g_stack, &g_pc)) + { + Program_trace(&g_program, &g_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; + + g_stack.resumeable = 0; + ++g_pc.token; + argpc = g_pc; + if (g_pc.token->type == T_INTEGER) + { + if (Program_goLine(&g_program, g_pc.token->u.integer, &begin) == + (struct Pc *)0) + { + return Value_new_ERROR(value, NOSUCHLINE); + } + + if (g_pass == COMPILE && + Program_scopeCheck(&g_program, &begin, findLabel(L_FUNC))) + { + return Value_new_ERROR(value, OUTOFSCOPE); + } + + ++g_pc.token; + } + else if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + g_pc = argpc; + return value; + } + else if (g_pass == INTERPRET) + { + int chn; + struct Program newprogram; + + if ((chn = FS_openin(value->u.string.character)) == -1) + { + g_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)) + { + g_pc = argpc; + Program_destroy(&newprogram); + return value; + } + + FS_close(chn); + new(); + Program_destroy(&g_program); + g_program = newprogram; + if (Program_beginning(&g_program, &begin) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOPROGRAM); + } + } + else + { + Value_destroy(value); + } + } + else + { + if (Program_beginning(&g_program, &begin) == (struct Pc *)0) + { + return Value_new_ERROR(value, NOPROGRAM); + } + } + + if (g_pass == INTERPRET) + { + if (compileProgram(value, 1)->type == V_ERROR) + { + return value; + } + + g_pc = begin; + g_curdata = g_stack.begindata; + Global_clear(&g_globals); + FS_closefiles(); + Program_trace(&g_program, &g_pc, 0, 1); + } + + return (struct Value *)0; +} + +struct Value *stmt_SAVE(struct Value *value) +{ + struct Pc loadpc; + int name; + + if (g_pass == INTERPRET && !DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + ++g_pc.token; + loadpc = g_pc; + if (g_pc.token->type == T_EOL && g_program.name.length) + { + name = 0; + } + else + { + name = 1; + if (eval(value, _("file name"))->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + g_pc = loadpc; + return value; + } + } + + if (g_pass == INTERPRET) + { + int chn; + + if (name) + { + Program_setname(&g_program, value->u.string.character); + } + + if ((chn = FS_openout(g_program.name.character)) == -1) + { + g_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(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value)) + { + g_pc = loadpc; + return value; + } + + FS_close(chn); + g_program.unsaved = 0; + } + else if (name) + { + Value_destroy(value); + } + + return (struct Value *)0; +} + +struct Value *stmt_SELECTCASE(struct Value *value) +{ + struct Pc statementpc = g_pc; + + if (g_pass == DECLARE || g_pass == COMPILE) + { + pushLabel(L_SELECTCASE, &g_pc); + } + + ++g_pc.token; + if (eval(value, _("selector"))->type == V_ERROR) + { + return value; + } + + if (g_pass == DECLARE || g_pass == COMPILE) + { + statementpc.token->u.selectcase->type = value->type; + statementpc.token->u.selectcase->nextcasevalue.line = -1; + } + else + { + struct Pc casevaluepc; + int match = 0; + + g_pc = casevaluepc = statementpc.token->u.selectcase->nextcasevalue; + do + { + ++g_pc.token; + switch (casevaluepc.token->type) + { + case T_CASEVALUE: + { + do + { + struct Value casevalue1; + + if (g_pc.token->type == T_IS) + { + enum TokenType relop; + + ++g_pc.token; + relop = g_pc.token->type; + ++g_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 (g_pc.token->type == T_TO) /* match range */ + { + struct Value casevalue2; + + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_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) + { + g_pc = casevaluepc = + casevaluepc.token->u.casevalue->nextcasevalue; + } + else + { + g_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; + + ++g_pc.token; + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR || + Value_retype(value, V_STRING)->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + if (g_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 (g_pass == INTERPRET) + { + if (g_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; + + ++g_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 (g_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 (g_pass != INTERPRET) + { + ++g_pc.token; + } + + return (struct Value *)0; +} + +struct Value *stmt_SUBEXIT(struct Value *value) +{ + struct Pc *curfn = (struct Pc *)0; + + if (g_pass == DECLARE || g_pass == COMPILE) + { + if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 || + (curfn->token + 1)->u.identifier->defaultType != V_VOID) + { + return Value_new_ERROR(value, STRAYSUBEXIT); + } + } + + ++g_pc.token; + if (g_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; + + ++g_pc.token; + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGSWAPIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + else + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + lvaluepc = g_pc; + if (g_pc.token->type != T_IDENTIFIER) + { + return Value_new_ERROR(value, MISSINGSWAPIDENT); + } + + if (g_pass == DECLARE && + Global_variable(&g_globals, g_pc.token->u.identifier, + g_pc.token->u.identifier->defaultType, + (g_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) + { + g_pc = lvaluepc; + return Value_new_typeError(value, l2->type, l1->type); + } + + if (g_pass == INTERPRET) + { + struct Value foo; + + foo = *l1; + *l1 = *l2; + *l2 = foo; + } + + return (struct Value *)0; +} + +struct Value *stmt_SYSTEM(struct Value *value) +{ + ++g_pc.token; + if (g_pass == INTERPRET) + { + if (g_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) +{ + ++g_pc.token; + g_program.trace = 0; + return (struct Value *)0; +} + +struct Value *stmt_TRON(struct Value *value) +{ + ++g_pc.token; + g_program.trace = 1; + return (struct Value *)0; +} + +struct Value *stmt_TRUNCATE(struct Value *value) +{ + struct Pc chnpc; + int chn; + + chnpc = g_pc; + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pass == INTERPRET && FS_truncate(chn) == -1) + { + g_pc = chnpc; + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + + return (struct Value *)0; +} + +struct Value *stmt_UNNUM(struct Value *value) +{ + ++g_pc.token; + if (g_pass == INTERPRET) + { + if (!DIRECTMODE) + { + return Value_new_ERROR(value, NOTINPROGRAMMODE); + } + + Program_unnum(&g_program); + } + + return (struct Value *)0; +} + +struct Value *stmt_UNTIL(struct Value *value) +{ + struct Pc untilpc = g_pc; + struct Pc *repeatpc; + + ++g_pc.token; + if (eval(value, _("condition"))->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + if (Value_isNull(value)) + { + g_pc = untilpc.token->u.until; + } + + Value_destroy(value); + } + + if (g_pass == DECLARE || g_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 = g_pc; + ++g_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 (g_pc.token->type != T_COMMA) + { + return Value_new_ERROR(value, MISSINGCOMMA); + } + + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_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 (g_pass == INTERPRET) + { + int v; + + do + { + if ((v = FS_portInput(address)) == -1) + { + g_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 = g_pc; + + if (g_pass == DECLARE || g_pass == COMPILE) + { + pushLabel(L_WHILE, &g_pc); + } + + ++g_pc.token; + if (eval(value, _("condition"))->type == V_ERROR) + { + return value; + } + + if (g_pass == INTERPRET) + { + if (Value_isNull(value)) + { + g_pc = *whilepc.token->u.afterwend; + } + + Value_destroy(value); + } + + return (struct Value *)0; +} + +struct Value *stmt_WEND(struct Value *value) +{ + if (g_pass == DECLARE || g_pass == COMPILE) + { + struct Pc *whilepc; + + if ((whilepc = popLabel(L_WHILE)) == (struct Pc *)0) + { + return Value_new_ERROR(value, STRAYWEND, topLabelDescription()); + } + + *g_pc.token->u.whilepc = *whilepc; + ++g_pc.token; + *(whilepc->token->u.afterwend) = g_pc; + } + else + { + g_pc = *g_pc.token->u.whilepc; + } + + return (struct Value *)0; +} + +struct Value *stmt_WIDTH(struct Value *value) +{ + int chn = STDCHANNEL, width; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_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 (g_pass == INTERPRET && FS_width(chn, width) == -1) + { + return Value_new_ERROR(value, IOERROR, FS_errmsg); + } + } + + if (g_pc.token->type == T_COMMA) + { + ++g_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 (g_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; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_pc.token; + } + } + + while (1) + { + if (eval(value, (const char *)0)) + { + if (value->type == V_ERROR) + { + return value; + } + + if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) + { + ++g_pc.token; + } + else + { + break; + } + } + + if (g_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) +{ + g_stack.resumeable = 0; + ++g_pc.token; + if (g_pass == INTERPRET) + { + if (!g_program.runnable && compileProgram(value, 1)->type == V_ERROR) + { + return value; + } + + Program_xref(&g_program, STDCHANNEL); + } + + return (struct Value *)0; +} + +struct Value *stmt_ZONE(struct Value *value) +{ + int chn = STDCHANNEL, width; + + ++g_pc.token; + if (g_pc.token->type == T_CHANNEL) + { + ++g_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 (g_pc.token->type == T_COMMA) + { + ++g_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 (g_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/bas_statement.h b/apps/interpreters/bas/bas_statement.h new file mode 100644 index 000000000..49512171e --- /dev/null +++ b/apps/interpreters/bas/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 + * Gregory Nutt + * + * 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/bas_str.c b/apps/interpreters/bas/bas_str.c new file mode 100644 index 000000000..075f5529a --- /dev/null +++ b/apps/interpreters/bas/bas_str.c @@ -0,0 +1,457 @@ +/**************************************************************************** + * apps/interpreters/bas/bas_str.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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include +#include +#include +#include + +#include "bas_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/bas_str.h b/apps/interpreters/bas/bas_str.h new file mode 100644 index 000000000..0fb54ae02 --- /dev/null +++ b/apps/interpreters/bas/bas_str.h @@ -0,0 +1,115 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_STR_H +#define __APPS_EXAMPLES_BAS_BAS_STR_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include + +/**************************************************************************** + * 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_BAS_STR_H */ diff --git a/apps/interpreters/bas/bas_token.c b/apps/interpreters/bas/bas_token.c new file mode 100644 index 000000000..8c0e39aa8 --- /dev/null +++ b/apps/interpreters/bas/bas_token.c @@ -0,0 +1,5388 @@ + +#line 3 "" + +#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 +#include +#include +#include + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have . 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 +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 "bas_token.l" +/* Tokens and token sequence arrays. */ +#line 3 "bas_token.l" +/* #includes */ /*{{{C}}}*//*{{{*/ +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "bas_auto.h" +#include "bas_token.h" +#include "bas_statement.h" + +static int g_matchdata; +static int g_backslash_colon; +static int g_uppercase; +static struct Token *cur; +int yylex(void); + +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 "" + +#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 +#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 "bas_token.l" + + /* flex rules */ /*{{{*/ + if (g_matchdata) BEGIN(DATAINPUT); + +#line 1683 "" + + 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 "bas_token.l" +return T_CHANNEL; + YY_BREAK +case 2: +YY_RULE_SETUP +#line 107 "bas_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 "bas_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 "bas_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 "bas_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 "bas_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 "bas_token.l" +string2(); return T_STRING; + YY_BREAK +case 8: +YY_RULE_SETUP +#line 173 "bas_token.l" +return T_OP; + YY_BREAK +case 9: +YY_RULE_SETUP +#line 174 "bas_token.l" +return T_CP; + YY_BREAK +case 10: +YY_RULE_SETUP +#line 175 "bas_token.l" +return T_MULT; + YY_BREAK +case 11: +YY_RULE_SETUP +#line 176 "bas_token.l" +return T_PLUS; + YY_BREAK +case 12: +YY_RULE_SETUP +#line 177 "bas_token.l" +return T_MINUS; + YY_BREAK +case 13: +YY_RULE_SETUP +#line 178 "bas_token.l" +return T_COMMA; + YY_BREAK +case 14: +YY_RULE_SETUP +#line 179 "bas_token.l" +return T_DIV; + YY_BREAK +case 15: +YY_RULE_SETUP +#line 180 "bas_token.l" +{ + if (g_backslash_colon) + { + if (cur) cur->statement=stmt_COLON_EOL; + return T_COLON; + } + return T_IDIV; + } + YY_BREAK +case 16: +YY_RULE_SETUP +#line 188 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_COLON_EOL; + } + return T_COLON; + } + YY_BREAK +case 17: +YY_RULE_SETUP +#line 195 "bas_token.l" +return T_SEMICOLON; + YY_BREAK +case 18: +YY_RULE_SETUP +#line 196 "bas_token.l" +return T_LT; + YY_BREAK +case 19: +YY_RULE_SETUP +#line 197 "bas_token.l" +return T_LE; + YY_BREAK +case 20: +YY_RULE_SETUP +#line 198 "bas_token.l" +return T_LE; + YY_BREAK +case 21: +YY_RULE_SETUP +#line 199 "bas_token.l" +return T_NE; + YY_BREAK +case 22: +YY_RULE_SETUP +#line 200 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_EQ; + } + YY_BREAK +case 23: +YY_RULE_SETUP +#line 207 "bas_token.l" +return T_GT; + YY_BREAK +case 24: +YY_RULE_SETUP +#line 208 "bas_token.l" +return T_GE; + YY_BREAK +case 25: +YY_RULE_SETUP +#line 209 "bas_token.l" +return T_GE; + YY_BREAK +case 26: +YY_RULE_SETUP +#line 210 "bas_token.l" +return T_POW; + YY_BREAK +case 27: +YY_RULE_SETUP +#line 211 "bas_token.l" +return T_ACCESS_READ; + YY_BREAK +case 28: +YY_RULE_SETUP +#line 212 "bas_token.l" +return T_ACCESS_READ_WRITE; + YY_BREAK +case 29: +YY_RULE_SETUP +#line 213 "bas_token.l" +return T_ACCESS_WRITE; + YY_BREAK +case 30: +YY_RULE_SETUP +#line 214 "bas_token.l" +return T_AND; + YY_BREAK +case 31: +YY_RULE_SETUP +#line 215 "bas_token.l" +return T_AS; + YY_BREAK +case 32: +YY_RULE_SETUP +#line 216 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CALL; + } + return T_CALL; + } + YY_BREAK +case 33: +YY_RULE_SETUP +#line 223 "bas_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 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_CHDIR; + } + YY_BREAK +case 36: +YY_RULE_SETUP +#line 246 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CLEAR; + } + return T_CLEAR; + } + YY_BREAK +case 37: +YY_RULE_SETUP +#line 253 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } + YY_BREAK +case 39: +YY_RULE_SETUP +#line 267 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CLS; + } + return T_CLS; + } + YY_BREAK +case 40: +YY_RULE_SETUP +#line 274 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_COLOR; + } + return T_COLOR; + } + YY_BREAK +case 41: +YY_RULE_SETUP +#line 281 "bas_token.l" +return T_CON; + YY_BREAK +case 42: +YY_RULE_SETUP +#line 282 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_COPY; + } + YY_BREAK +case 43: +YY_RULE_SETUP +#line 289 "bas_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 "bas_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 "bas_token.l" +string2(); return T_STRING; + YY_BREAK +case 46: +YY_RULE_SETUP +#line 299 "bas_token.l" +return T_COMMA; + YY_BREAK +case 47: +YY_RULE_SETUP +#line 300 "bas_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 "bas_token.l" + + YY_BREAK +case 49: +/* rule 49 can match eol */ +YY_RULE_SETUP +#line 305 "bas_token.l" +BEGIN(INITIAL); + YY_BREAK +case 50: +YY_RULE_SETUP +#line 306 "bas_token.l" +BEGIN(INITIAL); return T_COLON; + YY_BREAK +case 51: +YY_RULE_SETUP +#line 307 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_DEC; + } + YY_BREAK +case 52: +YY_RULE_SETUP +#line 314 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFDBL; + } + YY_BREAK +case 53: +YY_RULE_SETUP +#line 321 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFINT; + } + YY_BREAK +case 54: +YY_RULE_SETUP +#line 328 "bas_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 "bas_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 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DELETE; + } + return T_DELETE; + } + YY_BREAK +case 58: +YY_RULE_SETUP +#line 358 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DIM; + } + return T_DIM; + } + YY_BREAK +case 59: +YY_RULE_SETUP +#line 365 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DISPLAY; + } + return T_DISPLAY; + } + YY_BREAK +case 60: +YY_RULE_SETUP +#line 372 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DO; + } + return T_DO; + } + YY_BREAK +case 61: +YY_RULE_SETUP +#line 379 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOUNTIL; + } + YY_BREAK +case 62: +YY_RULE_SETUP +#line 386 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DOcondition; + } + return T_DOWHILE; + } + YY_BREAK +case 63: +YY_RULE_SETUP +#line 393 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EDIT; + } + return T_EDIT; + } + YY_BREAK +case 64: +YY_RULE_SETUP +#line 400 "bas_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 "bas_token.l" +{ + BEGIN(ELSEIF); + if (cur) + { + cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSEIFELSE; + } + YY_BREAK +case 66: +YY_RULE_SETUP +#line 415 "bas_token.l" +{ + BEGIN(INITIAL); + if (cur) + { + cur->statement=stmt_IF_ELSEIFIF; + } + return T_ELSEIFIF; + } + YY_BREAK +case 67: +YY_RULE_SETUP +#line 423 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDFN; + } + return T_ENDFN; + } + YY_BREAK +case 68: +YY_RULE_SETUP +#line 430 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDIF; + } + return T_ENDIF; + } + YY_BREAK +case 69: +YY_RULE_SETUP +#line 437 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_ENDPROC; + } + YY_BREAK +case 70: +YY_RULE_SETUP +#line 444 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDSELECT; + } + return T_ENDSELECT; + } + YY_BREAK +case 71: +YY_RULE_SETUP +#line 451 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } + YY_BREAK +case 72: +YY_RULE_SETUP +#line 458 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_END; + } + return T_END; + } + YY_BREAK +case 73: +YY_RULE_SETUP +#line 465 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENVIRON; + } + return T_ENVIRON; + } + YY_BREAK +case 74: +YY_RULE_SETUP +#line 472 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ERASE; + } + return T_ERASE; + } + YY_BREAK +case 75: +YY_RULE_SETUP +#line 479 "bas_token.l" +return T_EQV; + YY_BREAK +case 76: +YY_RULE_SETUP +#line 480 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EXITDO; + } + return T_EXITDO; + } + YY_BREAK +case 77: +YY_RULE_SETUP +#line 487 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EXITFOR; + } + return T_EXITFOR; + } + YY_BREAK +case 78: +YY_RULE_SETUP +#line 494 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_FNEXIT; + } + return T_FNEXIT; + } + YY_BREAK +case 79: +YY_RULE_SETUP +#line 501 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } + YY_BREAK +case 80: +YY_RULE_SETUP +#line 508 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_FIELD; + } + return T_FIELD; + } + YY_BREAK +case 82: +YY_RULE_SETUP +#line 522 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNEND; + } + YY_BREAK +case 83: +YY_RULE_SETUP +#line 529 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNRETURN; + } + YY_BREAK +case 84: +YY_RULE_SETUP +#line 536 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_FOR; + } + return T_FOR; + } + YY_BREAK +case 85: +YY_RULE_SETUP +#line 543 "bas_token.l" +return T_FOR_INPUT; + YY_BREAK +case 86: +YY_RULE_SETUP +#line 544 "bas_token.l" +return T_FOR_OUTPUT; + YY_BREAK +case 87: +YY_RULE_SETUP +#line 545 "bas_token.l" +return T_FOR_APPEND; + YY_BREAK +case 88: +YY_RULE_SETUP +#line 546 "bas_token.l" +return T_FOR_RANDOM; + YY_BREAK +case 89: +YY_RULE_SETUP +#line 547 "bas_token.l" +return T_FOR_BINARY; + YY_BREAK +case 90: +YY_RULE_SETUP +#line 548 "bas_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 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_GET; + } + YY_BREAK +case 93: +YY_RULE_SETUP +#line 570 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_GOSUB; + } + return T_GOSUB; + } + YY_BREAK +case 94: +YY_RULE_SETUP +#line 577 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_GOTO; + } + YY_BREAK +case 95: +YY_RULE_SETUP +#line 584 "bas_token.l" +return T_IDN; + YY_BREAK +case 96: +YY_RULE_SETUP +#line 585 "bas_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 "bas_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 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } + YY_BREAK +case 100: +YY_RULE_SETUP +#line 620 "bas_token.l" +return T_IMP; + YY_BREAK +case 101: +YY_RULE_SETUP +#line 621 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_DEC_INC; + } + return T_INC; + } + YY_BREAK +case 102: +YY_RULE_SETUP +#line 628 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_INPUT; + } + return T_INPUT; + } + YY_BREAK +case 104: +YY_RULE_SETUP +#line 642 "bas_token.l" +return T_INV; + YY_BREAK +case 105: +YY_RULE_SETUP +#line 643 "bas_token.l" +return T_IS; + YY_BREAK +case 106: +YY_RULE_SETUP +#line 644 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_KILL; + } + return T_KILL; + } + YY_BREAK +case 107: +YY_RULE_SETUP +#line 651 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LET; + } + return T_LET; + } + YY_BREAK +case 108: +YY_RULE_SETUP +#line 658 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LIST; + } + YY_BREAK +case 109: +YY_RULE_SETUP +#line 665 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LIST_LLIST; + } + return T_LLIST; + } + YY_BREAK +case 110: +YY_RULE_SETUP +#line 672 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOAD; + } + return T_LOAD; + } + YY_BREAK +case 111: +YY_RULE_SETUP +#line 679 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOCAL; + } + return T_LOCAL; + } + YY_BREAK +case 112: +YY_RULE_SETUP +#line 686 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOCATE; + } + return T_LOCATE; + } + YY_BREAK +case 113: +YY_RULE_SETUP +#line 693 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_LOCK; + } + YY_BREAK +case 114: +YY_RULE_SETUP +#line 700 "bas_token.l" +return T_LOCK_READ; + YY_BREAK +case 115: +YY_RULE_SETUP +#line 701 "bas_token.l" +return T_LOCK_WRITE; + YY_BREAK +case 116: +YY_RULE_SETUP +#line 702 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOOP; + } + return T_LOOP; + } + YY_BREAK +case 117: +YY_RULE_SETUP +#line 709 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOOPUNTIL; + } + return T_LOOPUNTIL; + } + YY_BREAK +case 118: +YY_RULE_SETUP +#line 716 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_LPRINT; + } + YY_BREAK +case 119: +YY_RULE_SETUP +#line 723 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_LSET; + } + YY_BREAK +case 120: +YY_RULE_SETUP +#line 730 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MATINPUT; + } + return T_MATINPUT; + } + YY_BREAK +case 121: +YY_RULE_SETUP +#line 737 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MATPRINT; + } + return T_MATPRINT; + } + YY_BREAK +case 122: +YY_RULE_SETUP +#line 744 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MATREAD; + } + return T_MATREAD; + } + YY_BREAK +case 123: +YY_RULE_SETUP +#line 751 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MATREDIM; + } + return T_MATREDIM; + } + YY_BREAK +case 124: +YY_RULE_SETUP +#line 758 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MATWRITE; + } + return T_MATWRITE; + } + YY_BREAK +case 125: +YY_RULE_SETUP +#line 765 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_MAT; + } + return T_MAT; + } + YY_BREAK +case 126: +YY_RULE_SETUP +#line 772 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_CHDIR_MKDIR; + } + return T_MKDIR; + } + YY_BREAK +case 127: +YY_RULE_SETUP +#line 779 "bas_token.l" +return T_MOD; + YY_BREAK +case 128: +YY_RULE_SETUP +#line 780 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_NEW; + } + return T_NEW; + } + YY_BREAK +case 129: +YY_RULE_SETUP +#line 787 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_NAME; + } + return T_NAME; + } + YY_BREAK +case 130: +YY_RULE_SETUP +#line 794 "bas_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 "bas_token.l" +return T_NOT; + YY_BREAK +case 132: +YY_RULE_SETUP +#line 803 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ONERROROFF; + } + return T_ONERROROFF; + } + YY_BREAK +case 133: +YY_RULE_SETUP +#line 810 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ONERRORGOTO0; + } + return T_ONERRORGOTO0; + } + YY_BREAK +case 134: +YY_RULE_SETUP +#line 817 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ONERROR; + } + return T_ONERROR; + } + YY_BREAK +case 135: +YY_RULE_SETUP +#line 824 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OPEN; + } + return T_OPEN; + } + YY_BREAK +case 137: +YY_RULE_SETUP +#line 840 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONBASE; + } + return T_OPTIONBASE; + } + YY_BREAK +case 138: +YY_RULE_SETUP +#line 847 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONRUN; + } + return T_OPTIONRUN; + } + YY_BREAK +case 139: +YY_RULE_SETUP +#line 854 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OPTIONSTOP; + } + return T_OPTIONSTOP; + } + YY_BREAK +case 140: +YY_RULE_SETUP +#line 861 "bas_token.l" +return T_OR; + YY_BREAK +case 141: +YY_RULE_SETUP +#line 862 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_OUT; + } + YY_BREAK +case 142: +YY_RULE_SETUP +#line 869 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } + YY_BREAK +case 144: +YY_RULE_SETUP +#line 883 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_OUT_POKE; + } + return T_POKE; + } + YY_BREAK +case 145: +YY_RULE_SETUP +#line 890 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_GET_PUT; + } + return T_PUT; + } + YY_BREAK +case 147: +YY_RULE_SETUP +#line 904 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RANDOMIZE; + } + return T_RANDOMIZE; + } + YY_BREAK +case 148: +YY_RULE_SETUP +#line 911 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_READ; + } + return T_READ; + } + YY_BREAK +case 149: +YY_RULE_SETUP +#line 918 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RENUM; + } + return T_RENUM; + } + YY_BREAK +case 150: +YY_RULE_SETUP +#line 925 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_REPEAT; + } + return T_REPEAT; + } + YY_BREAK +case 151: +YY_RULE_SETUP +#line 932 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RESTORE; + } + return T_RESTORE; + } + YY_BREAK +case 152: +YY_RULE_SETUP +#line 939 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RESUME_GOTO; + } + return T_RESUME; + } + YY_BREAK +case 153: +YY_RULE_SETUP +#line 946 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RETURN; + } + return T_RETURN; + } + YY_BREAK +case 154: +YY_RULE_SETUP +#line 953 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LSET_RSET; + } + return T_RSET; + } + YY_BREAK +case 155: +YY_RULE_SETUP +#line 960 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_RUN; + } + return T_RUN; + } + YY_BREAK +case 156: +YY_RULE_SETUP +#line 967 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SAVE; + } + return T_SAVE; + } + YY_BREAK +case 157: +YY_RULE_SETUP +#line 974 "bas_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 "bas_token.l" +return T_SHARED; + YY_BREAK +case 159: +YY_RULE_SETUP +#line 983 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SHELL; + } + return T_SHELL; + } + YY_BREAK +case 160: +YY_RULE_SETUP +#line 990 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SLEEP; + } + return T_SLEEP; + } + YY_BREAK +case 161: +YY_RULE_SETUP +#line 997 "bas_token.l" +return T_SPC; + YY_BREAK +case 162: +YY_RULE_SETUP +#line 998 "bas_token.l" +return T_STEP; + YY_BREAK +case 163: +YY_RULE_SETUP +#line 999 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_STOP; + } + return T_STOP; + } + YY_BREAK +case 164: +YY_RULE_SETUP +#line 1006 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } + YY_BREAK +case 165: +YY_RULE_SETUP +#line 1013 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } + YY_BREAK +case 166: +YY_RULE_SETUP +#line 1020 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SWAP; + } + return T_SWAP; + } + YY_BREAK +case 168: +YY_RULE_SETUP +#line 1035 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_SYSTEM; + } + return T_SYSTEM; + } + YY_BREAK +case 169: +YY_RULE_SETUP +#line 1042 "bas_token.l" +return T_THEN; + YY_BREAK +case 170: +YY_RULE_SETUP +#line 1043 "bas_token.l" +return T_TAB; + YY_BREAK +case 171: +YY_RULE_SETUP +#line 1044 "bas_token.l" +return T_TO; + YY_BREAK +case 172: +YY_RULE_SETUP +#line 1045 "bas_token.l" +return T_TRN; + YY_BREAK +case 173: +YY_RULE_SETUP +#line 1046 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_TROFF; + } + return T_TROFF; + } + YY_BREAK +case 174: +YY_RULE_SETUP +#line 1053 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_TRON; + } + return T_TRON; + } + YY_BREAK +case 175: +YY_RULE_SETUP +#line 1060 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_TRUNCATE; + } + return T_TRUNCATE; + } + YY_BREAK +case 176: +YY_RULE_SETUP +#line 1067 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LOCK_UNLOCK; + } + return T_UNLOCK; + } + YY_BREAK +case 177: +YY_RULE_SETUP +#line 1074 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_UNNUM; + } + return T_UNNUM; + } + YY_BREAK +case 178: +YY_RULE_SETUP +#line 1081 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_UNTIL; + } + return T_UNTIL; + } + YY_BREAK +case 179: +YY_RULE_SETUP +#line 1088 "bas_token.l" +return T_USING; + YY_BREAK +case 180: +YY_RULE_SETUP +#line 1089 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_WAIT; + } + return T_WAIT; + } + YY_BREAK +case 181: +YY_RULE_SETUP +#line 1096 "bas_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 "bas_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 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } + YY_BREAK +case 185: +YY_RULE_SETUP +#line 1126 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_WRITE; + } + return T_WRITE; + } + YY_BREAK +case 187: +YY_RULE_SETUP +#line 1140 "bas_token.l" +return T_XOR; + YY_BREAK +case 188: +YY_RULE_SETUP +#line 1141 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_XREF; + } + return T_XREF; + } + YY_BREAK +case 189: +YY_RULE_SETUP +#line 1148 "bas_token.l" +return T_ZER; + YY_BREAK +case 190: +YY_RULE_SETUP +#line 1149 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_ZONE; + } + return T_ZONE; + } + YY_BREAK +case 191: +YY_RULE_SETUP +#line 1156 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_COPY_RENAME; + } + return T_RENAME; + } + YY_BREAK +case 193: +YY_RULE_SETUP +#line 1171 "bas_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 "bas_token.l" +{ + if (cur) + { + cur->statement=stmt_LINEINPUT; + } + return T_LINEINPUT; + } + YY_BREAK +case 195: +YY_RULE_SETUP +#line 1186 "bas_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 "bas_token.l" + + YY_BREAK +case 197: +YY_RULE_SETUP +#line 1226 "bas_token.l" +{ + if (cur) cur->u.junk=yytext[0]; + return T_JUNK; + } + YY_BREAK +/*}}}*/ +case 198: +YY_RULE_SETUP +#line 1231 "bas_token.l" +ECHO; + YY_BREAK +#line 3711 "" +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 bas_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 "bas_token.l" + + + +int g_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 */ /*{{{*/ + g_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; + g_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); + g_matchdata=1; + for (l=1; yylex(); ++l); + yy_delete_buffer(buf); + cur=result=malloc(sizeof(struct Token)*l); + buf=yy_scan_string(ln); + g_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",g_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 (g_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) \ + g_token_property[t]=(assoc<<8)|(unary_priority<<5)|(binary_priority<<2)|(is_unary<<1)|is_binary + + g_backslash_colon=b_c; + g_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/bas_token.h b/apps/interpreters/bas/bas_token.h new file mode 100644 index 000000000..ed0af2b6b --- /dev/null +++ b/apps/interpreters/bas/bas_token.h @@ -0,0 +1,546 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_TOKEN_H +#define __APPS_EXAMPLES_BAS_BAS_TOKEN_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_autotypes.h" +#include "bas_value.h" +#include "bas_var.h" + +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + +#define TOKEN_ISBINARYOPERATOR(t) (g_token_property[t]&1) +#define TOKEN_ISUNARYOPERATOR(t) (g_token_property[t]&(1<<1)) +#define TOKEN_BINARYPRIORITY(t) ((g_token_property[t]>>2)&7) +#define TOKEN_UNARYPRIORITY(t) ((g_token_property[t]>>5)&7) +#define TOKEN_ISRIGHTASSOCIATIVE(t) (g_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 "bas_program.h" +#include "bas_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 g_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_BAS_TOKEN_H */ diff --git a/apps/interpreters/bas/bas_token.l b/apps/interpreters/bas/bas_token.l new file mode 100644 index 000000000..d28267df6 --- /dev/null +++ b/apps/interpreters/bas/bas_token.l @@ -0,0 +1,1938 @@ +/* Tokens and token sequence arrays. */ +%{ +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "bas_auto.h" +#include "bas_token.h" +#include "bas_statement.h" + +static int g_matchdata; +static int g_backslash_colon; +static int g_uppercase; +int yylex(void); +static struct Token *g_cur; + +static void string(const char *text) +{ + if (g_cur) + { + const char *t; + char *q; + size_t l; + + for (t=text+1,l=0; *(t+1); ++t,++l) + { + if (*t=='"') ++t; + } + g_cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(g_cur->u.string),l); + for (t=text+1,q=g_cur->u.string->character; *(t+1); ++t,++q) + { + *q=*t; + if (*t=='"') ++t; + } + } +} + +static void string2(void) +{ + if (g_cur) + { + char *t,*q; + size_t l; + + for (t=yytext+1,l=0; *t; ++t,++l) + { + if (*t=='"') ++t; + } + g_cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(g_cur->u.string),l); + for (t=yytext+1,q=g_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 (g_matchdata) BEGIN(DATAINPUT); + +"#" return T_CHANNEL; +{REAL} { + int overflow; + double d; + + d=Value_vald(yytext,(char**)0,&overflow); + if (overflow) + { + if (g_cur) g_cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (g_cur) g_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 (g_cur) g_cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (g_cur) g_cur->u.real=d; + return T_REAL; + } + if (g_cur) g_cur->u.integer=n; + return T_INTEGER; + } +{HEXINTEGER} { + int overflow; + long int n; + + n=Value_vali(yytext,(char**)0,&overflow); + if (overflow) + { + if (g_cur) g_cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (g_cur) g_cur->u.hexinteger=n; + return T_HEXINTEGER; + } +{OCTINTEGER} { + int overflow; + long int n; + + n=Value_vali(yytext,(char**)0,&overflow); + if (overflow) + { + if (g_cur) g_cur->u.junk=yytext[0]; + yyless(1); + return T_JUNK; + } + if (g_cur) g_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 (g_backslash_colon) + { + if (g_cur) g_cur->statement=stmt_COLON_EOL; + return T_COLON; + } + return T_IDIV; + } +":" { + if (g_cur) + { + g_cur->statement=stmt_COLON_EOL; + } + return T_COLON; + } +";" return T_SEMICOLON; +"<" return T_LT; +"<=" return T_LE; +"=<" return T_LE; +"<>"|"><" return T_NE; +"=" { + if (g_cur) + { + g_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 (g_cur) + { + g_cur->statement=stmt_CALL; + } + return T_CALL; + } +"case"[ \t]+"else" { + if (g_cur) + { + g_cur->statement=stmt_CASE; + g_cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEELSE; + } +"case" { + if (g_cur) + { + g_cur->statement=stmt_CASE; + g_cur->u.casevalue=malloc(sizeof(struct Casevalue)); + } + return T_CASEVALUE; + } +"chdir" { + if (g_cur) + { + g_cur->statement=stmt_CHDIR_MKDIR; + } + return T_CHDIR; + } +"clear" { + if (g_cur) + { + g_cur->statement=stmt_CLEAR; + } + return T_CLEAR; + } +"close" { + if (g_cur) + { + g_cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } +"close"/"#" { + if (g_cur) + { + g_cur->statement=stmt_CLOSE; + } + return T_CLOSE; + } +"cls"|"home" { + if (g_cur) + { + g_cur->statement=stmt_CLS; + } + return T_CLS; + } +"color" { + if (g_cur) + { + g_cur->statement=stmt_COLOR; + } + return T_COLOR; + } +"con" return T_CON; +"copy" { + if (g_cur) + { + g_cur->statement=stmt_COPY_RENAME; + } + return T_COPY; + } +"data"|"d." { + BEGIN(DATAINPUT); + if (g_cur) + { + g_cur->statement=stmt_DATA; + } + return T_DATA; + } +{STRING} string(yytext); return T_STRING; +{STRING2} string2(); return T_STRING; +"," return T_COMMA; +{DATAITEM} { + if (g_cur) g_cur->u.datainput=strcpy(malloc(strlen(yytext)+1),yytext); + return T_DATAINPUT; + } +[ \t]+ +\n BEGIN(INITIAL); +: BEGIN(INITIAL); return T_COLON; +"dec" { + if (g_cur) + { + g_cur->statement=stmt_DEC_INC; + } + return T_DEC; + } +"defdbl" { + if (g_cur) + { + g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFDBL; + } +"defint" { + if (g_cur) + { + g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFINT; + } +"defstr" { + if (g_cur) + { + g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; + } + return T_DEFSTR; + } +"def"/[ \t]+fn[ \t]*[A-Z_0-9\.] { + if (g_cur) + { + g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + g_cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFFN; + } +"def"/[ \t]+proc[A-Z_0-9\.] { + if (g_cur) + { + g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + g_cur->u.localSyms=(struct Symbol*)0; + } + return T_DEFPROC; + } +"delete" { + if (g_cur) + { + g_cur->statement=stmt_DELETE; + } + return T_DELETE; + } +"dim" { + if (g_cur) + { + g_cur->statement=stmt_DIM; + } + return T_DIM; + } +"display" { + if (g_cur) + { + g_cur->statement=stmt_DISPLAY; + } + return T_DISPLAY; + } +"do" { + if (g_cur) + { + g_cur->statement=stmt_DO; + } + return T_DO; + } +{DOUNTIL} { + if (g_cur) + { + g_cur->statement=stmt_DOcondition; + } + return T_DOUNTIL; + } +{DOWHILE} { + if (g_cur) + { + g_cur->statement=stmt_DOcondition; + } + return T_DOWHILE; + } +"edit" { + if (g_cur) + { + g_cur->statement=stmt_EDIT; + } + return T_EDIT; + } +"else"|"el." { + if (g_cur) + { + g_cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSE; + } +"else"/"if" { + BEGIN(ELSEIF); + if (g_cur) + { + g_cur->statement=stmt_ELSE_ELSEIFELSE; + } + return T_ELSEIFELSE; + } +"if" { + BEGIN(INITIAL); + if (g_cur) + { + g_cur->statement=stmt_IF_ELSEIFIF; + } + return T_ELSEIFIF; + } +end[ \t]+function { + if (g_cur) + { + g_cur->statement=stmt_ENDFN; + } + return T_ENDFN; + } +{ENDIF} { + if (g_cur) + { + g_cur->statement=stmt_ENDIF; + } + return T_ENDIF; + } +{ENDPROC} { + if (g_cur) + { + g_cur->statement=stmt_ENDPROC_SUBEND; + } + return T_ENDPROC; + } +{ENDSELECT} { + if (g_cur) + { + g_cur->statement=stmt_ENDSELECT; + } + return T_ENDSELECT; + } +"end"[ \t]*"sub" { + if (g_cur) + { + g_cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } +"end" { + if (g_cur) + { + g_cur->statement=stmt_END; + } + return T_END; + } +"environ" { + if (g_cur) + { + g_cur->statement=stmt_ENVIRON; + } + return T_ENVIRON; + } +"erase" { + if (g_cur) + { + g_cur->statement=stmt_ERASE; + } + return T_ERASE; + } +"eqv" return T_EQV; +{EXITDO} { + if (g_cur) + { + g_cur->statement=stmt_EXITDO; + } + return T_EXITDO; + } +{EXITFOR} { + if (g_cur) + { + g_cur->statement=stmt_EXITFOR; + } + return T_EXITFOR; + } +"exit"[ \t]+"function" { + if (g_cur) + { + g_cur->statement=stmt_FNEXIT; + } + return T_FNEXIT; + } +"exit"[ \t]+"sub" { + if (g_cur) + { + g_cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } +"field" { + if (g_cur) + { + g_cur->statement=stmt_FIELD; + } + return T_FIELD; + } +"field"/"#" { + if (g_cur) + { + g_cur->statement=stmt_FIELD; + } + return T_FIELD; + } +"fnend" { + if (g_cur) + { + g_cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNEND; + } +"fnreturn" { + if (g_cur) + { + g_cur->statement=stmt_EQ_FNRETURN_FNEND; + } + return T_FNRETURN; + } +"for" { + if (g_cur) + { + g_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 (g_cur) + { + g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + g_cur->u.localSyms=(struct Symbol*)0; + } + return T_FUNCTION; + } +"get" { + if (g_cur) + { + g_cur->statement=stmt_GET_PUT; + } + return T_GET; + } +"get"/"#" { + if (g_cur) + { + g_cur->statement=stmt_GET_PUT; + } + return T_GET; + } +"go"[ \t]*"sub" { + if (g_cur) + { + g_cur->statement=stmt_GOSUB; + } + return T_GOSUB; + } +"go"[ \t]*"to" { + if (g_cur) + { + g_cur->statement=stmt_RESUME_GOTO; + } + return T_GOTO; + } +"idn" return T_IDN; +"if" { + if (g_cur) + { + g_cur->statement=stmt_IF_ELSEIFIF; + } + return T_IF; + } +"image"[ \t]*/[^"\n \t] { + BEGIN(IMAGEFMT); + if (g_cur) + { + g_cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } +.*$ { + BEGIN(INITIAL); + if (g_cur) + { + size_t l; + + l=strlen(yytext); + g_cur->u.string=malloc(sizeof(struct String)); + String_size(String_new(g_cur->u.string),l); + memcpy(g_cur->u.string->character,yytext,l); + } + return T_STRING; + } +"image" { + if (g_cur) + { + g_cur->statement=stmt_IMAGE; + } + return T_IMAGE; + } +"imp" return T_IMP; +"inc" { + if (g_cur) + { + g_cur->statement=stmt_DEC_INC; + } + return T_INC; + } +"input" { + if (g_cur) + { + g_cur->statement=stmt_INPUT; + } + return T_INPUT; + } +"input"/"#" { + if (g_cur) + { + g_cur->statement=stmt_INPUT; + } + return T_INPUT; + } +"inv" return T_INV; +"is" return T_IS; +"kill" { + if (g_cur) + { + g_cur->statement=stmt_KILL; + } + return T_KILL; + } +"let" { + if (g_cur) + { + g_cur->statement=stmt_LET; + } + return T_LET; + } +"list" { + if (g_cur) + { + g_cur->statement=stmt_LIST_LLIST; + } + return T_LIST; + } +"llist" { + if (g_cur) + { + g_cur->statement=stmt_LIST_LLIST; + } + return T_LLIST; + } +"load" { + if (g_cur) + { + g_cur->statement=stmt_LOAD; + } + return T_LOAD; + } +"local" { + if (g_cur) + { + g_cur->statement=stmt_LOCAL; + } + return T_LOCAL; + } +"locate" { + if (g_cur) + { + g_cur->statement=stmt_LOCATE; + } + return T_LOCATE; + } +"lock" { + if (g_cur) + { + g_cur->statement=stmt_LOCK_UNLOCK; + } + return T_LOCK; + } +"lock"[ \t]+"read" return T_LOCK_READ; +"lock"[ \t]+"write" return T_LOCK_WRITE; +"loop" { + if (g_cur) + { + g_cur->statement=stmt_LOOP; + } + return T_LOOP; + } +{LOOPUNTIL} { + if (g_cur) + { + g_cur->statement=stmt_LOOPUNTIL; + } + return T_LOOPUNTIL; + } +"lprint" { + if (g_cur) + { + g_cur->statement=stmt_PRINT_LPRINT; + } + return T_LPRINT; + } +"lset" { + if (g_cur) + { + g_cur->statement=stmt_LSET_RSET; + } + return T_LSET; + } +"mat"[ \t]+"input" { + if (g_cur) + { + g_cur->statement=stmt_MATINPUT; + } + return T_MATINPUT; + } +"mat"[ \t]+"print" { + if (g_cur) + { + g_cur->statement=stmt_MATPRINT; + } + return T_MATPRINT; + } +"mat"[ \t]+"read" { + if (g_cur) + { + g_cur->statement=stmt_MATREAD; + } + return T_MATREAD; + } +"mat"[ \t]+"redim" { + if (g_cur) + { + g_cur->statement=stmt_MATREDIM; + } + return T_MATREDIM; + } +"mat"[ \t]+"write" { + if (g_cur) + { + g_cur->statement=stmt_MATWRITE; + } + return T_MATWRITE; + } +"mat" { + if (g_cur) + { + g_cur->statement=stmt_MAT; + } + return T_MAT; + } +"mkdir" { + if (g_cur) + { + g_cur->statement=stmt_CHDIR_MKDIR; + } + return T_MKDIR; + } +"mod" return T_MOD; +"new" { + if (g_cur) + { + g_cur->statement=stmt_NEW; + } + return T_NEW; + } +"name" { + if (g_cur) + { + g_cur->statement=stmt_NAME; + } + return T_NAME; + } +"next" { + if (g_cur) + { + g_cur->statement=stmt_NEXT; + g_cur->u.next=malloc(sizeof(struct Next)); + } + return T_NEXT; + } +"not" return T_NOT; +{ONERROROFF} { + if (g_cur) + { + g_cur->statement=stmt_ONERROROFF; + } + return T_ONERROROFF; + } +{ONERRORGOTO0} { + if (g_cur) + { + g_cur->statement=stmt_ONERRORGOTO0; + } + return T_ONERRORGOTO0; + } +{ONERROR} { + if (g_cur) + { + g_cur->statement=stmt_ONERROR; + } + return T_ONERROR; + } +"on" { + if (g_cur) + { + g_cur->statement=stmt_ON; + g_cur->u.on.pcLength=1; + g_cur->u.on.pc=(struct Pc*)0; + } + return T_ON; + } +"open" { + if (g_cur) + { + g_cur->statement=stmt_OPEN; + } + return T_OPEN; + } +"option"[ \t]+"base" { + if (g_cur) + { + g_cur->statement=stmt_OPTIONBASE; + } + return T_OPTIONBASE; + } +"option"[ \t]+"run" { + if (g_cur) + { + g_cur->statement=stmt_OPTIONRUN; + } + return T_OPTIONRUN; + } +"option"[ \t]+"stop" { + if (g_cur) + { + g_cur->statement=stmt_OPTIONSTOP; + } + return T_OPTIONSTOP; + } +"or" return T_OR; +"out" { + if (g_cur) + { + g_cur->statement=stmt_OUT_POKE; + } + return T_OUT; + } +"print"|"p."|"?" { + if (g_cur) + { + g_cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } +("print"|"p."|"?")/"#" { + if (g_cur) + { + g_cur->statement=stmt_PRINT_LPRINT; + } + return T_PRINT; + } +"poke" { + if (g_cur) + { + g_cur->statement=stmt_OUT_POKE; + } + return T_POKE; + } +"put" { + if (g_cur) + { + g_cur->statement=stmt_GET_PUT; + } + return T_PUT; + } +"put"/"#" { + if (g_cur) + { + g_cur->statement=stmt_GET_PUT; + } + return T_PUT; + } +"randomize" { + if (g_cur) + { + g_cur->statement=stmt_RANDOMIZE; + } + return T_RANDOMIZE; + } +"read" { + if (g_cur) + { + g_cur->statement=stmt_READ; + } + return T_READ; + } +"renum"|"ren." { + if (g_cur) + { + g_cur->statement=stmt_RENUM; + } + return T_RENUM; + } +"repeat"|"rep." { + if (g_cur) + { + g_cur->statement=stmt_REPEAT; + } + return T_REPEAT; + } +"restore"|"res." { + if (g_cur) + { + g_cur->statement=stmt_RESTORE; + } + return T_RESTORE; + } +"resume" { + if (g_cur) + { + g_cur->statement=stmt_RESUME_GOTO; + } + return T_RESUME; + } +"return"|"r." { + if (g_cur) + { + g_cur->statement=stmt_RETURN; + } + return T_RETURN; + } +"rset" { + if (g_cur) + { + g_cur->statement=stmt_LSET_RSET; + } + return T_RSET; + } +"run" { + if (g_cur) + { + g_cur->statement=stmt_RUN; + } + return T_RUN; + } +"save" { + if (g_cur) + { + g_cur->statement=stmt_SAVE; + } + return T_SAVE; + } +{SELECTCASE} { + if (g_cur) + { + g_cur->statement=stmt_SELECTCASE; + g_cur->u.selectcase=malloc(sizeof(struct Selectcase)); + } + return T_SELECTCASE; + } +"shared" return T_SHARED; +"shell" { + if (g_cur) + { + g_cur->statement=stmt_SHELL; + } + return T_SHELL; + } +"sleep" { + if (g_cur) + { + g_cur->statement=stmt_SLEEP; + } + return T_SLEEP; + } +"spc" return T_SPC; +"step" return T_STEP; +"stop" { + if (g_cur) + { + g_cur->statement=stmt_STOP; + } + return T_STOP; + } +"sub"[ \t]*"end" { + if (g_cur) + { + g_cur->statement=stmt_ENDPROC_SUBEND; + } + return T_SUBEND; + } +"sub"[ \t]*"exit" { + if (g_cur) + { + g_cur->statement=stmt_SUBEXIT; + } + return T_SUBEXIT; + } +"sub" { + if (g_cur) + { + g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; + g_cur->u.localSyms=(struct Symbol*)0; + } + return T_SUB; + } +"swap" { + if (g_cur) + { + g_cur->statement=stmt_SWAP; + } + return T_SWAP; + } +"system"|"bye" { + if (g_cur) + { + g_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 (g_cur) + { + g_cur->statement=stmt_TROFF; + } + return T_TROFF; + } +"tron" { + if (g_cur) + { + g_cur->statement=stmt_TRON; + } + return T_TRON; + } +"truncate" { + if (g_cur) + { + g_cur->statement=stmt_TRUNCATE; + } + return T_TRUNCATE; + } +"unlock" { + if (g_cur) + { + g_cur->statement=stmt_LOCK_UNLOCK; + } + return T_UNLOCK; + } +"unnum" { + if (g_cur) + { + g_cur->statement=stmt_UNNUM; + } + return T_UNNUM; + } +"until" { + if (g_cur) + { + g_cur->statement=stmt_UNTIL; + } + return T_UNTIL; + } +"using" return T_USING; +"wait" { + if (g_cur) + { + g_cur->statement=stmt_WAIT; + } + return T_WAIT; + } +"wend" { + if (g_cur) + { + g_cur->statement=stmt_WEND; + g_cur->u.whilepc=malloc(sizeof(struct Pc)); + } + return T_WEND; + } +"while" { + if (g_cur) + { + g_cur->statement=stmt_WHILE; + g_cur->u.afterwend=malloc(sizeof(struct Pc)); + } + return T_WHILE; + } +"width" { + if (g_cur) + { + g_cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } +"width"/"#" { + if (g_cur) + { + g_cur->statement=stmt_WIDTH; + } + return T_WIDTH; + } +"write" { + if (g_cur) + { + g_cur->statement=stmt_WRITE; + } + return T_WRITE; + } +"write"/"#" { + if (g_cur) + { + g_cur->statement=stmt_WRITE; + } + return T_WRITE; + } +"xor" return T_XOR; +"xref" { + if (g_cur) + { + g_cur->statement=stmt_XREF; + } + return T_XREF; + } +"zer" return T_ZER; +"zone" { + if (g_cur) + { + g_cur->statement=stmt_ZONE; + } + return T_ZONE; + } +{REM} { + if (g_cur) + { + g_cur->statement=stmt_QUOTE_REM; + g_cur->u.rem=strcpy(malloc(strlen(yytext+3)+1),yytext+3); + } + return T_REM; + } +"rename" { + if (g_cur) + { + g_cur->statement=stmt_COPY_RENAME; + } + return T_RENAME; + } +{QUOTE} { + if (g_cur) + { + g_cur->statement=stmt_QUOTE_REM; + strcpy(g_cur->u.rem=malloc(strlen(yytext+1)+1),yytext+1); + } + return T_QUOTE; + } +{LINEINPUT} { + if (g_cur) + { + g_cur->statement=stmt_LINEINPUT; + } + return T_LINEINPUT; + } +{IDENTIFIER} { + if (g_cur) + { + size_t len; + char *s; + int fn; + + g_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); + g_cur->u.identifier=malloc(offsetof(struct Identifier,name)+len+1); + if (fn) + { + memcpy(g_cur->u.identifier->name,yytext,2); + strcpy(g_cur->u.identifier->name+2,s); + } + else + { + strcpy(g_cur->u.identifier->name,s); + } + switch (yytext[yyleng-1]) + { + case '$': g_cur->u.identifier->defaultType=V_STRING; break; + case '%': g_cur->u.identifier->defaultType=V_INTEGER; break; + default: g_cur->u.identifier->defaultType=V_REAL; break; + } + } + return T_IDENTIFIER; + } +[ \t\n]+ +. { + if (g_cur) g_cur->u.junk=yytext[0]; + return T_JUNK; + } + +%% + +int g_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; + + g_cur=(struct Token*)0; + buf=yy_scan_string(ln); + /* determine number of tokens */ + g_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); + g_cur=result=malloc(sizeof(struct Token)*l); + if (addNumber) + { + g_cur->type=T_UNNUMBERED; + ++g_cur; + } + buf=yy_scan_string(ln); + lasttok=T_EOL; + g_matchdata=sawif=0; + while (g_cur->statement=NULL,(g_cur->type=yylex())) + { + if (g_cur->type==T_IF) sawif=1; + if (g_cur->type==T_THEN) sawif=0; + if (g_cur->type==T_GOTO && sawif) + { + sawif=0; + *(g_cur+1)=*g_cur; + g_cur->type=T_THEN; + lasttok=T_GOTO; + g_cur+=2; + } + else if ((lasttok==T_THEN || lasttok==T_ELSE) && g_cur->type==T_INTEGER) + { + *(g_cur+1)=*g_cur; + g_cur->type=T_GOTO; + g_cur->statement=stmt_RESUME_GOTO; + lasttok=T_INTEGER; + g_cur+=2; + } + else + { + lasttok=g_cur->type; + ++g_cur; + } + } + g_cur->type=T_EOL; + g_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; + + g_cur=(struct Token*)0; + buf=yy_scan_string(ln); + g_matchdata=1; + for (l=1; yylex(); ++l); + yy_delete_buffer(buf); + g_cur=result=malloc(sizeof(struct Token)*l); + buf=yy_scan_string(ln); + g_matchdata=1; + while (g_cur->statement=NULL,(g_cur->type=yylex())) ++g_cur; + g_cur->type=T_EOL; + g_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",g_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 (g_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) \ + g_token_property[t]=(assoc<<8)|(unary_priority<<5)|(binary_priority<<2)|(is_unary<<1)|is_binary + + g_backslash_colon=b_c; + g_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/bas_value.c b/apps/interpreters/bas/bas_value.c new file mode 100644 index 000000000..24b6e166f --- /dev/null +++ b/apps/interpreters/bas/bas_value.c @@ -0,0 +1,2098 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "bas_error.h" +#include "bas_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/bas_value.h b/apps/interpreters/bas/bas_value.h new file mode 100644 index 000000000..d38eab94c --- /dev/null +++ b/apps/interpreters/bas/bas_value.h @@ -0,0 +1,182 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_VALUE_H +#define __APPS_EXAMPLES_BAS_BAS_VALUE_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_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_BAS_VALUE_H */ diff --git a/apps/interpreters/bas/bas_var.c b/apps/interpreters/bas/bas_var.c new file mode 100644 index 000000000..be7562aa1 --- /dev/null +++ b/apps/interpreters/bas/bas_var.c @@ -0,0 +1,717 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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 + +#include +#include +#include + +#include "bas_error.h" +#include "bas_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/bas_var.h b/apps/interpreters/bas/bas_var.h new file mode 100644 index 000000000..b7c6c3669 --- /dev/null +++ b/apps/interpreters/bas/bas_var.h @@ -0,0 +1,115 @@ +/**************************************************************************** + * apps/interpreters/bas/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 + * Gregory Nutt + * + * 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_VAR_H +#define __APPS_EXAMPLES_BAS_BAS_VAR_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include "bas_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_BAS_VAR_H */ diff --git a/apps/interpreters/bas/bas_vt100.c b/apps/interpreters/bas/bas_vt100.c new file mode 100644 index 000000000..1cad41e1b --- /dev/null +++ b/apps/interpreters/bas/bas_vt100.c @@ -0,0 +1,368 @@ +/**************************************************************************** + * apps/interpreters/bas/bas_vt100.c + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Author: Gregory Nutt + * + * 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 + +#include +#include + +#include + +#include "bas_fs.h" +#include "bas_vt100.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; +#endif +static const char g_cursorhome[] = VT100_CURSORHOME; +#if 0 /* Not used */ +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_fmt_cursorpos[] = VT100_FMT_CURSORPOS; +static const char g_fmt_forecolor[] = VT100_FMT_FORE_COLOR; +static const char g_fmt_backcolor[] = VT100_FMT_BACK_COLOR; + +/**************************************************************************** + * 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 + * + ****************************************************************************/ + +void vt100_cursorhome(int chn) +{ + /* Send the VT100 CURSORHOME command */ + + vt100_write(chn, g_cursorhome, sizeof(g_cursorhome)); +} + +/**************************************************************************** + * 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_fmt_cursorpos, 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 + +/**************************************************************************** + * Name: vt100_foreground_color + * + * Description: + * Set the foreground color + * + ****************************************************************************/ + +void vt100_foreground_color(int chn, uint8_t color) +{ + char buffer[16]; + int len; + + /* Format the foreground color command. */ + + DEBUGASSERT(color < 10); + len = snprintf(buffer, 16, g_fmt_forecolor, color); + + /* Send the VT100 foreground color command */ + + vt100_write(chn, buffer, len); +} + +/**************************************************************************** + * Name: vt100_background_color + * + * Description: + * Set the background color + * + ****************************************************************************/ + +void vt100_background_color(int chn, uint8_t color) +{ + char buffer[16]; + int len; + + /* Format the background color command. */ + + DEBUGASSERT(color < 10); + len = snprintf(buffer, 16, g_fmt_backcolor, color); + + /* Send the VT100 background color command */ + + vt100_write(chn, buffer, len); +} diff --git a/apps/interpreters/bas/bas_vt100.h b/apps/interpreters/bas/bas_vt100.h new file mode 100644 index 000000000..fc9560395 --- /dev/null +++ b/apps/interpreters/bas/bas_vt100.h @@ -0,0 +1,235 @@ +/**************************************************************************** + * apps/interpreters/bas/bas_vt100.h + * + * Copyright (C) 2014 Gregory Nutt. All rights reserved. + * Author: Gregory Nutt + * + * 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_BAS_VT100_H +#define __APPS_INTERPRETERS_BAS_BAS_VT100_H + +/**************************************************************************** + * Included Files + ****************************************************************************/ + +#include + +#include + +/**************************************************************************** + * 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 + * + ****************************************************************************/ + +void vt100_cursorhome(int chn); + +/**************************************************************************** + * 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 + +/**************************************************************************** + * Name: vt100_foreground_color + * + * Description: + * Set the foreground color + * + ****************************************************************************/ + +void vt100_foreground_color(int chn, uint8_t color); + +/**************************************************************************** + * Name: vt100_background_color + * + * Description: + * Set the background color + * + ****************************************************************************/ + +void vt100_background_color(int chn, uint8_t color); + +#undef EXTERN +#ifdef __cplusplus +} +#endif + +#endif /* __APPS_INTERPRETERS_BAS_BAS_VT100_H */ diff --git a/apps/interpreters/bas/error.h b/apps/interpreters/bas/error.h deleted file mode 100644 index 15af8da49..000000000 --- a/apps/interpreters/bas/error.h +++ /dev/null @@ -1,188 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index 5712b6d07..000000000 --- a/apps/interpreters/bas/fs.c +++ /dev/null @@ -1,1909 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include -#include - -#include "vt100.h" -#include "fs.h" - -/**************************************************************************** - * Pre-processor Definitions - ****************************************************************************/ - -#define LINEWIDTH 80 -#define COLWIDTH 14 - -#define _(String) String - -/**************************************************************************** - * Private Data - ****************************************************************************/ - -static struct FileStream **g_file; -static int g_capacity; -static int g_used; -static const int g_open_mode[4] = { 0, O_RDONLY, O_WRONLY, O_RDWR }; -static char g_errmsgbuf[80]; - -#ifdef CONFIG_INTERPREPTER_BAS_VT100 -static const uint8_t g_vt100_colormap[8] = -{ - VT100_BLACK, VT100_BLUE, VT100_GREEN, VT100_CYAN, - VT100_RED, VT100_MAGENTA, VT100_YELLOW, VT100_WHITE -}; -#endif - -/**************************************************************************** - * Public Data - ****************************************************************************/ - -const char *FS_errmsg; - -/**************************************************************************** - * Private Functions - ****************************************************************************/ - -static int size(int dev) -{ - if (dev >= g_capacity) - { - int i; - struct FileStream **n; - - n = (struct FileStream **) - realloc(g_file, (dev + 1) * sizeof(struct FileStream *)); - if (n == (struct FileStream **)0) - { - FS_errmsg = strerror(errno); - return -1; - } - - g_file = n; - for (i = g_capacity; i <= dev; ++i) - { - g_file[i] = (struct FileStream *)0; - } - - g_capacity = dev + 1; - } - - return 0; -} - -static int opened(int dev, int mode) -{ - int fd = -1; - - if (dev < 0 || dev >= g_capacity || g_file[dev] == (struct FileStream *)0) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), _("channel #%d not open"), - dev); - FS_errmsg = g_errmsgbuf; - return -1; - } - - if (mode == -1) - { - return 0; - } - - switch (mode) - { - case 0: - { - fd = g_file[dev]->outfd; - if (fd == -1) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), - _("channel #%d not opened for writing"), dev); - } - break; - } - - case 1: - { - fd = g_file[dev]->infd; - if (fd == -1) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), - _("channel #%d not opened for reading"), dev); - } - break; - } - - case 2: - { - fd = g_file[dev]->randomfd; - if (fd == -1) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), - _("channel #%d not opened for random access"), dev); - } - break; - } - - case 3: - { - fd = g_file[dev]->binaryfd; - if (fd == -1) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), - _("channel #%d not opened for binary access"), dev); - } - break; - } - - case 4: - { - fd = (g_file[dev]->randomfd != -1 ? g_file[dev]->randomfd : g_file[dev]->binaryfd); - if (fd == -1) - { - snprintf(g_errmsgbuf, sizeof(g_errmsgbuf), - _("channel #%d not opened for random or binary access"), - dev); - } - break; - } - - default: - assert(0); - } - - if (fd == -1) - { - FS_errmsg = g_errmsgbuf; - return -1; - } - else - { - return 0; - } -} - -static int refill(int dev) -{ - struct FileStream *f; - ssize_t len; - - f = g_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 = g_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; - } - - /* Check for backspace - * - * There are several notions of backspace, for an elaborate summary see - * http://www.ibb.net/~anne/keyboard.html. There is no clean solution. - * Here both DEL and backspace are treated like backspace here. The - * Unix/Linux screen terminal by default outputs DEL (0x7f) when the - * backspace key is pressed. - */ - - if (ch == ASCII_BS || ch == ASCII_DEL) - { - 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); - vt100_cursorhome(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 - if (foreground >= 0) - { - vt100_foreground_color(chn, foreground); - } - - if (background >= 0) - { - vt100_background_color(chn, background); - } - - return 0; -#else - FS_errmsg = _("Set color operation no implemented"); - return -1; -#endif -} - -static int resetcolour(int chn) -{ -#ifdef CONFIG_INTERPREPTER_BAS_VT100 - vt100_foreground_color(chn, VT100_DEFAULT); - vt100_background_color(chn, VT100_DEFAULT); -#endif - return 0; -} - -/**************************************************************************** - * Public Functions - ****************************************************************************/ - -int FS_opendev(int chn, int infd, int outfd) -{ - if (size(chn) == -1) - { - return -1; - } - - if (g_file[chn] != (struct FileStream *)0) - { - FS_errmsg = _("channel already open"); - return -1; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->dev = 1; -#ifdef CONFIG_SERIAL_TERMIOS - g_file[chn]->tty = (infd == 0 ? isatty(infd) && isatty(outfd) : 0); -#else - g_file[chn]->tty = 1; -#endif - g_file[chn]->recLength = 1; - g_file[chn]->infd = infd; - g_file[chn]->inSize = 0; - g_file[chn]->inCapacity = 0; - g_file[chn]->outfd = outfd; - g_file[chn]->outPos = 0; - g_file[chn]->outLineWidth = LINEWIDTH; - g_file[chn]->outColWidth = COLWIDTH; - g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); - g_file[chn]->outSize = 0; - g_file[chn]->outforeground = -1; - g_file[chn]->outbackground = -1; - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 < g_capacity; ++chn) - { - if (g_file[chn] == (struct FileStream *)0) - { - break; - } - } - - if (size(chn) == -1) - { - return -1; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = 1; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = fd; - g_file[chn]->inSize = 0; - g_file[chn]->inCapacity = 0; - g_file[chn]->outfd = -1; - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 (g_file[chn] != (struct FileStream *)0) - { - FS_errmsg = _("channel already open"); - return -1; - } - - fl = g_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; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = 1; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = fd; - g_file[chn]->inSize = 0; - g_file[chn]->inCapacity = 0; - g_file[chn]->outfd = -1; - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 < g_capacity; ++chn) - { - if (g_file[chn] == (struct FileStream *)0) - { - break; - } - } - - if (size(chn) == -1) - { - return -1; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = 1; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = -1; - g_file[chn]->outfd = fd; - g_file[chn]->outPos = 0; - g_file[chn]->outLineWidth = LINEWIDTH; - g_file[chn]->outColWidth = COLWIDTH; - g_file[chn]->outSize = 0; - g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 (g_file[chn] != (struct FileStream *)0) - { - FS_errmsg = _("channel already open"); - return -1; - } - - fl = g_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; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = 1; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = -1; - g_file[chn]->outfd = fd; - g_file[chn]->outPos = 0; - g_file[chn]->outLineWidth = LINEWIDTH; - g_file[chn]->outColWidth = COLWIDTH; - g_file[chn]->outSize = 0; - g_file[chn]->outCapacity = sizeof(g_file[chn]->outBuf); - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 (g_file[chn] != (struct FileStream *)0) - { - FS_errmsg = _("channel already open"); - return -1; - } - - if ((fd = open(name, g_open_mode[mode] | O_CREAT, 0666)) == -1) - { - FS_errmsg = strerror(errno); - return -1; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = recLength; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = -1; - g_file[chn]->outfd = -1; - g_file[chn]->randomfd = fd; - g_file[chn]->recBuf = malloc(recLength); - memset(g_file[chn]->recBuf, 0, recLength); - StringField_new(&g_file[chn]->field); - g_file[chn]->binaryfd = -1; - FS_errmsg = (const char *)0; - ++g_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 (g_file[chn] != (struct FileStream *)0) - { - FS_errmsg = _("channel already open"); - return -1; - } - - if ((fd = open(name, g_open_mode[mode] | O_CREAT, 0666)) == -1) - { - FS_errmsg = strerror(errno); - return -1; - } - - g_file[chn] = malloc(sizeof(struct FileStream)); - g_file[chn]->recLength = 1; - g_file[chn]->dev = 0; - g_file[chn]->tty = 0; - g_file[chn]->infd = -1; - g_file[chn]->outfd = -1; - g_file[chn]->randomfd = -1; - g_file[chn]->binaryfd = fd; - FS_errmsg = (const char *)0; - ++g_used; - return chn; -} - -int FS_freechn(void) -{ - int i; - - for (i = 0; i < g_capacity && g_file[i]; ++i); - if (size(i) == -1) - { - return -1; - } - - return i; -} - -int FS_flush(int dev) -{ - ssize_t written; - size_t offset; - - if (g_file[dev] == (struct FileStream *)0) - { - FS_errmsg = _("channel not open"); - return -1; - } - - offset = 0; - while (offset < g_file[dev]->outSize) - { - written = - write(g_file[dev]->outfd, g_file[dev]->outBuf + offset, - g_file[dev]->outSize - offset); - if (written == -1) - { - FS_errmsg = strerror(errno); - return -1; - } - else - { - offset += written; - } - } - - g_file[dev]->outSize = 0; - FS_errmsg = (const char *)0; - return 0; -} - -int FS_close(int dev) -{ - if (g_file[dev] == (struct FileStream *)0) - { - FS_errmsg = _("channel not open"); - return -1; - } - - if (g_file[dev]->outfd >= 0) - { - if (g_file[dev]->tty && - (g_file[dev]->outforeground != -1 || g_file[dev]->outbackground != -1)) - { - resetcolour(dev); - } - - FS_flush(dev); - close(g_file[dev]->outfd); - } - - if (g_file[dev]->randomfd >= 0) - { - StringField_destroy(&g_file[dev]->field); - free(g_file[dev]->recBuf); - close(g_file[dev]->randomfd); - } - - if (g_file[dev]->binaryfd >= 0) - { - close(g_file[dev]->binaryfd); - } - - if (g_file[dev]->infd >= 0) - { - close(g_file[dev]->infd); - } - - free(g_file[dev]); - g_file[dev] = (struct FileStream *)0; - FS_errmsg = (const char *)0; - if (--g_used == 0) - { - free(g_file); - g_file = (struct FileStream **)0; - g_capacity = 0; - } - - return 0; -} - -#ifdef CONFIG_SERIAL_TERMIOS -int FS_istty(int chn) -{ - return (g_file[chn] && g_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 (g_file[chn] == (struct FileStream *)0) - { - FS_errmsg = _("channel not open"); - return -1; - } - - if ((fd = g_file[chn]->infd) == -1) - { - if ((fd = g_file[chn]->outfd) == -1) - { - if ((fd = g_file[chn]->randomfd) == -1) - { - if ((fd = g_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 (g_file[chn] == (struct FileStream *)0) - { - FS_errmsg = _("channel not open"); - return -1; - } - - if ((fd = g_file[chn]->infd) == -1) - { - if ((fd = g_file[chn]->outfd) == -1) - { - if ((fd = g_file[chn]->randomfd) == -1) - { - if ((fd = g_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 < g_file[chn]->recLength) - { - written = - write(g_file[chn]->randomfd, g_file[chn]->recBuf + offset, - g_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 = g_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 = g_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(g_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(g_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(g_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(g_file[chn]->binaryfd, s->character, s->length)) != s->length) - { - if (len == -1) - { - FS_errmsg = strerror(errno); - } - else - { - FS_errmsg = _("End of g_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(g_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(g_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 = g_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 = g_file[dev]; - if (f->outPos && FS_putChar(dev, '\n') == -1) - { - return -1; - } - - return 0; -} - -int FS_tab(int dev, int position) -{ - struct FileStream *f = g_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; - } - - g_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; - } - - g_file[dev]->outColWidth = zone; - return 0; -} - -int FS_cls(int chn) -{ - struct FileStream *f; - - if (opened(chn, 0) == -1) - { - return -1; - } - - f = g_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 = g_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 = g_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 = g_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 < g_file[chn]->recLength) - { - rd = - read(g_file[chn]->randomfd, g_file[chn]->recBuf + offset, - g_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 = g_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 = g_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 (g_file[chn]->infd != -1) - { - fd = g_file[chn]->infd; - offset = -g_file[chn]->inCapacity + g_file[chn]->inSize; - } - else if (g_file[chn]->outfd != -1) - { - fd = g_file[chn]->outfd; - offset = g_file[chn]->outSize; - } - else if (g_file[chn]->randomfd != -1) - { - fd = g_file[chn]->randomfd; - } - else - { - fd = g_file[chn]->binaryfd; - } - - assert(fd != -1); - if ((cur = lseek(fd, 0, SEEK_CUR)) == -1) - { - FS_errmsg = strerror(errno); - return -1; - } - - return (cur + offset) / g_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 (g_file[chn]->infd != -1) - { - fd = g_file[chn]->infd; - } - else if (g_file[chn]->outfd != -1) - { - fd = g_file[chn]->outfd; - } - else if (g_file[chn]->randomfd != -1) - { - fd = g_file[chn]->randomfd; - } - else - { - fd = g_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 / g_file[chn]->recLength); -} - -long int FS_recLength(int chn) -{ - if (opened(chn, 2) == -1) - { - return -1; - } - - return g_file[chn]->recLength; -} - -void FS_field(int chn, struct String *s, long int position, long int length) -{ - assert(g_file[chn]); - String_joinField(s, &g_file[chn]->field, g_file[chn]->recBuf + position, length); -} - -int FS_seek(int chn, long int record) -{ - if (opened(chn, 2) != -1) - { - if (lseek - (g_file[chn]->randomfd, (off_t) record * g_file[chn]->recLength, - SEEK_SET) != -1) - { - return 0; - } - - FS_errmsg = strerror(errno); - } - else if (opened(chn, 4) != -1) - { - if (lseek(g_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 = g_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; - - /* Example each entry in the g_files[] arrary */ - - for (i = 0; i < g_capacity; ++i) - { - /* Has this entry been allocated? Is it a file? Or a device? */ - - if (g_file[i] && !g_file[i]->dev) - { - /* It is an open file, close it */ - - FS_close(i); - } - } -} - -int FS_charpos(int chn) -{ - if (g_file[chn] == (struct FileStream *)0) - { - FS_errmsg = _("channel not open"); - return -1; - } - - return (g_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 deleted file mode 100644 index 21a30452d..000000000 --- a/apps/interpreters/bas/fs.h +++ /dev/null @@ -1,198 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 -#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 deleted file mode 100644 index 9d7e1d504..000000000 --- a/apps/interpreters/bas/global.c +++ /dev/null @@ -1,2469 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "auto.h" -#include "bas.h" -#include "error.h" -#include "fs.h" -#include "global.h" -#include "var.h" - -#include - -/**************************************************************************** - * 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 < g_bas_argc; ++i) - { - if (i) - { - String_appendChar(&v->u.string, ' '); - } - - String_appendChars(&v->u.string, g_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 (g_bas_argv0 != (char *)0) - { - String_appendChars(&v->u.string, g_bas_argv0); - } - } - else if (a <= g_bas_argc) - { - String_appendChars(&v->u.string, g_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 (g_bas_argv0 != (char *)0) - { - String_appendChars(&v->u.string, g_bas_argv0); - } - } - else if (a <= g_bas_argc) - { - String_appendChars(&v->u.string, g_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 deleted file mode 100644 index bd91d4a02..000000000 --- a/apps/interpreters/bas/global.h +++ /dev/null @@ -1,111 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index bf8dd4e65..000000000 --- a/apps/interpreters/bas/main.c +++ /dev/null @@ -1,204 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include -#include -#include - -#include "fs.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); - } - - g_bas_argc = argc - optind; - g_bas_argv = &argv[optind]; - g_bas_argv0 = runFile; - g_bas_end = false; - - bas_init(backslash_colon, restricted, uppercase, lpfd); - if (runFile) - { - bas_runFile(runFile); - } - else - { - bas_interpreter(); - } - - /* Terminate the output stream with a newline BEFORE closing devices */ - - FS_putChar(STDCHANNEL, '\n'); - - /* Release resouces and close files and devices */ - - bas_exit(); - return 0; -} diff --git a/apps/interpreters/bas/program.c b/apps/interpreters/bas/program.c deleted file mode 100644 index 893825d8d..000000000 --- a/apps/interpreters/bas/program.c +++ /dev/null @@ -1,1126 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include -#include - -#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 deleted file mode 100644 index b50ff0951..000000000 --- a/apps/interpreters/bas/program.h +++ /dev/null @@ -1,114 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index b5c1e9c1a..000000000 --- a/apps/interpreters/bas/programtypes.h +++ /dev/null @@ -1,99 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index cd9ea6f86..000000000 --- a/apps/interpreters/bas/statement.c +++ /dev/null @@ -1,6354 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include - -#include "statement.h" - -/**************************************************************************** - * Pre-processor Definitions - ****************************************************************************/ - -#define _(String) String - -/**************************************************************************** - * Private Functions - ****************************************************************************/ - -/**************************************************************************** - * Public Functions - ****************************************************************************/ - -struct Value *stmt_CALL(struct Value *value) -{ - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGPROCIDENT); - } - - if (g_pass == DECLARE) - { - if (func(value)->type == V_ERROR) - { - return value; - } - else - { - Value_destroy(value); - } - } - else - { - if (g_pass == COMPILE) - { - if (Global_find - (&g_globals, g_pc.token->u.identifier, - (g_pc.token + 1)->type == T_OP) == 0) - { - return Value_new_ERROR(value, UNDECLARED); - } - } - - if (g_pc.token->u.identifier->sym->type != USERFUNCTION && - g_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 = g_pc; - - if (g_pass == DECLARE || g_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 = g_pc; - if (g_pass == COMPILE) - { - g_pc.token->u.casevalue->endselect = - selectcase->token->u.selectcase->endselect; - } - - g_pc.token->u.casevalue->nextcasevalue.line = -1; - ++g_pc.token; - switch (statementpc.token->type) - { - case T_CASEELSE: - break; - - case T_CASEVALUE: - { - struct Pc exprpc; - - do - { - if (g_pc.token->type == T_IS) - { - ++g_pc.token; - switch (g_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); - } - - ++g_pc.token; - exprpc = g_pc; - if (eval(value, "`is'")->type == V_ERROR) - { - return value; - } - - if (Value_retype - (value, - selectcase->token->u.selectcase->type)->type == - V_ERROR) - { - g_pc = exprpc; - return value; - } - - Value_destroy(value); - } - - else /* value or range */ - { - exprpc = g_pc; - if (eval(value, "`case'")->type == V_ERROR) - { - return value; - } - - if (Value_retype - (value, - selectcase->token->u.selectcase->type)->type == - V_ERROR) - { - g_pc = exprpc; - return value; - } - - Value_destroy(value); - if (g_pc.token->type == T_TO) - { - ++g_pc.token; - exprpc = g_pc; - if (eval(value, "`case'")->type == V_ERROR) - { - return value; - } - - if (Value_retype - (value, - selectcase->token->u.selectcase->type)->type == - V_ERROR) - { - g_pc = exprpc; - return value; - } - - Value_destroy(value); - } - - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - while (1); - - break; - } - - default: - assert(0); - } - } - else - { - g_pc = g_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 = g_pc; - - ++g_pc.token; - dirpc = g_pc; - if (eval(value, _("directory"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (g_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 (g_pass == INTERPRET && res == -1) - { - g_pc = dirpc; - return Value_new_ERROR(value, IOERROR, strerror(err)); - } - - return (struct Value *)0; -} - -struct Value *stmt_CLEAR(struct Value *value) -{ - if (g_pass == INTERPRET) - { - Global_clear(&g_globals); - FS_closefiles(); - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_CLOSE(struct Value *value) -{ - int hasargs = 0; - struct Pc chnpc; - - ++g_pc.token; - while (1) - { - chnpc = g_pc; - if (g_pc.token->type == T_CHANNEL) - { - hasargs = 1; - ++g_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 (g_pass == INTERPRET && FS_close(value->u.integer) == -1) - { - Value_destroy(value); - g_pc = chnpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (!hasargs && g_pass == INTERPRET) - { - FS_closefiles(); - } - - return (struct Value *)0; -} - -struct Value *stmt_CLS(struct Value *value) -{ - struct Pc statementpc = g_pc; - - ++g_pc.token; - if (g_pass == INTERPRET && FS_cls(STDCHANNEL) == -1) - { - g_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 = g_pc; - - ++g_pc.token; - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - foreground = value->u.integer; - if (foreground < 0 || foreground > 15) - { - Value_destroy(value); - g_pc = statementpc; - return Value_new_ERROR(value, OUTOFRANGE, _("foreground colour")); - } - } - - Value_destroy(value); - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - background = value->u.integer; - if (background < 0 || background > 15) - { - Value_destroy(value); - g_pc = statementpc; - return Value_new_ERROR(value, OUTOFRANGE, _("background colour")); - } - } - - Value_destroy(value); - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (eval(value, (const char *)0)) - { - int bordercolour = -1; - - if (value->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - bordercolour = value->u.integer; - if (bordercolour < 0 || bordercolour > 15) - { - Value_destroy(value); - g_pc = statementpc; - return Value_new_ERROR(value, OUTOFRANGE, _("border colour")); - } - } - - Value_destroy(value); - } - } - - if (g_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 (g_pass == DECLARE) - { - *g_lastdata = g_pc; - (g_lastdata = &(g_pc.token->u.nextdata))->line = -1; - } - - ++g_pc.token; - while (1) - { - if (g_pc.token->type != T_STRING && g_pc.token->type != T_DATAINPUT) - { - return Value_new_ERROR(value, MISSINGDATAINPUT); - } - - ++g_pc.token; - if (g_pc.token->type != T_COMMA) - { - break; - } - else - { - ++g_pc.token; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value) -{ - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Pc statementpc = g_pc; - struct Identifier *fn; - int proc; - int args = 0; - - if (DIRECTMODE) - { - return Value_new_ERROR(value, NOTINDIRECTMODE); - } - - proc = (g_pc.token->type == T_DEFPROC || g_pc.token->type == T_SUB); - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - if (proc) - { - return Value_new_ERROR(value, MISSINGPROCIDENT); - } - else - { - return Value_new_ERROR(value, MISSINGFUNCIDENT); - } - } - - fn = g_pc.token->u.identifier; - if (proc) - { - fn->defaultType = V_VOID; - } - - ++g_pc.token; - if (findLabel(L_FUNC)) - { - g_pc = statementpc; - return Value_new_ERROR(value, NESTEDDEFINITION); - } - - Auto_variable(&g_stack, fn); - if (g_pc.token->type == T_OP) /* arguments */ - { - ++g_pc.token; - while (1) - { - if (g_pc.token->type != T_IDENTIFIER) - { - Auto_funcEnd(&g_stack); - return Value_new_ERROR(value, MISSINGFORMIDENT); - } - - if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0) - { - Auto_funcEnd(&g_stack); - return Value_new_ERROR(value, ALREADYDECLARED); - } - - ++args; - ++g_pc.token; - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (g_pc.token->type != T_CP) - { - Auto_funcEnd(&g_stack); - return Value_new_ERROR(value, MISSINGCP); - } - - ++g_pc.token; - } - - if (g_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(&g_stack, i); - } - - if (Global_function - (&g_globals, fn, fn->defaultType, &g_pc, &statementpc, args, t) == 0) - { - free(t); - Auto_funcEnd(&g_stack); - g_pc = statementpc; - return Value_new_ERROR(value, REDECLARATION); - } - - Program_addScope(&g_program, &fn->sym->u.sub.u.def.scope); - } - - pushLabel(L_FUNC, &statementpc); - if (g_pc.token->type == T_EQ) - { - return stmt_EQ_FNRETURN_FNEND(value); - } - } - else - { - g_pc = (g_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 = (g_pc.token->type == T_DEC ? -1 : 1); - ++g_pc.token; - while (1) - { - struct Value *l, stepValue; - struct Pc lvaluepc; - - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGDECINCIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 - { - g_pc = lvaluepc; - return Value_new_ERROR(value, TYPEMISMATCH5); - } - - if (g_pass == INTERPRET) - { - Value_add(l, &stepValue, 1); - } - - Value_destroy(&stepValue); - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value) -{ - enum ValueType dsttype = V_NIL; - - switch (g_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); - } - - ++g_pc.token; - while (1) - { - struct Identifier *ident; - - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (g_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 = g_pc.token->u.identifier; - ++g_pc.token; - if (g_pc.token->type == T_MINUS) - { - struct Identifier i; - - if (strlen(ident->name) != 1) - { - return Value_new_ERROR(value, BADRANGE); - } - - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (strlen(g_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(g_pc.token->u.identifier->name[0]); - ++i.name[0]) - { - Global_variable(&g_globals, &i, dsttype, GLOBALVAR, 1); - } - - ++g_pc.token; - } - else - { - Global_variable(&g_globals, ident, dsttype, GLOBALVAR, 1); - } - - if (g_pc.token->type == T_COMMA) - { - ++g_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 (g_pass == INTERPRET && !DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == INTERPRET && - Program_goLine(&g_program, g_pc.token->u.integer, - &from) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - f = 1; - ++g_pc.token; - } - - if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == INTERPRET && - Program_goLine(&g_program, g_pc.token->u.integer, - &to) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - t = 1; - ++g_pc.token; - } - } - else if (f == 1) - { - to = from; - t = 1; - } - - if (!f && !t) - { - return Value_new_ERROR(value, MISSINGLINENUMBER); - } - - if (g_pass == INTERPRET) - { - Program_delete(&g_program, f ? &from : (struct Pc *)0, - t ? &to : (struct Pc *)0); - } - - return (struct Value *)0; -} - -struct Value *stmt_DIM(struct Value *value) -{ - ++g_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 (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGARRIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - if (g_pass == INTERPRET && var->dim) - { - return Value_new_ERROR(value, REDIM); - } - - vartype = var->type; - ++g_pc.token; - if (g_pc.token->type != T_OP) - { - return Value_new_ERROR(value, MISSINGOP); - } - - ++g_pc.token; - dim = 0; - while (1) - { - dimpc = g_pc; - if (eval(value, _("dimension"))->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - if (capacity) - { - free(geometry); - } - - return value; - } - - if (g_pass == INTERPRET && value->u.integer < g_optionbase) /* error */ - { - Value_destroy(value); - Value_new_ERROR(value, OUTOFRANGE, _("dimension")); - } - - if (value->type == V_ERROR) /* abort */ - { - if (capacity) - { - free(geometry); - } - - g_pc = dimpc; - return value; - } - - if (g_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 - g_optionbase + 1; - ++dim; - } - - Value_destroy(value); - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (g_pc.token->type != T_CP) /* abort */ - { - if (capacity) - { - free(geometry); - } - - return Value_new_ERROR(value, MISSINGCP); - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - struct Var newarray; - - assert(capacity); - if (Var_new(&newarray, vartype, dim, geometry, g_optionbase) == - (struct Var *)0) - { - free(geometry); - return Value_new_ERROR(value, OUTOFMEMORY); - } - - Var_destroy(var); - *var = newarray; - free(geometry); - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; /* advance to next var */ - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_DISPLAY(struct Value *value) -{ - struct Pc statementpc = g_pc; - - ++g_pc.token; - if (eval(value, _("file name"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) - { - return value; - } - - if (g_pass == INTERPRET && cat(value->u.string.character) == -1) - { - const char *msg = strerror(errno); - - Value_destroy(value); - g_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 (g_pass == DECLARE || g_pass == COMPILE) - { - pushLabel(L_DO, &g_pc); - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_DOcondition(struct Value *value) -{ - struct Pc dowhilepc = g_pc; - int negate = (g_pc.token->type == T_DOUNTIL); - - if (g_pass == DECLARE || g_pass == COMPILE) - { - pushLabel(L_DOcondition, &g_pc); - } - - ++g_pc.token; - if (eval(value, "condition")->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - int condition; - - condition = Value_isNull(value); - if (negate) - { - condition = !condition; - } - - if (condition) - { - g_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 = g_pc; - int status; - - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - struct Pc where; - - if (g_program.numbered) - { - if (Program_goLine(&g_program, g_pc.token->u.integer, &where) == - (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - line = where.line + 1; - } - else - { - if (!Program_end(&g_program, &where)) - { - return Value_new_ERROR(value, NOPROGRAM); - } - - line = g_pc.token->u.integer; - if (line < 1 || line > (where.line + 1)) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - } - ++g_pc.token; - } - else - { - line = 1; - } - - if (g_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) - { - g_pc = statementpc; - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - if ((name = tmpnam(NULL)) == (char *)0) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, - _("generating temporary file name failed")); - } - - if ((chn = FS_openout(name)) == -1) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERRORCREATE, name, FS_errmsg); - } - - FS_width(chn, 0); - if (Program_list(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value)) - { - g_pc = statementpc; - return value; - } - - if (FS_close(chn) == -1) - { - g_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) - { - g_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); - g_pc = statementpc; - return value; - } - - FS_close(chn); - Program_setname(&newProgram, g_program.name.character); - Program_destroy(&g_program); - g_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 (g_pass == INTERPRET) - { - g_pc = g_pc.token->u.endifpc; - } - - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Pc elsepc = g_pc; - struct Pc *ifinstr; - int elseifelse = (g_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 = g_pc; - } - - ++g_pc.token; - ifinstr->token->u.elsepc = g_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 (g_pass == INTERPRET) - { - g_pc = g_pc.token->u.endpc; - g_bas_end = true; - } - - if (g_pass == DECLARE || g_pass == COMPILE) - { - if (Program_end(&g_program, &g_pc.token->u.endpc)) - { - ++g_pc.token; - } - else - { - struct Token *eol; - - for (eol = g_pc.token; eol->type != T_EOL; ++eol); - - g_pc.token->u.endpc = g_pc; - g_pc.token->u.endpc.token = eol; - ++g_pc.token; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_ENDIF(struct Value *value) -{ - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Pc endifpc = g_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 = g_pc; - } - } - else if ((elsepc = popLabel(L_ELSE))) - { - elsepc->token->u.endifpc = endifpc; - } - else - { - return Value_new_ERROR(value, STRAYENDIF); - } - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_ENDFN(struct Value *value) -{ - struct Pc *curfn = (struct Pc *)0; - struct Pc eqpc = g_pc; - - if (g_pass == DECLARE || g_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); - } - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - return Value_clone(value, - Var_value(Auto_local(&g_stack, 0), 0, (int *)0, - (struct Value *)0)); - } - else - { - if (g_pass == DECLARE) - { - Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc); - } - Auto_funcEnd(&g_stack); - } - - return (struct Value *)0; -} - -struct Value *stmt_ENDPROC_SUBEND(struct Value *value) -{ - struct Pc *curfn = (struct Pc *)0; - - if (g_pass == DECLARE || g_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()); - } - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - return Value_new_VOID(value); - } - else - { - if (g_pass == DECLARE) - { - Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc); - } - - Auto_funcEnd(&g_stack); - } - - return (struct Value *)0; -} - -struct Value *stmt_ENDSELECT(struct Value *value) -{ - struct Pc statementpc = g_pc; - - ++g_pc.token; - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Pc *selectcasepc; - - if ((selectcasepc = popLabel(L_SELECTCASE))) - { - selectcasepc->token->u.selectcase->endselect = g_pc; - } - else - { - g_pc = statementpc; - return Value_new_ERROR(value, STRAYENDSELECT); - } - } - - return (struct Value *)0; -} - -struct Value *stmt_ENVIRON(struct Value *value) -{ - struct Pc epc = g_pc; - - ++g_pc.token; - if (eval(value, _("environment variable"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET && value->u.string.character) - { - if (putenv(value->u.string.character) == -1) - { - Value_destroy(value); - g_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 (g_pass == DECLARE || g_pass == COMPILE) - { - if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 || - (curfn->token + 1)->u.identifier->defaultType == V_VOID) - { - return Value_new_ERROR(value, STRAYFNEXIT); - } - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - return Value_clone(value, - Var_value(Auto_local(&g_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) -{ - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value) -{ - struct Pc *curfn = (struct Pc *)0; - struct Pc eqpc = g_pc; - enum TokenType t = g_pc.token->type; - - if (g_pass == DECLARE || g_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); - } - } - } - - ++g_pc.token; - if (eval(value, _("return"))->type == V_ERROR || - Value_retype(value, eqpc.token->u.type)->type == V_ERROR) - { - if (g_pass != INTERPRET) - { - Auto_funcEnd(&g_stack); - } - - g_pc = eqpc; - return value; - } - - if (g_pass == INTERPRET) - { - return value; - } - else - { - Value_destroy(value); - if (t == T_EQ || t == T_FNEND) - { - if (g_pass == DECLARE) - { - Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, - &g_pc); - } - - Auto_funcEnd(&g_stack); - } - } - - return (struct Value *)0; -} - -struct Value *stmt_ERASE(struct Value *value) -{ - ++g_pc.token; - while (1) - { - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGARRIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - if (g_pass == INTERPRET) - { - Var_destroy(&g_pc.token->u.identifier->sym->u.var); - } - - ++g_pc.token; - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_EXITDO(struct Value *value) -{ - if (g_pass == INTERPRET) - { - g_pc = g_pc.token->u.exitdo; - } - else - { - if (g_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); - } - - g_pc.token->u.exitdo = exitdo->token->u.exitdo; - } - - ++g_pc.token; - } - - return (struct Value *)0; -} - -struct Value *stmt_EXITFOR(struct Value *value) -{ - if (g_pass == INTERPRET) - { - g_pc = g_pc.token->u.exitfor; - } - else - { - if (g_pass == COMPILE) - { - struct Pc *exitfor; - - if ((exitfor = findLabel(L_FOR)) == (struct Pc *)0) - { - return Value_new_ERROR(value, STRAYEXITFOR); - } - - g_pc.token->u.exitfor = exitfor->token->u.exitfor; - } - - ++g_pc.token; - } - - return (struct Value *)0; -} - -struct Value *stmt_FIELD(struct Value *value) -{ - long int chn, offset, recLength = -1; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pass == INTERPRET && (recLength = FS_recLength(chn)) == -1) - { - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - if (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_pc.token; - offset = 0; - while (1) - { - struct Pc curpc; - struct Value *l; - long int width; - - curpc = g_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 (g_pass == INTERPRET && offset + width > recLength) - { - g_pc = curpc; - return Value_new_ERROR(value, OUTOFRANGE, _("field width")); - } - - if (g_pc.token->type != T_AS) - { - return Value_new_ERROR(value, MISSINGAS); - } - - ++g_pc.token; - curpc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 (g_pass != DECLARE && l->type != V_STRING) - { - g_pc = curpc; - return Value_new_ERROR(value, TYPEMISMATCH4); - } - - if (g_pass == INTERPRET) - { - FS_field(chn, &l->u.string, offset, width); - } - - offset += width; - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_FOR(struct Value *value) -{ - struct Pc forpc = g_pc; - struct Pc varpc; - struct Pc limitpc; - struct Value limit, stepValue; - - ++g_pc.token; - varpc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGLOOPIDENT); - } - - if (assign(value)->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - ++g_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 (g_pc.token->type == T_STEP) /* STEP x */ - { - struct Pc stepPc; - - ++g_pc.token; - stepPc = g_pc; - if (eval(&stepValue, "`step'")->type == V_ERROR) - { - Value_destroy(value); - *value = stepValue; - g_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)) - { - g_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 (g_pc.token->type != T_TO) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGTO); - } - - ++g_pc.token; - pushLabel(L_FOR_LIMIT, &g_pc); - limitpc = g_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 (g_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(&g_stack, - sym))->type - == V_ERROR) - { - Value_destroy(value); - *value = limit; - g_pc = limitpc; - return value; - } - } - - Value_destroy(&limit); - if (g_pc.token->type == T_STEP) /* STEP x */ - { - struct Pc stepPc; - - ++g_pc.token; - stepPc = g_pc; - if (eval(&stepValue, "`step'")->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(&stepValue, value->type)->type == V_ERROR)) - { - Value_destroy(value); - *value = stepValue; - g_pc = stepPc; - return value; - } - } - else /* implicit numeric STEP */ - { - VALUE_NEW_INTEGER(&stepValue, 1); - if (g_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, &g_pc); - Value_destroy(&stepValue); - Value_destroy(value); - } - - return (struct Value *)0; -} - -struct Value *stmt_GET_PUT(struct Value *value) -{ - struct Pc statementpc = g_pc; - int put = g_pc.token->type == T_PUT; - long int chn; - struct Pc errpc; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - errpc = g_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 (g_pass == INTERPRET) - { - if (rec < 1) - { - g_pc = errpc; - return Value_new_ERROR(value, OUTOFRANGE, _("record number")); - } - - if (FS_seek((int)chn, rec - 1) == -1) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - } - } - - } - - if (g_pc.token->type == T_COMMA) /* BINARY mode get/put */ - { - int res = -1; - - ++g_pc.token; - if (put) - { - if (eval(value, _("`put'/`get' data"))->type == V_ERROR) - { - return value; - } - - if (g_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 (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGPROCIDENT); - } - - if (g_pass == DECLARE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 (g_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 (g_pass == INTERPRET && res == -1) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - } - else if (g_pass == INTERPRET && ((put ? FS_put : FS_get) (chn)) == -1) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - return (struct Value *)0; -} - -struct Value *stmt_GOSUB(struct Value *value) -{ - if (g_pass == INTERPRET) - { - if (!g_program.runnable && - compileProgram(value, !DIRECTMODE)->type == V_ERROR) - { - return value; - } - - g_pc.token += 2; - Auto_pushGosubRet(&g_stack, &g_pc); - g_pc = (g_pc.token - 2)->u.gosubpc; - Program_trace(&g_program, &g_pc, 0, 1); - } - - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Token *gosubpc = g_pc.token; - - ++g_pc.token; - if (g_pc.token->type != T_INTEGER) - { - return Value_new_ERROR(value, MISSINGLINENUMBER); - } - - if (Program_goLine(&g_program, g_pc.token->u.integer, &gosubpc->u.gosubpc) == - (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - if (g_pass == COMPILE && - Program_scopeCheck(&g_program, &gosubpc->u.gosubpc, findLabel(L_FUNC))) - { - return Value_new_ERROR(value, OUTOFSCOPE); - } - - ++g_pc.token; - } - - return (struct Value *)0; -} - -struct Value *stmt_RESUME_GOTO(struct Value *value) -{ - if (g_pass == INTERPRET) - { - if (!g_program.runnable && - compileProgram(value, !DIRECTMODE)->type == V_ERROR) - { - return value; - } - - if (g_pc.token->type == T_RESUME) - { - if (!g_stack.resumeable) - { - return Value_new_ERROR(value, STRAYRESUME); - } - - g_stack.resumeable = 0; - } - - g_pc = g_pc.token->u.gotopc; - Program_trace(&g_program, &g_pc, 0, 1); - } - else if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Token *gotopc = g_pc.token; - - ++g_pc.token; - if (g_pc.token->type != T_INTEGER) - { - return Value_new_ERROR(value, MISSINGLINENUMBER); - } - - if (Program_goLine(&g_program, g_pc.token->u.integer, &gotopc->u.gotopc) == - (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - if (g_pass == COMPILE && - Program_scopeCheck(&g_program, &gotopc->u.gotopc, findLabel(L_FUNC))) - { - return Value_new_ERROR(value, OUTOFSCOPE); - } - - ++g_pc.token; - } - - return (struct Value *)0; -} - -struct Value *stmt_KILL(struct Value *value) -{ - struct Pc statementpc = g_pc; - - ++g_pc.token; - if (eval(value, _("file name"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) - { - return value; - } - - if (g_pass == INTERPRET && unlink(value->u.string.character) == -1) - { - const char *msg = strerror(errno); - - Value_destroy(value); - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, msg); - } - else - { - Value_destroy(value); - } - - return (struct Value *)0; -} - -struct Value *stmt_LET(struct Value *value) -{ - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (assign(value)->type == V_ERROR) - { - return value; - } - - if (g_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; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - else - { - ++g_pc.token; - } - } - - /* prompt */ - - if (g_pc.token->type == T_STRING) - { - if (g_pass == INTERPRET && channel == 0) - { - FS_putString(channel, g_pc.token->u.string); - } - - ++g_pc.token; - if (g_pc.token->type != T_SEMICOLON && g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGSEMICOMMA); - } - - ++g_pc.token; - } - - if (g_pass == INTERPRET && channel == 0) - { - FS_flush(channel); - } - - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - lpc = g_pc; - if (((l = lvalue(value))->type) == V_ERROR) - { - return value; - } - - if (g_pass == COMPILE && l->type != V_STRING) - { - g_pc = lpc; - return Value_new_ERROR(value, TYPEMISMATCH4); - } - - if (g_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 = (g_pc.token->type == T_LLIST ? LPCHANNEL : STDCHANNEL); - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == INTERPRET && - Program_fromLine(&g_program, g_pc.token->u.integer, - &from) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - f = 1; - ++g_pc.token; - } - else if (g_pc.token->type != T_MINUS && g_pc.token->type != T_COMMA) - { - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - if (g_pass == INTERPRET && - Program_fromLine(&g_program, value->u.integer, - &from) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - f = 1; - Value_destroy(value); - } - } - - if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - (g_pass != DECLARE && - Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - if (g_pass == INTERPRET && - Program_toLine(&g_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 (g_pass == INTERPRET) - { - /* Some implementations do not require direct mode */ - - if (Program_list - (&g_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 (g_pass == INTERPRET && !DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - ++g_pc.token; - loadpc = g_pc; - if (eval(value, _("file name"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - g_pc = loadpc; - return value; - } - - if (g_pass == INTERPRET) - { - int dev; - - new(); - Program_setname(&g_program, value->u.string.character); - if ((dev = FS_openin(value->u.string.character)) == -1) - { - g_pc = loadpc; - Value_destroy(value); - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - FS_width(dev, 0); - Value_destroy(value); - if (Program_merge(&g_program, dev, value)) - { - g_pc = loadpc; - return value; - } - - FS_close(dev); - g_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 (g_pass == DECLARE || g_pass == COMPILE) - { - if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0) - return Value_new_ERROR(value, STRAYLOCAL); - } - - ++g_pc.token; - while (1) - { - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Symbol *fnsym; - - if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0) - return Value_new_ERROR(value, ALREADYLOCAL); - if (g_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] = - g_pc.token->u.identifier->defaultType; - ++fnsym->u.sub.u.def.localLength; - } - } - - ++g_pc.token; - if (g_pc.token->type == T_COMMA) - { - ++g_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 = g_pc; - - ++g_pc.token; - argpc = g_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 (g_pass == INTERPRET && line < 1) - { - g_pc = argpc; - return Value_new_ERROR(value, OUTOFRANGE, _("row")); - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - argpc = g_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 (g_pass == INTERPRET && column < 1) - { - g_pc = argpc; - return Value_new_ERROR(value, OUTOFRANGE, _("column")); - } - - if (g_pass == INTERPRET && FS_locate(STDCHANNEL, line, column) == -1) - { - g_pc = statementpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - return (struct Value *)0; -} - -struct Value *stmt_LOCK_UNLOCK(struct Value *value) -{ - int lock = g_pc.token->type == T_LOCK; - int channel; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_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 = g_pc; - struct Pc *dopc; - - ++g_pc.token; - if (g_pass == INTERPRET) - { - g_pc = looppc.token->u.dopc; - } - - if (g_pass == DECLARE || g_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 = g_pc; - } - - return (struct Value *)0; -} - -struct Value *stmt_LOOPUNTIL(struct Value *value) -{ - struct Pc loopuntilpc = g_pc; - struct Pc *dopc; - - ++g_pc.token; - if (eval(value, _("condition"))->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - if (Value_isNull(value)) - g_pc = loopuntilpc.token->u.dopc; - Value_destroy(value); - } - - if (g_pass == DECLARE || g_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 = g_pc; - } - - return (struct Value *)0; -} - -struct Value *stmt_LSET_RSET(struct Value *value) -{ - struct Value *l; - struct Pc tmppc; - int lset = (g_pc.token->type == T_LSET); - - ++g_pc.token; - if (g_pass == DECLARE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_pc.token + 1)->type == - T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - } - - tmppc = g_pc; - if ((l = lvalue(value))->type == V_ERROR) - { - return value; - } - - if (g_pass == COMPILE && l->type != V_STRING) - { - g_pc = tmppc; - return Value_new_ERROR(value, TYPEMISMATCH4); - } - - if (g_pc.token->type != T_EQ) - { - return Value_new_ERROR(value, MISSINGEQ); - } - - ++g_pc.token; - tmppc = g_pc; - if (eval(value, _("rhs"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, l->type)->type == V_ERROR)) - { - g_pc = tmppc; - return value; - } - - if (g_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 = g_pc; - - if (g_pass == DECLARE) - { - if (func(value)->type == V_ERROR) - { - return value; - } - else - { - Value_destroy(value); - } - - if (g_pc.token->type == T_EQ || g_pc.token->type == T_COMMA) - { - g_pc = here; - if (assign(value)->type == V_ERROR) - { - return value; - } - - Value_destroy(value); - } - } - else - { - if (g_pass == COMPILE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_find(&g_globals, g_pc.token->u.identifier, - (g_pc.token + 1)->type == T_OP) == 0) - { - return Value_new_ERROR(value, UNDECLARED); - } - } - - if (strcasecmp(g_pc.token->u.identifier->name, "mid$") - && (g_pc.token->u.identifier->sym->type == USERFUNCTION || - g_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 (g_pass != INTERPRET) - { - Value_destroy(value); - } - } - } - - return (struct Value *)0; -} - -struct Value *stmt_IF_ELSEIFIF(struct Value *value) -{ - struct Pc ifpc = g_pc; - - ++g_pc.token; - if (eval(value, _("condition"))->type == V_ERROR) - { - return value; - } - - if (g_pc.token->type != T_THEN) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGTHEN); - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - if (Value_isNull(value)) - { - g_pc = ifpc.token->u.elsepc; - } - - Value_destroy(value); - } - else - { - Value_destroy(value); - if (g_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 (g_pc.token->type == T_ELSE) - { - struct Pc elsepc = g_pc; - - ++g_pc.token; - ifpc.token->u.elsepc = g_pc; - if (ifpc.token->type == T_ELSEIFIF) - { - (ifpc.token - 1)->u.elsepc = g_pc; - } - - if (statements(value)->type == V_ERROR) - { - return value; - } - - Value_destroy(value); - elsepc.token->u.endifpc = g_pc; - } - else - { - ifpc.token->u.elsepc = g_pc; - if (ifpc.token->type == T_ELSEIFIF) - { - (ifpc.token - 1)->u.elsepc = g_pc; - } - } - } - - } - - return (struct Value *)0; -} - -struct Value *stmt_IMAGE(struct Value *value) -{ - ++g_pc.token; - if (g_pc.token->type != T_STRING) - { - return Value_new_ERROR(value, MISSINGFMT); - } - - ++g_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; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - else - { - ++g_pc.token; - } - } - - if (g_pc.token->type == T_SEMICOLON) - { - nl = 0; - ++g_pc.token; - } - - /* prompt */ - - if (g_pc.token->type == T_STRING) - { - if (g_pass == INTERPRET && channel == STDCHANNEL) - { - FS_putString(STDCHANNEL, g_pc.token->u.string); - } - - ++g_pc.token; - if (g_pc.token->type == T_COMMA || g_pc.token->type == T_COLON) - { - ++g_pc.token; - extraprompt = 0; - } - else if (g_pc.token->type == T_SEMICOLON) - { - ++g_pc.token; - } - else - { - extraprompt = 0; - } - } - - if (g_pass == INTERPRET && channel == STDCHANNEL && extraprompt) - { - FS_putChars(STDCHANNEL, "? "); - } - -retry: - if (g_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 (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGVARIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_pc.token + 1)->type == - T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - lvaluepc = g_pc; - if (((l = lvalue(value))->type) == V_ERROR) - { - return value; - } - - if (g_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)) - { - g_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 (g_pc.token->type == T_COMMA) - { - if (t->type == T_COMMA) - { - ++t; - } - else - { - Token_destroy(inputdata); - if (channel == STDCHANNEL) - { - FS_putChars(STDCHANNEL, "?? "); - ++g_pc.token; - goto retry; - } - else - { - g_pc = lvaluepc; - return Value_new_ERROR(value, MISSINGINPUTDATA); - } - } - } - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (g_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; - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var1 = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_pc.token->type != T_EQ) - { - return Value_new_ERROR(value, MISSINGEQ); - } - - ++g_pc.token; - if (g_pc.token->type == T_IDENTIFIER) /* a = b [ +|-|* c ] */ - { - if (g_pass == COMPILE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) - return Value_new_ERROR(value, UNDECLARED); - } - - var2 = &g_pc.token->u.identifier->sym->u.var; - if (g_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 (g_pass == COMPILE && - Value_commonType[var1->type][var2->type] == V_ERROR) - { - return Value_new_typeError(value, var2->type, var1->type); - } - - ++g_pc.token; - if (g_pc.token->type == T_PLUS || g_pc.token->type == T_MINUS || - g_pc.token->type == T_MULT) - { - oppc = g_pc; - op = g_pc.token->type; - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGARRIDENT); - } - - if (g_pass == COMPILE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) - { - return Value_new_ERROR(value, UNDECLARED); - } - } - - var3 = &g_pc.token->u.identifier->sym->u.var; - if (g_pass == INTERPRET && - ((var3->dim != 1 && var3->dim != 2) || var3->base < 0 || - var3->base > 1)) - { - return Value_new_ERROR(value, NOMATRIX, var3->dim, var3->base); - } - - ++g_pc.token; - } - - if (g_pass != DECLARE) - { - if (var3 == (struct Var *)0) - { - if (Var_mat_assign(var1, var2, value, g_pass == INTERPRET)) - { - assert(oppc.line != -1); - g_pc = oppc; - return value; - } - } - else if (op == T_MULT) - { - if (Var_mat_mult(var1, var2, var3, value, g_pass == INTERPRET)) - { - assert(oppc.line != -1); - g_pc = oppc; - return value; - } - } - else if (Var_mat_addsub - (var1, var2, var3, op == T_PLUS, value, g_pass == INTERPRET)) - { - assert(oppc.line != -1); - g_pc = oppc; - return value; - } - } - } - else if (g_pc.token->type == T_OP) - { - if (var1->type == V_STRING) - { - return Value_new_ERROR(value, TYPEMISMATCH5); - } - - ++g_pc.token; - if (eval(value, _("factor"))->type == V_ERROR) - { - return value; - } - - if (g_pass == COMPILE && - Value_commonType[var1->type][value->type] == V_ERROR) - { - return Value_new_typeError(value, var1->type, value->type); - } - - if (g_pc.token->type != T_CP) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGCP); - } - - ++g_pc.token; - if (g_pc.token->type != T_MULT) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGMULT); - } - - oppc = g_pc; - ++g_pc.token; - if (g_pass == COMPILE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) - { - Value_destroy(value); - return Value_new_ERROR(value, UNDECLARED); - } - } - - var2 = &g_pc.token->u.identifier->sym->u.var; - if (g_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 (g_pass != DECLARE && - Var_mat_scalarMult(var1, value, var2, g_pass == INTERPRET)) - { - assert(oppc.line != -1); - g_pc = oppc; - return value; - } - - Value_destroy(value); - ++g_pc.token; - } - - else if (g_pc.token->type == T_CON || g_pc.token->type == T_ZER || - g_pc.token->type == T_IDN) - { - op = g_pc.token->type; - if (g_pass == COMPILE && Value_commonType[var1->type][V_INTEGER] == V_ERROR) - { - return Value_new_typeError(value, V_INTEGER, var1->type); - } - - ++g_pc.token; - if (g_pc.token->type == T_OP) - { - unsigned int dim, geometry[2]; - enum ValueType vartype = var1->type; - - ++g_pc.token; - if (evalGeometry(value, &dim, geometry)) - { - return value; - } - - if (g_pass == INTERPRET) - { - Var_destroy(var1); - Var_new(var1, vartype, dim, geometry, g_optionbase); - } - } - - if (g_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 (g_pc.token->type == T_TRN || g_pc.token->type == T_INV) - { - op = g_pc.token->type; - ++g_pc.token; - if (g_pc.token->type != T_OP) - { - return Value_new_ERROR(value, MISSINGOP); - } - - ++g_pc.token; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == COMPILE) - { - if (((g_pc.token + 1)->type == T_OP || - Auto_find(&g_stack, g_pc.token->u.identifier) == 0) && - Global_find(&g_globals, g_pc.token->u.identifier, 1) == 0) - { - return Value_new_ERROR(value, UNDECLARED); - } - } - - var2 = &g_pc.token->u.identifier->sym->u.var; - if (g_pass == COMPILE && - Value_commonType[var1->type][var2->type] == V_ERROR) - { - return Value_new_typeError(value, var2->type, var1->type); - } - - if (g_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, &g_stack.lastdet, value)) - { - return value; - } - - break; - - default: - assert(0); - } - } - - ++g_pc.token; - if (g_pc.token->type != T_CP) - { - return Value_new_ERROR(value, MISSINGCP); - } - - ++g_pc.token; - } - else - { - return Value_new_ERROR(value, MISSINGEXPR, _("matrix")); - } - - return (struct Value *)0; -} - -struct Value *stmt_MATINPUT(struct Value *value) -{ - int channel = STDCHANNEL; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - else - { - ++g_pc.token; - } - } - - while (1) - { - struct Pc lvaluepc; - struct Var *var; - - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_pc.token->type == T_OP) - { - unsigned int dim, geometry[2]; - enum ValueType vartype = var->type; - - ++g_pc.token; - if (evalGeometry(value, &dim, geometry)) - { - return value; - } - - if (g_pass == INTERPRET) - { - Var_destroy(var); - Var_new(var, vartype, dim, geometry, g_optionbase); - } - } - - if (g_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); - g_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 (g_pc.token->type == T_COMMA) - { - ++g_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; - - ++g_pc.token; - if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - } - - if (g_pc.token->type == T_USING) - { - struct Pc usingpc; - - usingpc = g_pc; - printusing = 1; - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == COMPILE && - Program_imageLine(&g_program, g_pc.token->u.integer, - &usingpc.token->u.image) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHIMAGELINE); - } - else if (g_pass == INTERPRET) - { - using = usingpc.token->u.image.token->u.string; - } - - Value_new_STRING(&usingval); - ++g_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 (g_pc.token->type != T_SEMICOLON) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, MISSINGSEMICOLON); - } - - ++g_pc.token; - } - else - { - Value_new_STRING(&usingval); - using = &usingval.u.string; - } - while (1) - { - struct Var *var; - int zoned = 1; - - if (g_pc.token->type != T_IDENTIFIER) - { - if (notfirst) - { - break; - } - - Value_destroy(&usingval); - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_pc.token->type == T_SEMICOLON) - { - zoned = 0; - } - - if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) - { - ++g_pc.token; - } - else - { - break; - } - - notfirst = 1; - } - - Value_destroy(&usingval); - if (g_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) -{ - ++g_pc.token; - while (1) - { - struct Pc lvaluepc; - struct Var *var; - - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_pc.token->type == T_OP) - { - unsigned int dim, geometry[2]; - enum ValueType vartype = var->type; - - ++g_pc.token; - if (evalGeometry(value, &dim, geometry)) - { - return value; - } - - if (g_pass == INTERPRET) - { - Var_destroy(var); - Var_new(var, vartype, dim, geometry, g_optionbase); - } - } - - if (g_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]))) - { - g_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]))) - { - g_pc = lvaluepc; - return value; - } - } - } - } - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_MATREDIM(struct Value *value) -{ - ++g_pc.token; - while (1) - { - struct Var *var; - unsigned int dim, geometry[2]; - - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_pc.token->type != T_OP) - { - return Value_new_ERROR(value, MISSINGOP); - } - - ++g_pc.token; - if (evalGeometry(value, &dim, geometry)) - { - return value; - } - - if (g_pass == INTERPRET && - Var_mat_redim(var, dim, geometry, value) != (struct Value *)0) - { - return value; - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_MATWRITE(struct Value *value) -{ - int chn = STDCHANNEL; - int notfirst = 0; - int comma = 0; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - } - - while (1) - { - struct Var *var; - - if (g_pc.token->type != T_IDENTIFIER) - { - if (notfirst) - { - break; - } - - return Value_new_ERROR(value, MISSINGMATIDENT); - } - - notfirst = 1; - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, GLOBALARRAY, - 0) == 0) - { - return Value_new_ERROR(value, REDECLARATION); - } - - var = &g_pc.token->u.identifier->sym->u.var; - ++g_pc.token; - if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (g_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 = g_pc; - struct Value old; - int res = -1, reserrno = -1; - - ++g_pc.token; - if (eval(value, _("file name"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (g_pc.token->type != T_AS) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGAS); - } - - old = *value; - ++g_pc.token; - if (eval(value, _("file name"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - Value_destroy(&old); - return value; - } - - if (g_pass == INTERPRET) - { - res = rename(old.u.string.character, value->u.string.character); - reserrno = errno; - } - - Value_destroy(&old); - Value_destroy(value); - if (g_pass == INTERPRET && res == -1) - { - g_pc = namepc; - return Value_new_ERROR(value, IOERROR, strerror(reserrno)); - } - - return (struct Value *)0; -} - -struct Value *stmt_NEW(struct Value *value) -{ - if (g_pass == INTERPRET) - { - if (!DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - new(); - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_NEXT(struct Value *value) -{ - struct Next **next = &g_pc.token->u.next; - int level = 0; - - if (g_pass == INTERPRET) - { - struct Value *l, inc; - struct Pc savepc; - - ++g_pc.token; - while (1) - { - /* get variable lvalue */ - - savepc = g_pc; - g_pc = (*next)[level].var; - if ((l = lvalue(value))->type == V_ERROR) - { - return value; - } - - g_pc = savepc; - - /* get limit value and increment */ - - savepc = g_pc; - g_pc = (*next)[level].limit; - if (eval(value, _("limit"))->type == V_ERROR) - { - return value; - } - - Value_retype(value, l->type); - assert(value->type != V_ERROR); - if (g_pc.token->type == T_STEP) - { - ++g_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); - g_pc = savepc; - - Value_add(l, &inc, 1); - if (Value_exitFor(l, value, &inc)) - { - Value_destroy(value); - Value_destroy(&inc); - if (g_pc.token->type == T_IDENTIFIER) - { - if (lvalue(value)->type == V_ERROR) - { - return value; - } - - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - ++level; - } - else - { - break; - } - } - else - { - break; - } - } - else - { - g_pc = (*next)[level].body; - Value_destroy(value); - Value_destroy(&inc); - break; - } - } - } - else - { - struct Pc *body; - - ++g_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 (g_pc.token->type == T_IDENTIFIER) - { - if (cistrcmp - (g_pc.token->u.identifier->name, - (*next)[level].var.token->u.identifier->name)) - { - return Value_new_ERROR(value, FORMISMATCH); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - ++level; - } - else - { - break; - } - } - else - { - break; - } - } - - while (level >= 0) - { - (*next)[level--].fr.token->u.exitfor = g_pc; - } - } - - return (struct Value *)0; -} - -struct Value *stmt_ON(struct Value *value) -{ - struct On *on = &g_pc.token->u.on; - - ++g_pc.token; - if (eval(value, _("selector"))->type == V_ERROR) - { - return value; - } - - if (Value_retype(value, V_INTEGER)->type == V_ERROR) - { - return value; - } - - if (g_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 (g_pc.token->type == T_GOTO) - { - g_pc = newpc; - } - else - { - g_pc = on->pc[0]; - Auto_pushGosubRet(&g_stack, &g_pc); - g_pc = newpc; - } - - Program_trace(&g_program, &g_pc, 0, 1); - } - else if (g_pass == DECLARE || g_pass == COMPILE) - { - Value_destroy(value); - if (g_pc.token->type != T_GOTO && g_pc.token->type != T_GOSUB) - { - return Value_new_ERROR(value, MISSINGGOTOSUB); - } - - ++g_pc.token; - on->pcLength = 1; - while (1) - { - on->pc = realloc(on->pc, sizeof(struct Pc) * ++on->pcLength); - if (g_pc.token->type != T_INTEGER) - { - return Value_new_ERROR(value, MISSINGLINENUMBER); - } - - if (Program_goLine - (&g_program, g_pc.token->u.integer, - &on->pc[on->pcLength - 1]) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - if (g_pass == COMPILE && - Program_scopeCheck(&g_program, &on->pc[on->pcLength - 1], - findLabel(L_FUNC))) - { - return Value_new_ERROR(value, OUTOFSCOPE); - } - - ++g_pc.token; - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - break; - } - } - - on->pc[0] = g_pc; - } - - return (struct Value *)0; -} - -struct Value *stmt_ONERROR(struct Value *value) -{ - if (DIRECTMODE) - { - return Value_new_ERROR(value, NOTINDIRECTMODE); - } - - ++g_pc.token; - if (g_pass == INTERPRET) - { - g_stack.onerror = g_pc; - Program_nextLine(&g_program, &g_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 (g_pass == INTERPRET) - { - g_stack.onerror.line = -1; - if (g_stack.resumeable) - { - g_pc = g_stack.erpc; - return Value_clone(value, &g_stack.err); - } - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_ONERROROFF(struct Value *value) -{ - if (DIRECTMODE) - { - return Value_new_ERROR(value, NOTINDIRECTMODE); - } - - if (g_pass == INTERPRET) - { - g_stack.onerror.line = -1; - } - - ++g_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 = g_pc; - - ++g_pc.token; - errpc = g_pc; - if (eval(value, _("mode or file"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (g_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 (g_pass == INTERPRET && inout == -1) - { - g_pc = errpc; - return Value_new_ERROR(value, BADMODE); - } - - if (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_pc.token; - } - - errpc = g_pc; - if (eval(value, _("channel"))->type == V_ERROR || - Value_retype(value, V_INTEGER)->type == V_ERROR) - { - g_pc = errpc; - return value; - } - - channel = value->u.integer; - Value_destroy(value); - if (g_pass == INTERPRET && channel < 0) - { - return Value_new_ERROR(value, OUTOFRANGE, _("channel")); - } - - if (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_pc.token; - if (eval(value, _("file name"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (inout == 3) - { - if (g_pc.token->type != T_COMMA) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_pc.token; - errpc = g_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 (g_pass == INTERPRET && recLength <= 0) - { - Value_destroy(value); - g_pc = errpc; - return Value_new_ERROR(value, OUTOFRANGE, _("record length")); - } - } - } - else /* parse ANSI syntax */ - { - struct Value channelValue; - int newMode; - - switch (g_pc.token->type) - { - case T_FOR_INPUT: - inout = 0; - mode = FS_ACCESS_READ; - ++g_pc.token; - break; - - case T_FOR_OUTPUT: - inout = 1; - mode = FS_ACCESS_WRITE; - ++g_pc.token; - break; - - case T_FOR_APPEND: - inout = 1; - mode = FS_ACCESS_WRITE; - append = 1; - ++g_pc.token; - break; - - case T_FOR_RANDOM: - inout = 3; - mode = FS_ACCESS_READWRITE; - ++g_pc.token; - break; - - case T_FOR_BINARY: - inout = 4; - mode = FS_ACCESS_READWRITE; - ++g_pc.token; - break; - - default: - inout = 3; - mode = FS_ACCESS_READWRITE; - break; - } - - switch (g_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; - ++g_pc.token; - } - - switch (g_pc.token->type) - { - case T_SHARED: - lock = FS_LOCK_NONE; - ++g_pc.token; - break; - - case T_LOCK_READ: - lock = FS_LOCK_SHARED; - ++g_pc.token; - break; - - case T_LOCK_WRITE: - lock = FS_LOCK_EXCLUSIVE; - ++g_pc.token; - break; - - default:; - } - - if (g_pc.token->type != T_AS) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGAS); - } - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_pc.token; - } - - errpc = g_pc; - if (eval(&channelValue, _("channel"))->type == V_ERROR || - Value_retype(&channelValue, V_INTEGER)->type == V_ERROR) - { - g_pc = errpc; - Value_destroy(value); - *value = channelValue; - return value; - } - - channel = channelValue.u.integer; - Value_destroy(&channelValue); - if (inout == 3) - { - if (g_pc.token->type == T_IDENTIFIER) - { - if (cistrcmp(g_pc.token->u.identifier->name, "len")) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGLEN); - } - - ++g_pc.token; - if (g_pc.token->type != T_EQ) - { - Value_destroy(value); - return Value_new_ERROR(value, MISSINGEQ); - } - - ++g_pc.token; - errpc = g_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 (g_pass == INTERPRET && recLength <= 0) - { - Value_destroy(value); - g_pc = errpc; - return Value_new_ERROR(value, OUTOFRANGE, _("record length")); - } - } - else - { - recLength = 1; - } - } - } - - /* open file with name value */ - if (g_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) - { - g_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) - { - g_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) -{ - ++g_pc.token; - if (eval(value, _("array subscript base"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) - { - return value; - } - - if (g_pass == INTERPRET) - { - g_optionbase = value->u.integer; - } - - Value_destroy(value); - return (struct Value *)0; -} - -struct Value *stmt_OPTIONRUN(struct Value *value) -{ - ++g_pc.token; - if (g_pass == INTERPRET) - { - FS_xonxoff(STDCHANNEL, 0); - } - - return (struct Value *)0; -} - -struct Value *stmt_OPTIONSTOP(struct Value *value) -{ - ++g_pc.token; - if (g_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 = (g_pc.token->type == T_OUT); - lpc = g_pc; - ++g_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 (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_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 (g_pass == INTERPRET) - { - if ((out ? FS_portOutput : FS_memOutput) (address, val) == -1) - { - g_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 = (g_pc.token->type == T_PRINT ? STDCHANNEL : LPCHANNEL); - int printusing = 0; - struct Value usingval; - struct String *using = (struct String *)0; - size_t usingpos = 0; - - ++g_pc.token; - if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - } - - if (g_pc.token->type == T_USING) - { - struct Pc usingpc; - - usingpc = g_pc; - printusing = 1; - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == COMPILE && - Program_imageLine(&g_program, g_pc.token->u.integer, - &usingpc.token->u.image) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHIMAGELINE); - } - else if (g_pass == INTERPRET) - { - using = usingpc.token->u.image.token->u.string; - } - - Value_new_STRING(&usingval); - ++g_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 (g_pc.token->type != T_SEMICOLON) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, MISSINGSEMICOLON); - } - - ++g_pc.token; - } - else - { - Value_new_STRING(&usingval); - using = &usingval.u.string; - } - - while (1) - { - struct Pc valuepc; - - valuepc = g_pc; - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR) - { - Value_destroy(&usingval); - return value; - } - - if (g_pass == INTERPRET) - { - struct String s; - - String_new(&s); - if (Value_toStringUsing(value, &s, using, &usingpos)->type == - V_ERROR) - { - Value_destroy(&usingval); - String_destroy(&s); - g_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 (g_pc.token->type == T_TAB || g_pc.token->type == T_SPC) - { - int tab = g_pc.token->type == T_TAB; - - ++g_pc.token; - if (g_pc.token->type != T_OP) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, MISSINGOP); - } - - ++g_pc.token; - if (eval(value, _("count"))->type == V_ERROR || - Value_retype(value, V_INTEGER)->type == V_ERROR) - { - Value_destroy(&usingval); - return value; - } - - if (g_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 (g_pc.token->type != T_CP) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, MISSINGCP); - } - - ++g_pc.token; - nl = 1; - } - - else if (g_pc.token->type == T_SEMICOLON) - { - ++g_pc.token; - nl = 0; - } - - else if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (g_pass == INTERPRET && !printusing) - { - FS_nextcol(chn); - } - - nl = 0; - } - - else - { - break; - } - - if (g_pass == INTERPRET && FS_flush(chn) == -1) - { - Value_destroy(&usingval); - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - } - - Value_destroy(&usingval); - if (g_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; - - ++g_pc.token; - argpc = g_pc; - if (eval(value, (const char *)0)) - { - Value_retype(value, V_INTEGER); - if (value->type == V_ERROR) - { - g_pc = argpc; - Value_destroy(value); - return Value_new_ERROR(value, MISSINGEXPR, - _("random number generator seed")); - } - - if (g_pass == INTERPRET) - { - srand(g_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) -{ - ++g_pc.token; - while (1) - { - struct Value *l; - struct Pc lvaluepc; - - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGREADIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 (g_pass == INTERPRET && dataread(value, l)) - { - g_pc = lvaluepc; - return value; - } - - if (g_pc.token->type == T_COMMA) - { - ++g_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 = g_pc; - - ++g_pc.token; - argpc = g_pc; - if (eval(&from, _("source file"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(&from, V_STRING)->type == V_ERROR)) - { - g_pc = argpc; - *value = from; - return value; - } - - if (g_pc.token->type != T_TO) - { - Value_destroy(&from); - return Value_new_ERROR(value, MISSINGTO); - } - - ++g_pc.token; - argpc = g_pc; - if (eval(value, _("destination file"))->type == V_ERROR || - (g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR)) - { - g_pc = argpc; - return value; - } - - if (g_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); - g_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; - - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - first = g_pc.token->u.integer; - ++g_pc.token; - if (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - if (g_pc.token->type != T_INTEGER) - return Value_new_ERROR(value, MISSINGINCREMENT); - inc = g_pc.token->u.integer; - ++g_pc.token; - } - } - - if (g_pass == INTERPRET) - { - if (!DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - Program_renum(&g_program, first, inc); - } - - return (struct Value *)0; -} - -struct Value *stmt_REPEAT(struct Value *value) -{ - if (g_pass == DECLARE || g_pass == COMPILE) - { - pushLabel(L_REPEAT, &g_pc); - } - - ++g_pc.token; - return (struct Value *)0; -} - -struct Value *stmt_RESTORE(struct Value *value) -{ - struct Token *restorepc = g_pc.token; - - if (g_pass == INTERPRET) - { - g_curdata = g_pc.token->u.restore; - } - - ++g_pc.token; - if (g_pc.token->type == T_INTEGER) - { - if (g_pass == COMPILE && - Program_dataLine(&g_program, g_pc.token->u.integer, - &restorepc->u.restore) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHDATALINE); - } - - ++g_pc.token; - } - else if (g_pass == COMPILE) - { - restorepc->u.restore = g_stack.begindata; - } - - return (struct Value *)0; -} - -struct Value *stmt_RETURN(struct Value *value) -{ - if (g_pass == DECLARE || g_pass == COMPILE) - { - ++g_pc.token; - } - - if (g_pass == INTERPRET) - { - if (Auto_gosubReturn(&g_stack, &g_pc)) - { - Program_trace(&g_program, &g_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; - - g_stack.resumeable = 0; - ++g_pc.token; - argpc = g_pc; - if (g_pc.token->type == T_INTEGER) - { - if (Program_goLine(&g_program, g_pc.token->u.integer, &begin) == - (struct Pc *)0) - { - return Value_new_ERROR(value, NOSUCHLINE); - } - - if (g_pass == COMPILE && - Program_scopeCheck(&g_program, &begin, findLabel(L_FUNC))) - { - return Value_new_ERROR(value, OUTOFSCOPE); - } - - ++g_pc.token; - } - else if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - g_pc = argpc; - return value; - } - else if (g_pass == INTERPRET) - { - int chn; - struct Program newprogram; - - if ((chn = FS_openin(value->u.string.character)) == -1) - { - g_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)) - { - g_pc = argpc; - Program_destroy(&newprogram); - return value; - } - - FS_close(chn); - new(); - Program_destroy(&g_program); - g_program = newprogram; - if (Program_beginning(&g_program, &begin) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOPROGRAM); - } - } - else - { - Value_destroy(value); - } - } - else - { - if (Program_beginning(&g_program, &begin) == (struct Pc *)0) - { - return Value_new_ERROR(value, NOPROGRAM); - } - } - - if (g_pass == INTERPRET) - { - if (compileProgram(value, 1)->type == V_ERROR) - { - return value; - } - - g_pc = begin; - g_curdata = g_stack.begindata; - Global_clear(&g_globals); - FS_closefiles(); - Program_trace(&g_program, &g_pc, 0, 1); - } - - return (struct Value *)0; -} - -struct Value *stmt_SAVE(struct Value *value) -{ - struct Pc loadpc; - int name; - - if (g_pass == INTERPRET && !DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - ++g_pc.token; - loadpc = g_pc; - if (g_pc.token->type == T_EOL && g_program.name.length) - { - name = 0; - } - else - { - name = 1; - if (eval(value, _("file name"))->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - g_pc = loadpc; - return value; - } - } - - if (g_pass == INTERPRET) - { - int chn; - - if (name) - { - Program_setname(&g_program, value->u.string.character); - } - - if ((chn = FS_openout(g_program.name.character)) == -1) - { - g_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(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value)) - { - g_pc = loadpc; - return value; - } - - FS_close(chn); - g_program.unsaved = 0; - } - else if (name) - { - Value_destroy(value); - } - - return (struct Value *)0; -} - -struct Value *stmt_SELECTCASE(struct Value *value) -{ - struct Pc statementpc = g_pc; - - if (g_pass == DECLARE || g_pass == COMPILE) - { - pushLabel(L_SELECTCASE, &g_pc); - } - - ++g_pc.token; - if (eval(value, _("selector"))->type == V_ERROR) - { - return value; - } - - if (g_pass == DECLARE || g_pass == COMPILE) - { - statementpc.token->u.selectcase->type = value->type; - statementpc.token->u.selectcase->nextcasevalue.line = -1; - } - else - { - struct Pc casevaluepc; - int match = 0; - - g_pc = casevaluepc = statementpc.token->u.selectcase->nextcasevalue; - do - { - ++g_pc.token; - switch (casevaluepc.token->type) - { - case T_CASEVALUE: - { - do - { - struct Value casevalue1; - - if (g_pc.token->type == T_IS) - { - enum TokenType relop; - - ++g_pc.token; - relop = g_pc.token->type; - ++g_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 (g_pc.token->type == T_TO) /* match range */ - { - struct Value casevalue2; - - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_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) - { - g_pc = casevaluepc = - casevaluepc.token->u.casevalue->nextcasevalue; - } - else - { - g_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; - - ++g_pc.token; - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR || - Value_retype(value, V_STRING)->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - if (g_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 (g_pass == INTERPRET) - { - if (g_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; - - ++g_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 (g_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 (g_pass != INTERPRET) - { - ++g_pc.token; - } - - return (struct Value *)0; -} - -struct Value *stmt_SUBEXIT(struct Value *value) -{ - struct Pc *curfn = (struct Pc *)0; - - if (g_pass == DECLARE || g_pass == COMPILE) - { - if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 || - (curfn->token + 1)->u.identifier->defaultType != V_VOID) - { - return Value_new_ERROR(value, STRAYSUBEXIT); - } - } - - ++g_pc.token; - if (g_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; - - ++g_pc.token; - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGSWAPIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - else - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - lvaluepc = g_pc; - if (g_pc.token->type != T_IDENTIFIER) - { - return Value_new_ERROR(value, MISSINGSWAPIDENT); - } - - if (g_pass == DECLARE && - Global_variable(&g_globals, g_pc.token->u.identifier, - g_pc.token->u.identifier->defaultType, - (g_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) - { - g_pc = lvaluepc; - return Value_new_typeError(value, l2->type, l1->type); - } - - if (g_pass == INTERPRET) - { - struct Value foo; - - foo = *l1; - *l1 = *l2; - *l2 = foo; - } - - return (struct Value *)0; -} - -struct Value *stmt_SYSTEM(struct Value *value) -{ - ++g_pc.token; - if (g_pass == INTERPRET) - { - if (g_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) -{ - ++g_pc.token; - g_program.trace = 0; - return (struct Value *)0; -} - -struct Value *stmt_TRON(struct Value *value) -{ - ++g_pc.token; - g_program.trace = 1; - return (struct Value *)0; -} - -struct Value *stmt_TRUNCATE(struct Value *value) -{ - struct Pc chnpc; - int chn; - - chnpc = g_pc; - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pass == INTERPRET && FS_truncate(chn) == -1) - { - g_pc = chnpc; - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - - return (struct Value *)0; -} - -struct Value *stmt_UNNUM(struct Value *value) -{ - ++g_pc.token; - if (g_pass == INTERPRET) - { - if (!DIRECTMODE) - { - return Value_new_ERROR(value, NOTINPROGRAMMODE); - } - - Program_unnum(&g_program); - } - - return (struct Value *)0; -} - -struct Value *stmt_UNTIL(struct Value *value) -{ - struct Pc untilpc = g_pc; - struct Pc *repeatpc; - - ++g_pc.token; - if (eval(value, _("condition"))->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - if (Value_isNull(value)) - { - g_pc = untilpc.token->u.until; - } - - Value_destroy(value); - } - - if (g_pass == DECLARE || g_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 = g_pc; - ++g_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 (g_pc.token->type != T_COMMA) - { - return Value_new_ERROR(value, MISSINGCOMMA); - } - - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_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 (g_pass == INTERPRET) - { - int v; - - do - { - if ((v = FS_portInput(address)) == -1) - { - g_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 = g_pc; - - if (g_pass == DECLARE || g_pass == COMPILE) - { - pushLabel(L_WHILE, &g_pc); - } - - ++g_pc.token; - if (eval(value, _("condition"))->type == V_ERROR) - { - return value; - } - - if (g_pass == INTERPRET) - { - if (Value_isNull(value)) - { - g_pc = *whilepc.token->u.afterwend; - } - - Value_destroy(value); - } - - return (struct Value *)0; -} - -struct Value *stmt_WEND(struct Value *value) -{ - if (g_pass == DECLARE || g_pass == COMPILE) - { - struct Pc *whilepc; - - if ((whilepc = popLabel(L_WHILE)) == (struct Pc *)0) - { - return Value_new_ERROR(value, STRAYWEND, topLabelDescription()); - } - - *g_pc.token->u.whilepc = *whilepc; - ++g_pc.token; - *(whilepc->token->u.afterwend) = g_pc; - } - else - { - g_pc = *g_pc.token->u.whilepc; - } - - return (struct Value *)0; -} - -struct Value *stmt_WIDTH(struct Value *value) -{ - int chn = STDCHANNEL, width; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_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 (g_pass == INTERPRET && FS_width(chn, width) == -1) - { - return Value_new_ERROR(value, IOERROR, FS_errmsg); - } - } - - if (g_pc.token->type == T_COMMA) - { - ++g_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 (g_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; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_pc.token; - } - } - - while (1) - { - if (eval(value, (const char *)0)) - { - if (value->type == V_ERROR) - { - return value; - } - - if (g_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 (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON) - { - ++g_pc.token; - } - else - { - break; - } - } - - if (g_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) -{ - g_stack.resumeable = 0; - ++g_pc.token; - if (g_pass == INTERPRET) - { - if (!g_program.runnable && compileProgram(value, 1)->type == V_ERROR) - { - return value; - } - - Program_xref(&g_program, STDCHANNEL); - } - - return (struct Value *)0; -} - -struct Value *stmt_ZONE(struct Value *value) -{ - int chn = STDCHANNEL, width; - - ++g_pc.token; - if (g_pc.token->type == T_CHANNEL) - { - ++g_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 (g_pc.token->type == T_COMMA) - { - ++g_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 (g_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 deleted file mode 100644 index 49512171e..000000000 --- a/apps/interpreters/bas/statement.h +++ /dev/null @@ -1,166 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index 134cb0634..000000000 --- a/apps/interpreters/bas/str.c +++ /dev/null @@ -1,457 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include -#include -#include -#include - -#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 deleted file mode 100644 index 9c706a27b..000000000 --- a/apps/interpreters/bas/str.h +++ /dev/null @@ -1,115 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -/**************************************************************************** - * 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 deleted file mode 100644 index f8fb352dd..000000000 --- a/apps/interpreters/bas/token.c +++ /dev/null @@ -1,5388 +0,0 @@ - -#line 3 "" - -#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 -#include -#include -#include - -/* end standard C headers. */ - -/* flex integer type definitions */ - -#ifndef FLEXINT_H -#define FLEXINT_H - -/* C99 systems have . 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 -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 - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "auto.h" -#include "token.h" -#include "statement.h" - -static int g_matchdata; -static int g_backslash_colon; -static int g_uppercase; -static struct Token *cur; -int yylex(void); - -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 "" - -#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 -#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 (g_matchdata) BEGIN(DATAINPUT); - -#line 1683 "" - - 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 (g_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 "" -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 g_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 */ /*{{{*/ - g_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; - g_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); - g_matchdata=1; - for (l=1; yylex(); ++l); - yy_delete_buffer(buf); - cur=result=malloc(sizeof(struct Token)*l); - buf=yy_scan_string(ln); - g_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",g_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 (g_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) \ - g_token_property[t]=(assoc<<8)|(unary_priority<<5)|(binary_priority<<2)|(is_unary<<1)|is_binary - - g_backslash_colon=b_c; - g_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 deleted file mode 100644 index 3fcb5afd5..000000000 --- a/apps/interpreters/bas/token.h +++ /dev/null @@ -1,546 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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) (g_token_property[t]&1) -#define TOKEN_ISUNARYOPERATOR(t) (g_token_property[t]&(1<<1)) -#define TOKEN_BINARYPRIORITY(t) ((g_token_property[t]>>2)&7) -#define TOKEN_UNARYPRIORITY(t) ((g_token_property[t]>>5)&7) -#define TOKEN_ISRIGHTASSOCIATIVE(t) (g_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 g_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 deleted file mode 100644 index 351497948..000000000 --- a/apps/interpreters/bas/token.l +++ /dev/null @@ -1,1944 +0,0 @@ -/* Tokens and token sequence arrays. */ -%{ -/* #includes */ /*{{{C}}}*//*{{{*/ -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "auto.h" -#include "token.h" -#include "statement.h" - -#ifdef DMALLOC -#include "dmalloc.h" -#endif -/*}}}*/ - -static int g_matchdata; -static int g_backslash_colon; -static int g_uppercase; -int yylex(void); -static struct Token *g_cur; - -static void string(const char *text) /*{{{*/ -{ - if (g_cur) - { - const char *t; - char *q; - size_t l; - - for (t=text+1,l=0; *(t+1); ++t,++l) - { - if (*t=='"') ++t; - } - g_cur->u.string=malloc(sizeof(struct String)); - String_size(String_new(g_cur->u.string),l); - for (t=text+1,q=g_cur->u.string->character; *(t+1); ++t,++q) - { - *q=*t; - if (*t=='"') ++t; - } - } -} -/*}}}*/ -static void string2(void) /*{{{*/ -{ - if (g_cur) - { - char *t,*q; - size_t l; - - for (t=yytext+1,l=0; *t; ++t,++l) - { - if (*t=='"') ++t; - } - g_cur->u.string=malloc(sizeof(struct String)); - String_size(String_new(g_cur->u.string),l); - for (t=yytext+1,q=g_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 (g_matchdata) BEGIN(DATAINPUT); - -"#" return T_CHANNEL; -{REAL} { - int overflow; - double d; - - d=Value_vald(yytext,(char**)0,&overflow); - if (overflow) - { - if (g_cur) g_cur->u.junk=yytext[0]; - yyless(1); - return T_JUNK; - } - if (g_cur) g_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 (g_cur) g_cur->u.junk=yytext[0]; - yyless(1); - return T_JUNK; - } - if (g_cur) g_cur->u.real=d; - return T_REAL; - } - if (g_cur) g_cur->u.integer=n; - return T_INTEGER; - } -{HEXINTEGER} { - int overflow; - long int n; - - n=Value_vali(yytext,(char**)0,&overflow); - if (overflow) - { - if (g_cur) g_cur->u.junk=yytext[0]; - yyless(1); - return T_JUNK; - } - if (g_cur) g_cur->u.hexinteger=n; - return T_HEXINTEGER; - } -{OCTINTEGER} { - int overflow; - long int n; - - n=Value_vali(yytext,(char**)0,&overflow); - if (overflow) - { - if (g_cur) g_cur->u.junk=yytext[0]; - yyless(1); - return T_JUNK; - } - if (g_cur) g_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 (g_backslash_colon) - { - if (g_cur) g_cur->statement=stmt_COLON_EOL; - return T_COLON; - } - return T_IDIV; - } -":" { - if (g_cur) - { - g_cur->statement=stmt_COLON_EOL; - } - return T_COLON; - } -";" return T_SEMICOLON; -"<" return T_LT; -"<=" return T_LE; -"=<" return T_LE; -"<>"|"><" return T_NE; -"=" { - if (g_cur) - { - g_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 (g_cur) - { - g_cur->statement=stmt_CALL; - } - return T_CALL; - } -"case"[ \t]+"else" { - if (g_cur) - { - g_cur->statement=stmt_CASE; - g_cur->u.casevalue=malloc(sizeof(struct Casevalue)); - } - return T_CASEELSE; - } -"case" { - if (g_cur) - { - g_cur->statement=stmt_CASE; - g_cur->u.casevalue=malloc(sizeof(struct Casevalue)); - } - return T_CASEVALUE; - } -"chdir" { - if (g_cur) - { - g_cur->statement=stmt_CHDIR_MKDIR; - } - return T_CHDIR; - } -"clear" { - if (g_cur) - { - g_cur->statement=stmt_CLEAR; - } - return T_CLEAR; - } -"close" { - if (g_cur) - { - g_cur->statement=stmt_CLOSE; - } - return T_CLOSE; - } -"close"/"#" { - if (g_cur) - { - g_cur->statement=stmt_CLOSE; - } - return T_CLOSE; - } -"cls"|"home" { - if (g_cur) - { - g_cur->statement=stmt_CLS; - } - return T_CLS; - } -"color" { - if (g_cur) - { - g_cur->statement=stmt_COLOR; - } - return T_COLOR; - } -"con" return T_CON; -"copy" { - if (g_cur) - { - g_cur->statement=stmt_COPY_RENAME; - } - return T_COPY; - } -"data"|"d." { - BEGIN(DATAINPUT); - if (g_cur) - { - g_cur->statement=stmt_DATA; - } - return T_DATA; - } -{STRING} string(yytext); return T_STRING; -{STRING2} string2(); return T_STRING; -"," return T_COMMA; -{DATAITEM} { - if (g_cur) g_cur->u.datainput=strcpy(malloc(strlen(yytext)+1),yytext); - return T_DATAINPUT; - } -[ \t]+ -\n BEGIN(INITIAL); -: BEGIN(INITIAL); return T_COLON; -"dec" { - if (g_cur) - { - g_cur->statement=stmt_DEC_INC; - } - return T_DEC; - } -"defdbl" { - if (g_cur) - { - g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; - } - return T_DEFDBL; - } -"defint" { - if (g_cur) - { - g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; - } - return T_DEFINT; - } -"defstr" { - if (g_cur) - { - g_cur->statement=stmt_DEFINT_DEFDBL_DEFSTR; - } - return T_DEFSTR; - } -"def"/[ \t]+fn[ \t]*[A-Z_0-9\.] { - if (g_cur) - { - g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; - g_cur->u.localSyms=(struct Symbol*)0; - } - return T_DEFFN; - } -"def"/[ \t]+proc[A-Z_0-9\.] { - if (g_cur) - { - g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; - g_cur->u.localSyms=(struct Symbol*)0; - } - return T_DEFPROC; - } -"delete" { - if (g_cur) - { - g_cur->statement=stmt_DELETE; - } - return T_DELETE; - } -"dim" { - if (g_cur) - { - g_cur->statement=stmt_DIM; - } - return T_DIM; - } -"display" { - if (g_cur) - { - g_cur->statement=stmt_DISPLAY; - } - return T_DISPLAY; - } -"do" { - if (g_cur) - { - g_cur->statement=stmt_DO; - } - return T_DO; - } -{DOUNTIL} { - if (g_cur) - { - g_cur->statement=stmt_DOcondition; - } - return T_DOUNTIL; - } -{DOWHILE} { - if (g_cur) - { - g_cur->statement=stmt_DOcondition; - } - return T_DOWHILE; - } -"edit" { - if (g_cur) - { - g_cur->statement=stmt_EDIT; - } - return T_EDIT; - } -"else"|"el." { - if (g_cur) - { - g_cur->statement=stmt_ELSE_ELSEIFELSE; - } - return T_ELSE; - } -"else"/"if" { - BEGIN(ELSEIF); - if (g_cur) - { - g_cur->statement=stmt_ELSE_ELSEIFELSE; - } - return T_ELSEIFELSE; - } -"if" { - BEGIN(INITIAL); - if (g_cur) - { - g_cur->statement=stmt_IF_ELSEIFIF; - } - return T_ELSEIFIF; - } -end[ \t]+function { - if (g_cur) - { - g_cur->statement=stmt_ENDFN; - } - return T_ENDFN; - } -{ENDIF} { - if (g_cur) - { - g_cur->statement=stmt_ENDIF; - } - return T_ENDIF; - } -{ENDPROC} { - if (g_cur) - { - g_cur->statement=stmt_ENDPROC_SUBEND; - } - return T_ENDPROC; - } -{ENDSELECT} { - if (g_cur) - { - g_cur->statement=stmt_ENDSELECT; - } - return T_ENDSELECT; - } -"end"[ \t]*"sub" { - if (g_cur) - { - g_cur->statement=stmt_ENDPROC_SUBEND; - } - return T_SUBEND; - } -"end" { - if (g_cur) - { - g_cur->statement=stmt_END; - } - return T_END; - } -"environ" { - if (g_cur) - { - g_cur->statement=stmt_ENVIRON; - } - return T_ENVIRON; - } -"erase" { - if (g_cur) - { - g_cur->statement=stmt_ERASE; - } - return T_ERASE; - } -"eqv" return T_EQV; -{EXITDO} { - if (g_cur) - { - g_cur->statement=stmt_EXITDO; - } - return T_EXITDO; - } -{EXITFOR} { - if (g_cur) - { - g_cur->statement=stmt_EXITFOR; - } - return T_EXITFOR; - } -"exit"[ \t]+"function" { - if (g_cur) - { - g_cur->statement=stmt_FNEXIT; - } - return T_FNEXIT; - } -"exit"[ \t]+"sub" { - if (g_cur) - { - g_cur->statement=stmt_SUBEXIT; - } - return T_SUBEXIT; - } -"field" { - if (g_cur) - { - g_cur->statement=stmt_FIELD; - } - return T_FIELD; - } -"field"/"#" { - if (g_cur) - { - g_cur->statement=stmt_FIELD; - } - return T_FIELD; - } -"fnend" { - if (g_cur) - { - g_cur->statement=stmt_EQ_FNRETURN_FNEND; - } - return T_FNEND; - } -"fnreturn" { - if (g_cur) - { - g_cur->statement=stmt_EQ_FNRETURN_FNEND; - } - return T_FNRETURN; - } -"for" { - if (g_cur) - { - g_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 (g_cur) - { - g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; - g_cur->u.localSyms=(struct Symbol*)0; - } - return T_FUNCTION; - } -"get" { - if (g_cur) - { - g_cur->statement=stmt_GET_PUT; - } - return T_GET; - } -"get"/"#" { - if (g_cur) - { - g_cur->statement=stmt_GET_PUT; - } - return T_GET; - } -"go"[ \t]*"sub" { - if (g_cur) - { - g_cur->statement=stmt_GOSUB; - } - return T_GOSUB; - } -"go"[ \t]*"to" { - if (g_cur) - { - g_cur->statement=stmt_RESUME_GOTO; - } - return T_GOTO; - } -"idn" return T_IDN; -"if" { - if (g_cur) - { - g_cur->statement=stmt_IF_ELSEIFIF; - } - return T_IF; - } -"image"[ \t]*/[^"\n \t] { - BEGIN(IMAGEFMT); - if (g_cur) - { - g_cur->statement=stmt_IMAGE; - } - return T_IMAGE; - } -.*$ { - BEGIN(INITIAL); - if (g_cur) - { - size_t l; - - l=strlen(yytext); - g_cur->u.string=malloc(sizeof(struct String)); - String_size(String_new(g_cur->u.string),l); - memcpy(g_cur->u.string->character,yytext,l); - } - return T_STRING; - } -"image" { - if (g_cur) - { - g_cur->statement=stmt_IMAGE; - } - return T_IMAGE; - } -"imp" return T_IMP; -"inc" { - if (g_cur) - { - g_cur->statement=stmt_DEC_INC; - } - return T_INC; - } -"input" { - if (g_cur) - { - g_cur->statement=stmt_INPUT; - } - return T_INPUT; - } -"input"/"#" { - if (g_cur) - { - g_cur->statement=stmt_INPUT; - } - return T_INPUT; - } -"inv" return T_INV; -"is" return T_IS; -"kill" { - if (g_cur) - { - g_cur->statement=stmt_KILL; - } - return T_KILL; - } -"let" { - if (g_cur) - { - g_cur->statement=stmt_LET; - } - return T_LET; - } -"list" { - if (g_cur) - { - g_cur->statement=stmt_LIST_LLIST; - } - return T_LIST; - } -"llist" { - if (g_cur) - { - g_cur->statement=stmt_LIST_LLIST; - } - return T_LLIST; - } -"load" { - if (g_cur) - { - g_cur->statement=stmt_LOAD; - } - return T_LOAD; - } -"local" { - if (g_cur) - { - g_cur->statement=stmt_LOCAL; - } - return T_LOCAL; - } -"locate" { - if (g_cur) - { - g_cur->statement=stmt_LOCATE; - } - return T_LOCATE; - } -"lock" { - if (g_cur) - { - g_cur->statement=stmt_LOCK_UNLOCK; - } - return T_LOCK; - } -"lock"[ \t]+"read" return T_LOCK_READ; -"lock"[ \t]+"write" return T_LOCK_WRITE; -"loop" { - if (g_cur) - { - g_cur->statement=stmt_LOOP; - } - return T_LOOP; - } -{LOOPUNTIL} { - if (g_cur) - { - g_cur->statement=stmt_LOOPUNTIL; - } - return T_LOOPUNTIL; - } -"lprint" { - if (g_cur) - { - g_cur->statement=stmt_PRINT_LPRINT; - } - return T_LPRINT; - } -"lset" { - if (g_cur) - { - g_cur->statement=stmt_LSET_RSET; - } - return T_LSET; - } -"mat"[ \t]+"input" { - if (g_cur) - { - g_cur->statement=stmt_MATINPUT; - } - return T_MATINPUT; - } -"mat"[ \t]+"print" { - if (g_cur) - { - g_cur->statement=stmt_MATPRINT; - } - return T_MATPRINT; - } -"mat"[ \t]+"read" { - if (g_cur) - { - g_cur->statement=stmt_MATREAD; - } - return T_MATREAD; - } -"mat"[ \t]+"redim" { - if (g_cur) - { - g_cur->statement=stmt_MATREDIM; - } - return T_MATREDIM; - } -"mat"[ \t]+"write" { - if (g_cur) - { - g_cur->statement=stmt_MATWRITE; - } - return T_MATWRITE; - } -"mat" { - if (g_cur) - { - g_cur->statement=stmt_MAT; - } - return T_MAT; - } -"mkdir" { - if (g_cur) - { - g_cur->statement=stmt_CHDIR_MKDIR; - } - return T_MKDIR; - } -"mod" return T_MOD; -"new" { - if (g_cur) - { - g_cur->statement=stmt_NEW; - } - return T_NEW; - } -"name" { - if (g_cur) - { - g_cur->statement=stmt_NAME; - } - return T_NAME; - } -"next" { - if (g_cur) - { - g_cur->statement=stmt_NEXT; - g_cur->u.next=malloc(sizeof(struct Next)); - } - return T_NEXT; - } -"not" return T_NOT; -{ONERROROFF} { - if (g_cur) - { - g_cur->statement=stmt_ONERROROFF; - } - return T_ONERROROFF; - } -{ONERRORGOTO0} { - if (g_cur) - { - g_cur->statement=stmt_ONERRORGOTO0; - } - return T_ONERRORGOTO0; - } -{ONERROR} { - if (g_cur) - { - g_cur->statement=stmt_ONERROR; - } - return T_ONERROR; - } -"on" { - if (g_cur) - { - g_cur->statement=stmt_ON; - g_cur->u.on.pcLength=1; - g_cur->u.on.pc=(struct Pc*)0; - } - return T_ON; - } -"open" { - if (g_cur) - { - g_cur->statement=stmt_OPEN; - } - return T_OPEN; - } -"option"[ \t]+"base" { - if (g_cur) - { - g_cur->statement=stmt_OPTIONBASE; - } - return T_OPTIONBASE; - } -"option"[ \t]+"run" { - if (g_cur) - { - g_cur->statement=stmt_OPTIONRUN; - } - return T_OPTIONRUN; - } -"option"[ \t]+"stop" { - if (g_cur) - { - g_cur->statement=stmt_OPTIONSTOP; - } - return T_OPTIONSTOP; - } -"or" return T_OR; -"out" { - if (g_cur) - { - g_cur->statement=stmt_OUT_POKE; - } - return T_OUT; - } -"print"|"p."|"?" { - if (g_cur) - { - g_cur->statement=stmt_PRINT_LPRINT; - } - return T_PRINT; - } -("print"|"p."|"?")/"#" { - if (g_cur) - { - g_cur->statement=stmt_PRINT_LPRINT; - } - return T_PRINT; - } -"poke" { - if (g_cur) - { - g_cur->statement=stmt_OUT_POKE; - } - return T_POKE; - } -"put" { - if (g_cur) - { - g_cur->statement=stmt_GET_PUT; - } - return T_PUT; - } -"put"/"#" { - if (g_cur) - { - g_cur->statement=stmt_GET_PUT; - } - return T_PUT; - } -"randomize" { - if (g_cur) - { - g_cur->statement=stmt_RANDOMIZE; - } - return T_RANDOMIZE; - } -"read" { - if (g_cur) - { - g_cur->statement=stmt_READ; - } - return T_READ; - } -"renum"|"ren." { - if (g_cur) - { - g_cur->statement=stmt_RENUM; - } - return T_RENUM; - } -"repeat"|"rep." { - if (g_cur) - { - g_cur->statement=stmt_REPEAT; - } - return T_REPEAT; - } -"restore"|"res." { - if (g_cur) - { - g_cur->statement=stmt_RESTORE; - } - return T_RESTORE; - } -"resume" { - if (g_cur) - { - g_cur->statement=stmt_RESUME_GOTO; - } - return T_RESUME; - } -"return"|"r." { - if (g_cur) - { - g_cur->statement=stmt_RETURN; - } - return T_RETURN; - } -"rset" { - if (g_cur) - { - g_cur->statement=stmt_LSET_RSET; - } - return T_RSET; - } -"run" { - if (g_cur) - { - g_cur->statement=stmt_RUN; - } - return T_RUN; - } -"save" { - if (g_cur) - { - g_cur->statement=stmt_SAVE; - } - return T_SAVE; - } -{SELECTCASE} { - if (g_cur) - { - g_cur->statement=stmt_SELECTCASE; - g_cur->u.selectcase=malloc(sizeof(struct Selectcase)); - } - return T_SELECTCASE; - } -"shared" return T_SHARED; -"shell" { - if (g_cur) - { - g_cur->statement=stmt_SHELL; - } - return T_SHELL; - } -"sleep" { - if (g_cur) - { - g_cur->statement=stmt_SLEEP; - } - return T_SLEEP; - } -"spc" return T_SPC; -"step" return T_STEP; -"stop" { - if (g_cur) - { - g_cur->statement=stmt_STOP; - } - return T_STOP; - } -"sub"[ \t]*"end" { - if (g_cur) - { - g_cur->statement=stmt_ENDPROC_SUBEND; - } - return T_SUBEND; - } -"sub"[ \t]*"exit" { - if (g_cur) - { - g_cur->statement=stmt_SUBEXIT; - } - return T_SUBEXIT; - } -"sub" { - if (g_cur) - { - g_cur->statement=stmt_DEFFN_DEFPROC_FUNCTION_SUB; - g_cur->u.localSyms=(struct Symbol*)0; - } - return T_SUB; - } -"swap" { - if (g_cur) - { - g_cur->statement=stmt_SWAP; - } - return T_SWAP; - } -"system"|"bye" { - if (g_cur) - { - g_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 (g_cur) - { - g_cur->statement=stmt_TROFF; - } - return T_TROFF; - } -"tron" { - if (g_cur) - { - g_cur->statement=stmt_TRON; - } - return T_TRON; - } -"truncate" { - if (g_cur) - { - g_cur->statement=stmt_TRUNCATE; - } - return T_TRUNCATE; - } -"unlock" { - if (g_cur) - { - g_cur->statement=stmt_LOCK_UNLOCK; - } - return T_UNLOCK; - } -"unnum" { - if (g_cur) - { - g_cur->statement=stmt_UNNUM; - } - return T_UNNUM; - } -"until" { - if (g_cur) - { - g_cur->statement=stmt_UNTIL; - } - return T_UNTIL; - } -"using" return T_USING; -"wait" { - if (g_cur) - { - g_cur->statement=stmt_WAIT; - } - return T_WAIT; - } -"wend" { - if (g_cur) - { - g_cur->statement=stmt_WEND; - g_cur->u.whilepc=malloc(sizeof(struct Pc)); - } - return T_WEND; - } -"while" { - if (g_cur) - { - g_cur->statement=stmt_WHILE; - g_cur->u.afterwend=malloc(sizeof(struct Pc)); - } - return T_WHILE; - } -"width" { - if (g_cur) - { - g_cur->statement=stmt_WIDTH; - } - return T_WIDTH; - } -"width"/"#" { - if (g_cur) - { - g_cur->statement=stmt_WIDTH; - } - return T_WIDTH; - } -"write" { - if (g_cur) - { - g_cur->statement=stmt_WRITE; - } - return T_WRITE; - } -"write"/"#" { - if (g_cur) - { - g_cur->statement=stmt_WRITE; - } - return T_WRITE; - } -"xor" return T_XOR; -"xref" { - if (g_cur) - { - g_cur->statement=stmt_XREF; - } - return T_XREF; - } -"zer" return T_ZER; -"zone" { - if (g_cur) - { - g_cur->statement=stmt_ZONE; - } - return T_ZONE; - } -{REM} { - if (g_cur) - { - g_cur->statement=stmt_QUOTE_REM; - g_cur->u.rem=strcpy(malloc(strlen(yytext+3)+1),yytext+3); - } - return T_REM; - } -"rename" { - if (g_cur) - { - g_cur->statement=stmt_COPY_RENAME; - } - return T_RENAME; - } -{QUOTE} { - if (g_cur) - { - g_cur->statement=stmt_QUOTE_REM; - strcpy(g_cur->u.rem=malloc(strlen(yytext+1)+1),yytext+1); - } - return T_QUOTE; - } -{LINEINPUT} { - if (g_cur) - { - g_cur->statement=stmt_LINEINPUT; - } - return T_LINEINPUT; - } -{IDENTIFIER} { - if (g_cur) - { - size_t len; - char *s; - int fn; - - g_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); - g_cur->u.identifier=malloc(offsetof(struct Identifier,name)+len+1); - if (fn) - { - memcpy(g_cur->u.identifier->name,yytext,2); - strcpy(g_cur->u.identifier->name+2,s); - } - else - { - strcpy(g_cur->u.identifier->name,s); - } - switch (yytext[yyleng-1]) - { - case '$': g_cur->u.identifier->defaultType=V_STRING; break; - case '%': g_cur->u.identifier->defaultType=V_INTEGER; break; - default: g_cur->u.identifier->defaultType=V_REAL; break; - } - } - return T_IDENTIFIER; - } -[ \t\n]+ -. { - if (g_cur) g_cur->u.junk=yytext[0]; - return T_JUNK; - } - /*}}}*/ -%% - -int g_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; - - g_cur=(struct Token*)0; - buf=yy_scan_string(ln); - /* determine number of tokens */ /*{{{*/ - g_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); - g_cur=result=malloc(sizeof(struct Token)*l); - if (addNumber) - { - g_cur->type=T_UNNUMBERED; - ++g_cur; - } - buf=yy_scan_string(ln); - lasttok=T_EOL; - g_matchdata=sawif=0; - while (g_cur->statement=NULL,(g_cur->type=yylex())) - { - if (g_cur->type==T_IF) sawif=1; - if (g_cur->type==T_THEN) sawif=0; - if (g_cur->type==T_GOTO && sawif) - { - sawif=0; - *(g_cur+1)=*g_cur; - g_cur->type=T_THEN; - lasttok=T_GOTO; - g_cur+=2; - } - else if ((lasttok==T_THEN || lasttok==T_ELSE) && g_cur->type==T_INTEGER) - { - *(g_cur+1)=*g_cur; - g_cur->type=T_GOTO; - g_cur->statement=stmt_RESUME_GOTO; - lasttok=T_INTEGER; - g_cur+=2; - } - else - { - lasttok=g_cur->type; - ++g_cur; - } - } - g_cur->type=T_EOL; - g_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; - - g_cur=(struct Token*)0; - buf=yy_scan_string(ln); - g_matchdata=1; - for (l=1; yylex(); ++l); - yy_delete_buffer(buf); - g_cur=result=malloc(sizeof(struct Token)*l); - buf=yy_scan_string(ln); - g_matchdata=1; - while (g_cur->statement=NULL,(g_cur->type=yylex())) ++g_cur; - g_cur->type=T_EOL; - g_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",g_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 (g_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) \ - g_token_property[t]=(assoc<<8)|(unary_priority<<5)|(binary_priority<<2)|(is_unary<<1)|is_binary - - g_backslash_colon=b_c; - g_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 deleted file mode 100644 index db2ed1130..000000000 --- a/apps/interpreters/bas/value.c +++ /dev/null @@ -1,2098 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#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 deleted file mode 100644 index 56e62a01e..000000000 --- a/apps/interpreters/bas/value.h +++ /dev/null @@ -1,182 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index f0fb934b9..000000000 --- a/apps/interpreters/bas/var.c +++ /dev/null @@ -1,717 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 - -#include -#include -#include - -#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 deleted file mode 100644 index afec8ba95..000000000 --- a/apps/interpreters/bas/var.h +++ /dev/null @@ -1,115 +0,0 @@ -/**************************************************************************** - * 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 - * Gregory Nutt - * - * 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 deleted file mode 100644 index ec151e2d9..000000000 --- a/apps/interpreters/bas/vt100.c +++ /dev/null @@ -1,367 +0,0 @@ -/**************************************************************************** - * apps/interpreters/bas/vt100.c - * - * Copyright (C) 2014 Gregory Nutt. All rights reserved. - * Author: Gregory Nutt - * - * 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 - -#include -#include - -#include - -#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; -#endif -static const char g_cursorhome[] = VT100_CURSORHOME; -#if 0 /* Not used */ -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_fmt_cursorpos[] = VT100_FMT_CURSORPOS; -static const char g_fmt_forecolor[] = VT100_FMT_FORE_COLOR; -static const char g_fmt_backcolor[] = VT100_FMT_BACK_COLOR; - -/**************************************************************************** - * 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 - * - ****************************************************************************/ - -void vt100_cursorhome(int chn) -{ - /* Send the VT100 CURSORHOME command */ - - vt100_write(chn, g_cursorhome, sizeof(g_cursorhome)); -} - -/**************************************************************************** - * 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_fmt_cursorpos, 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 - -/**************************************************************************** - * Name: vt100_foreground_color - * - * Description: - * Set the foreground color - * - ****************************************************************************/ - -void vt100_foreground_color(int chn, uint8_t color) -{ - char buffer[16]; - int len; - - /* Format the foreground color command. */ - - DEBUGASSERT(color < 10); - len = snprintf(buffer, 16, g_fmt_forecolor, color); - - /* Send the VT100 foreground color command */ - - vt100_write(chn, buffer, len); -} - -/**************************************************************************** - * Name: vt100_background_color - * - * Description: - * Set the background color - * - ****************************************************************************/ - -void vt100_background_color(int chn, uint8_t color) -{ - char buffer[16]; - int len; - - /* Format the background color command. */ - - DEBUGASSERT(color < 10); - len = snprintf(buffer, 16, g_fmt_backcolor, color); - - /* Send the VT100 background color command */ - - vt100_write(chn, buffer, len); -} diff --git a/apps/interpreters/bas/vt100.h b/apps/interpreters/bas/vt100.h deleted file mode 100644 index 563b96b14..000000000 --- a/apps/interpreters/bas/vt100.h +++ /dev/null @@ -1,235 +0,0 @@ -/**************************************************************************** - * apps/interpreters/bas/vt100.h - * - * Copyright (C) 2014 Gregory Nutt. All rights reserved. - * Author: Gregory Nutt - * - * 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 - -#include - -/**************************************************************************** - * 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 - * - ****************************************************************************/ - -void vt100_cursorhome(int chn); - -/**************************************************************************** - * 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 - -/**************************************************************************** - * Name: vt100_foreground_color - * - * Description: - * Set the foreground color - * - ****************************************************************************/ - -void vt100_foreground_color(int chn, uint8_t color); - -/**************************************************************************** - * Name: vt100_background_color - * - * Description: - * Set the background color - * - ****************************************************************************/ - -void vt100_background_color(int chn, uint8_t color); - -#undef EXTERN -#ifdef __cplusplus -} -#endif - -#endif /* __APPS_INTERPRETERS_BAS_VT100_H */ -- cgit v1.2.3