diff --git a/interpreters/bas/Makefile b/interpreters/bas/Makefile index 7cc1c0af3..9382ddfc5 100644 --- a/interpreters/bas/Makefile +++ b/interpreters/bas/Makefile @@ -39,12 +39,8 @@ include $(APPDIR)/Make.defs # BAS Library -ASRCS = -CSRCS = - -ifeq ($(CONFIG_INTERPRETERS_BAS),y) - -CSRCS += auto.c bas.c fs.c global.c main.c program.c str.c token.c value.c +ASRCS = +CSRCS = auto.c bas.c fs.c global.c main.c program.c str.c token.c value.c CSRCS += var.c DEPPATH = --dep-path . @@ -54,8 +50,6 @@ ifeq ($(WINTOOL),y) INCDIROPT = -w endif -endif - AOBJS = $(ASRCS:.S=$(OBJEXT)) COBJS = $(CSRCS:.c=$(OBJEXT)) @@ -118,6 +112,4 @@ distclean: clean $(call DELFILE, Make.dep) $(call DELFILE, .depend) - -include Make.dep - diff --git a/interpreters/bas/fs.c b/interpreters/bas/fs.c index 6fd731c20..229a9119d 100644 --- a/interpreters/bas/fs.c +++ b/interpreters/bas/fs.c @@ -1,5 +1,5 @@ /**************************************************************************** - * apps/examples/interpreters/bas/value.c + * apps/examples/interpreters/bas/fs.c * BASIC file system interface. * * Copyright (c) 1999-2014 Michael Haardt @@ -78,8 +78,6 @@ #include #include -#include - #include "fs.h" /**************************************************************************** @@ -281,68 +279,32 @@ static int edit(int chn, int onl) return -1; } - /* Check for the backspace charactor */ - - if (ch == ASCII_BS) - { - if (f->inCapacity) - { #ifdef CONFIG_INTERPREPTER_BAS_VT100 - /* REVISIT: Use VT100 commands to erase: Move cursor back and erase to the end of the line */ + /* REVISIT: Use VT100 commands to erase */ #warning Missing Logic #else - /* Use backspace to erase */ - - if (f->inBuf[f->inCapacity - 1] >= '\0' && - f->inBuf[f->inCapacity - 1] < ' ') - { - FS_putChars(chn, "\b\b \b\b"); - } - else - { - FS_putChars(chn, "\b \b"); - } -#endif - --f->inCapacity; - } - } - - /* Is there space for another character in the buffer? */ - - else if ((f->inCapacity + 1) < sizeof(f->inBuf)) + if ((f->inCapacity + 1) < sizeof(f->inBuf)) { - /* Yes.. Was this a new line character? */ - if (ch != '\n') { - /* No.. was this an ASCII control character? */ - if (ch >= '\0' && ch < ' ') { - /* Yes.. Echo control characters as escape sequences */ - FS_putChar(chn, '^'); FS_putChar(chn, ch ? (ch + 'a' - 1) : '@'); } else { - /* No.. Just echo the character */ - FS_putChar(chn, ch); } } - - /* Should we echo newline characters? */ - else if (onl) { FS_putChar(chn, '\n'); } - /* Put the raw character into the buffer in any event */ - f->inBuf[f->inCapacity++] = ch; } +#endif } while (ch != '\n'); diff --git a/interpreters/bas/global.c b/interpreters/bas/global.c index 7a3dd00e2..1ea00d3f7 100644 --- a/interpreters/bas/global.c +++ b/interpreters/bas/global.c @@ -1,4 +1,65 @@ -/* Global variables and functions. */ +/**************************************************************************** + * apps/examples/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 @@ -23,10 +84,13 @@ #include +/**************************************************************************** + * Pre-processor Definitions + ****************************************************************************/ + #ifndef M_PI -#define M_PI 3.14159265358979323846 +# define M_PI 3.14159265358979323846 #endif -/*}}}*/ #ifndef RAND_MAX # define RAND_MAX 32767 @@ -34,1748 +98,2369 @@ #define _(String) String -static int wildcardmatch(const char *a, const char *pattern) /*{{{*/ +/**************************************************************************** + * 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'); -} -/*}}}*/ + switch (*pattern) + { + case '*': + { + ++pattern; + while (*a) + if (wildcardmatch(a, pattern)) + { + return 1; + } + else + { + ++a; + } -static long int intValue(struct Auto *stack, int l) /*{{{*/ + 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); + 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) /*{{{*/ + +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); + 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) /*{{{*/ + +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); + 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) /*{{{*/ +static struct Value *bin(struct Value *v, unsigned long int value, + long int digits) { - char buf[sizeof(long int)*8+1]; + 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]; + s = buf + sizeof(buf); + *--s = '\0'; + if (digits == 0) + { + digits = 1; + } - sprintf(buf,"%0*lx",(int)digits,value); - Value_new_STRING(v); - String_appendChars(&v->u.string,buf); + while (digits || value) + { + *--s = value & 1 ? '1' : '0'; + if (digits) + { + --digits; + } + + value >>= 1; + } + + String_appendChars(&v->u.string, s); return v; } -/*}}}*/ -static struct Value *find(struct Value *v, struct String *pattern, long int occurence) /*{{{*/ + +static struct Value *hex(struct Value *v, long int value, long int digits) { - struct String dirname,basename; + 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; + 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) + String_appendString(&dirname, pattern); + while (dirname.length > 0 && dirname.character[dirname.length - 1] == '/') { - 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; - } + String_delete(&dirname, dirname.length - 1, 1); } - closedir(dir); - } + + 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) /*{{{*/ + +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; + 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); + 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) /*{{{*/ + +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")); + 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); + 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) /*{{{*/ + +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; - } + 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); + 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) /*{{{*/ + +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); - } + 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; - } + { + 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")); +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); - } + 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) /*{{{*/ + +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; iu.string,environ[i]); + if (i == n && environ[i]) + { + String_appendChars(&v->u.string, environ[i]); + } + return v; } -/*}}}*/ -static struct Value *rnd(struct Value *v, long int x) /*{{{*/ + +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); + 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) /*{{{*/ +static struct Value *fn_abs(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,fabs(realValue(stack,0))); + 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) /*{{{*/ +static struct Value *fn_asc(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,atan(realValue(stack,0))); + 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_bini(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_atn(struct Value *v, struct Auto *stack) { - return bin(v,intValue(stack,0),0); + return Value_new_REAL(v, atan(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_bind(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_binii(struct Value *v, struct Auto *stack) { - return bin(v,intValue(stack,0),intValue(stack,1)); + return bin(v, intValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_bindi(struct Value *v, struct Auto *stack) /*{{{*/ + +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)); + 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) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_bindd(struct Value *v, struct Auto *stack) { int overflow; - long int n,digits; + 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); + 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")); +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; + 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) /*{{{*/ + +static struct Value *fn_cint(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,ceil(realValue(stack,0))); + return Value_new_REAL(v, ceil(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_cos(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_cos(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,cos(realValue(stack,0))); + return Value_new_REAL(v, cos(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_command(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_command(struct Value *v, struct Auto *stack) { int i; Value_new_STRING(v); - for (i=0; iu.string,' '); - String_appendChars(&v->u.string,bas_argv[i]); - } + for (i = 0; i < bas_argc; ++i) + { + if (i) + { + String_appendChar(&v->u.string, ' '); + } + + String_appendChars(&v->u.string, bas_argv[i]); + } + return v; } -/*}}}*/ -static struct Value *fn_commandi(struct Value *v, struct Auto *stack) /*{{{*/ + +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")); + a = intValue(stack, 0); + if (a < 0) + { + return Value_new_ERROR(v, OUTOFRANGE, _("argument number")); + } + Value_new_STRING(v); - if (a==0) - { - if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0); - } - else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]); + if (a == 0) + { + if (bas_argv0 != (char *)0) + { + String_appendChars(&v->u.string, bas_argv0); + } + } + else if (a <= bas_argc) + { + String_appendChars(&v->u.string, bas_argv[a - 1]); + } + return v; } -/*}}}*/ -static struct Value *fn_commandd(struct Value *v, struct Auto *stack) /*{{{*/ + +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")); + a = Value_toi(realValue(stack, 0), &overflow); + if (overflow || a < 0) + { + return Value_new_ERROR(v, OUTOFRANGE, _("argument number")); + } + Value_new_STRING(v); - if (a==0) - { - if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0); - } - else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]); + if (a == 0) + { + if (bas_argv0 != (char *)0) + { + String_appendChars(&v->u.string, bas_argv0); + } + } + else if (a <= bas_argc) + { + String_appendChars(&v->u.string, bas_argv[a - 1]); + } + return v; } -/*}}}*/ -static struct Value *fn_cvi(struct Value *v, struct Auto *stack) /*{{{*/ + +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; + 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); + 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) /*{{{*/ + +static struct Value *fn_cvs(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); + 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); + 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) /*{{{*/ + +static struct Value *fn_cvd(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); + 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); + 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) /*{{{*/ + +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); + 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); + 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) /*{{{*/ + +static struct Value *fn_dec(struct Value *v, struct Auto *stack) { - struct Value value,*arg; + 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); + 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) /*{{{*/ + +static struct Value *fn_deg(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,realValue(stack,0)*(180.0/M_PI)); + return Value_new_REAL(v, realValue(stack, 0) * (180.0 / M_PI)); } -/*}}}*/ -static struct Value *fn_det(struct Value *v, struct Auto *stack) /*{{{*/ + +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)); + 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) /*{{{*/ + +static struct Value *fn_edit(struct Value *v, struct Auto *stack) { int code; - char *begin,*end,*rd,*wr; + char *begin, *end, *rd, *wr; char quote; - code=intValue(stack,1); + 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; + 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 begin) { - quote=*rd; - *wr++=*rd++; - while (rd begin && (*(wr - 1) == '\0' || *(wr - 1) == '\t')) + { + --wr; + } } - *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); + String_size(&v->u.string, wr - begin); return v; } -/*}}}*/ -static struct Value *fn_environi(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_environi(struct Value *v, struct Auto *stack) { - return env(v,intValue(stack,0)); + return env(v, intValue(stack, 0)); } -/*}}}*/ -static struct Value *fn_environd(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +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 ((var = stringValue(stack, 0)->character)) + { + char *val = getenv(var); + + if (val) + { + String_appendChars(&v->u.string, val); + } + } - 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) /*{{{*/ +static struct Value *fn_eof(struct Value *v, struct Auto *stack) { - return Value_new_INTEGER(v,stack->erl); + 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_err(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_erl(struct Value *v, struct Auto *stack) { - return Value_new_INTEGER(v,stack->err.type==V_NIL?0:stack->err.u.error.code); + return Value_new_INTEGER(v, stack->erl); } -/*}}}*/ -static struct Value *fn_exp(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_err(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,exp(realValue(stack,0))); + return Value_new_INTEGER(v, + stack->err.type == + V_NIL ? 0 : stack->err.u.error.code); } -/*}}}*/ -static struct Value *fn_false(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_exp(struct Value *v, struct Auto *stack) { - return Value_new_INTEGER(v,0); + return Value_new_REAL(v, exp(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_find(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_false(struct Value *v, struct Auto *stack) { - return find(v,stringValue(stack,0),0); + return Value_new_INTEGER(v, 0); } -/*}}}*/ -static struct Value *fn_findi(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_find(struct Value *v, struct Auto *stack) { - return find(v,stringValue(stack,0),intValue(stack,1)); + return find(v, stringValue(stack, 0), 0); } -/*}}}*/ -static struct Value *fn_findd(struct Value *v, struct Auto *stack) /*{{{*/ + +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]; + n = Value_toi(realValue(stack, 1), &overflow); + if (overflow) + { + return Value_new_ERROR(v, OUTOFRANGE, _("number")); + } - sprintf(buf,"%lx",intValue(stack,0)); + 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); + String_appendChars(&v->u.string, buf); return v; } -/*}}}*/ -static struct Value *fn_hexd(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_hexd(struct Value *v, struct Auto *stack) { - char buf[sizeof(long int)*2+1]; + 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); + 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); + String_appendChars(&v->u.string, buf); return v; } -/*}}}*/ -static struct Value *fn_hexii(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_hexii(struct Value *v, struct Auto *stack) { - return hex(v,intValue(stack,0),intValue(stack,1)); + return hex(v, intValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_hexdi(struct Value *v, struct Auto *stack) /*{{{*/ + +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)); + 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) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_hexdd(struct Value *v, struct Auto *stack) { int overflow; - long int n,digits; + 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); + 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) /*{{{*/ + +static struct Value *fn_int(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,floor(realValue(stack,0))); + return Value_new_REAL(v, floor(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_intp(struct Value *v, struct Auto *stack) /*{{{*/ + +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)); + errno = 0; + l = lrint(floor(realValue(stack, 0))); + if (errno == EDOM) + { + return Value_new_ERROR(v, OUTOFRANGE, _("number")); + } - if (r==-1) - { - return Value_new_ERROR(v,IOERROR,FS_errmsg); - } - else return Value_new_INTEGER(v,r); + return Value_new_INTEGER(v, l); } -/*}}}*/ -static struct Value *fn_input1(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_inp(struct Value *v, struct Auto *stack) { - return input(v,intValue(stack,0),STDCHANNEL); + 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_input2(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_input1(struct Value *v, struct Auto *stack) { - return input(v,intValue(stack,0),intValue(stack,1)); + return input(v, intValue(stack, 0), STDCHANNEL); } -/*}}}*/ -static struct Value *fn_inkey(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_input2(struct Value *v, struct Auto *stack) { - return inkey(v,0,STDCHANNEL); + return input(v, intValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_inkeyi(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_inkey(struct Value *v, struct Auto *stack) { - return inkey(v,intValue(stack,0),STDCHANNEL); + return inkey(v, 0, STDCHANNEL); } -/*}}}*/ -static struct Value *fn_inkeyd(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_inkeyii(struct Value *v, struct Auto *stack) { - return inkey(v,intValue(stack,0),intValue(stack,1)); + return inkey(v, intValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_inkeyid(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_inkeydi(struct Value *v, struct Auto *stack) { - return inkey(v,realValue(stack,0),intValue(stack,1)); + return inkey(v, realValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack) { int overflow; - long int t,chn; + 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")); + t = Value_toi(realValue(stack, 0), &overflow); + if (overflow) + { + return Value_new_ERROR(v, OUTOFRANGE, _("time")); + } - return inkey(v,t,chn); + 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) /*{{{*/ + +static struct Value *fn_instr2(struct Value *v, struct Auto *stack) { - struct String *haystack=stringValue(stack,0); + struct String *haystack = stringValue(stack, 0); - return instr(v,1,haystack->length,haystack,stringValue(stack,1)); + return instr(v, 1, haystack->length, haystack, stringValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack) { - struct String *haystack=stringValue(stack,1); + struct String *haystack = stringValue(stack, 1); - return instr(v,intValue(stack,0),haystack->length,haystack,stringValue(stack,2)); + return instr(v, intValue(stack, 0), haystack->length, haystack, + stringValue(stack, 2)); } -/*}}}*/ -static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack) { - struct String *haystack=stringValue(stack,0); + struct String *haystack = stringValue(stack, 0); - return instr(v,intValue(stack,2),haystack->length,haystack,stringValue(stack,1)); + return instr(v, intValue(stack, 2), haystack->length, haystack, + stringValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_instr3dss(struct Value *v, struct Auto *stack) /*{{{*/ + +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)); + 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) /*{{{*/ + +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)); + 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) /*{{{*/ + +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)); + 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) /*{{{*/ + +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)); + 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) /*{{{*/ + +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)); + 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) /*{{{*/ + +static struct Value *fn_instr4dd(struct Value *v, struct Auto *stack) { int overflow; - long int start,len; + 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)); + 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) /*{{{*/ + +static struct Value *fn_lcase(struct Value *v, struct Auto *stack) { Value_new_STRING(v); - String_appendString(&v->u.string,stringValue(stack,0)); + 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)length ? len : s->length; - if (left<0) return Value_new_ERROR(v,OUTOFRANGE,_("length")); +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)); + String_size(&v->u.string, left); + if (left) + { + memcpy(v->u.string.character, s->character, left); + } - if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg); - return Value_new_INTEGER(v,l); + return v; } -/*}}}*/ -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) /*{{{*/ +static struct Value *fn_loc(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))); + 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) /*{{{*/ + +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))); + 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) /*{{{*/ + +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))); + 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) /*{{{*/ + +static struct Value *fn_ltrim(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); - int len=s->length; + struct String *s = stringValue(stack, 0); + int len = s->length; int spaces; - for (spaces=0; spacescharacter[spaces]==' '; ++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); + 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) /*{{{*/ + +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); + 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; + 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; ny?x:y); + 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_maxdi(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +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); + 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) /*{{{*/ +static struct Value *fn_maxdd(struct Value *v, struct Auto *stack) { - return mid(v,stringValue(stack,0),intValue(stack,1),stringValue(stack,0)->length); + double x, y; + + x = realValue(stack, 0); + y = realValue(stack, 1); + return Value_new_REAL(v, x > y ? x : y); } -/*}}}*/ -static struct Value *fn_mid2d(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_mid3ii(struct Value *v, struct Auto *stack) { - return mid(v,stringValue(stack,0),intValue(stack,1),intValue(stack,2)); + return mid(v, stringValue(stack, 0), intValue(stack, 1), intValue(stack, 2)); } -/*}}}*/ -static struct Value *fn_mid3id(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +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")); + 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)); + return mid(v, stringValue(stack, 0), start, intValue(stack, 2)); } -/*}}}*/ -static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack) { int overflow; - long int start,len; + 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); + 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) /*{{{*/ + +static struct Value *fn_minii(struct Value *v, struct Auto *stack) { - long int x,y; + long int x, y; - x=intValue(stack,0); - y=intValue(stack,1); - return Value_new_INTEGER(v,xu.string,sizeof(long int)); - for (i=0; i>=8) v->u.string.character[i]=(x&0xff); + 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) /*{{{*/ + +static struct Value *fn_mks(struct Value *v, struct Auto *stack) { - float x=realValue(stack,0); + float x = realValue(stack, 0); Value_new_STRING(v); - String_size(&v->u.string,sizeof(float)); - memcpy(v->u.string.character,&x,sizeof(float)); + 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) /*{{{*/ + +static struct Value *fn_mkd(struct Value *v, struct Auto *stack) { - double x=realValue(stack,0); + double x = realValue(stack, 0); Value_new_STRING(v); - String_size(&v->u.string,sizeof(double)); - memcpy(v->u.string.character,&x,sizeof(double)); + 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) /*{{{*/ +static struct Value *fn_oct(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)); + char buf[sizeof(long int) * 3 + 1]; - 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)u.string,right); - if (right) memcpy(v->u.string.character,s->character+len-right,right); + String_appendChars(&v->u.string, buf); return v; } -/*}}}*/ -static struct Value *fn_rnd(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_pi(struct Value *v, struct Auto *stack) { - return rnd(v,0); + return Value_new_REAL(v, M_PI); } -/*}}}*/ -static struct Value *fn_rndi(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_peek(struct Value *v, struct Auto *stack) { - return rnd(v,intValue(stack,0)); + 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_rndd(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_rtrim(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); - int len=s->length; + 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); + for (lastSpace = len; lastSpace > 0 && s->character[lastSpace - 1] == ' '; + --lastSpace); - 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); + String_size(&v->u.string, lastSpace); + if (lastSpace) + { + memcpy(v->u.string.character, s->character, lastSpace); + } + return v; } -/*}}}*/ -static struct Value *fn_sqr(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_sgn(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))); + 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_str(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_sqr(struct Value *v, struct Auto *stack) { - struct Value value,*arg; + 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); + 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; + 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) /*{{{*/ + +static struct Value *fn_stringii(struct Value *v, struct Auto *stack) { - return string(v,intValue(stack,0),intValue(stack,1)); + return string(v, intValue(stack, 0), intValue(stack, 1)); } -/*}}}*/ -static struct Value *fn_stringid(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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) /*{{{*/ + +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)); + 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) /*{{{*/ + +static struct Value *fn_stringdd(struct Value *v, struct Auto *stack) { int overflow; - long int len,chr; + 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); + 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) /*{{{*/ + +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")); + 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]); + return string(v, intValue(stack, 0), stringValue(stack, 1)->character[0]); } -/*}}}*/ -static struct Value *fn_stringds(struct Value *v, struct Auto *stack) /*{{{*/ + +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]); + 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) /*{{{*/ + +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; iu.string.length; ++i) v->u.string.character[i]&=0x7f; + 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) /*{{{*/ + +static struct Value *fn_tan(struct Value *v, struct Auto *stack) { - return Value_new_REAL(v,tan(realValue(stack,0))); + return Value_new_REAL(v, tan(realValue(stack, 0))); } -/*}}}*/ -static struct Value *fn_timei(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_timei(struct Value *v, struct Auto *stack) { - return Value_new_INTEGER(v,(unsigned long)(clock_systimer()/(CLK_TCK/100.0))); + return Value_new_INTEGER(v, + (unsigned long)(clock_systimer() / + (CLK_TCK / 100.0))); } -/*}}}*/ -static struct Value *fn_times(struct Value *v, struct Auto *stack) /*{{{*/ + +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); + 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); + 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) /*{{{*/ + +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); + 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) /*{{{*/ + +static struct Value *fn_tl(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); + struct String *s = stringValue(stack, 0); Value_new_STRING(v); if (s->length) - { - int tail=s->length-1; + { + int tail = s->length - 1; - String_size(&v->u.string,tail); - if (s->length) memcpy(v->u.string.character,s->character+1,tail); - } + 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) /*{{{*/ + +static struct Value *fn_true(struct Value *v, struct Auto *stack) { - return Value_new_INTEGER(v,-1); + return Value_new_INTEGER(v, -1); } -/*}}}*/ -static struct Value *fn_ucase(struct Value *v, struct Auto *stack) /*{{{*/ + +static struct Value *fn_ucase(struct Value *v, struct Auto *stack) { Value_new_STRING(v); - String_appendString(&v->u.string,stringValue(stack,0)); + 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) /*{{{*/ + +static struct Value *fn_val(struct Value *v, struct Auto *stack) { - struct String *s=stringValue(stack,0); + 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)); -} -/*}}}*/ + if (s->character == (char *)0) + { + return Value_new_REAL(v, 0.0); + } -static unsigned int hash(const char *s) /*{{{*/ + 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; + unsigned int h = 0; while (*s) - { - h=h*256+tolower(*s); - ++s; - } - return h%GLOBAL_HASHSIZE; + { + 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, ...) /*{{{*/ + +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; + 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; iu.sub.argTypes[i]=va_arg(ap,enum ValueType); - } - va_end(ap); - s->u.sub.u.bltin.call=func; -} -/*}}}*/ + for (r = &this->table[hash(ident)]; + *r != (struct Symbol *)0 && cistrcmp((*r)->name, ident); + r = &((*r)->next)); -struct Global *Global_new(struct Global *this) /*{{{*/ + if (*r == (struct Symbol *)0) + { + *r = malloc(sizeof(struct Symbol)); + (*r)->name = strcpy(malloc(strlen(ident) + 1), ident); + (*r)->next = (struct Symbol *)0; + s = (*r); + } + else + { + for (sptr = &((*r)->u.sub.u.bltin.next); *sptr; + sptr = &((*sptr)->u.sub.u.bltin.next)); + + *sptr = s = malloc(sizeof(struct Symbol)); + } + + s->u.sub.u.bltin.next = (struct Symbol *)0; + s->type = BUILTINFUNCTION; + s->u.sub.argLength = argLength; + s->u.sub.argTypes = + argLength ? malloc(sizeof(enum ValueType) * + argLength) : (enum ValueType *)0; + s->u.sub.retType = type; + va_start(ap, argLength); + for (i = 0; i < argLength; ++i) + { + s->u.sub.argTypes[i] = va_arg(ap, enum ValueType); + } + + va_end(ap); + s->u.sub.u.bltin.call = func; +} + +/**************************************************************************** + * Public Functions + ****************************************************************************/ + +struct Global *Global_new(struct Global *this) { - builtin(this,"abs", V_REAL, fn_abs, 1,V_REAL); - builtin(this,"asc", V_INTEGER,fn_asc, 1,V_STRING); - builtin(this,"atn", V_REAL, fn_atn, 1,V_REAL); - builtin(this,"bin$", V_STRING, fn_bini, 1,V_INTEGER); - builtin(this,"bin$", V_STRING, fn_bind, 1,V_REAL); - builtin(this,"bin$", V_STRING, fn_binii, 2,V_INTEGER,V_INTEGER); - builtin(this,"bin$", V_STRING, fn_bindi, 2,V_REAL,V_INTEGER); - builtin(this,"bin$", V_STRING, fn_binid, 2,V_INTEGER,V_REAL); - builtin(this,"bin$", V_STRING, fn_bindd, 2,V_REAL,V_REAL); - builtin(this,"chr$", V_STRING, fn_chr, 1,V_INTEGER); - builtin(this,"cint", V_REAL, fn_cint, 1,V_REAL); - builtin(this,"code", V_INTEGER,fn_asc, 1,V_STRING); - builtin(this,"command$",V_STRING, fn_command, 0); - builtin(this,"command$",V_STRING, fn_commandi, 1,V_INTEGER); - builtin(this,"command$",V_STRING, fn_commandd, 1,V_REAL); - builtin(this,"cos", V_REAL, fn_cos, 1,V_REAL); - builtin(this,"cvi", V_INTEGER,fn_cvi, 1,V_STRING); - builtin(this,"cvs", V_REAL, fn_cvs, 1,V_STRING); - builtin(this,"cvd", V_REAL, fn_cvd, 1,V_STRING); - builtin(this,"date$", V_STRING, fn_date, 0); - builtin(this,"dec$", V_STRING, fn_dec, 2,V_REAL,V_STRING); - builtin(this,"dec$", V_STRING, fn_dec, 2,V_INTEGER,V_STRING); - builtin(this,"dec$", V_STRING, fn_dec, 2,V_STRING,V_STRING); - builtin(this,"deg", V_REAL, fn_deg, 1,V_REAL); - builtin(this,"det", V_REAL, fn_det, 0); - builtin(this,"edit$", V_STRING, fn_edit, 2,V_STRING,V_INTEGER); - builtin(this,"environ$",V_STRING, fn_environi, 1,V_INTEGER); - builtin(this,"environ$",V_STRING, fn_environd, 1,V_REAL); - builtin(this,"environ$",V_STRING, fn_environs, 1,V_STRING); - builtin(this,"eof", V_INTEGER,fn_eof, 1,V_INTEGER); - builtin(this,"erl", V_INTEGER,fn_erl, 0); - builtin(this,"err", V_INTEGER,fn_err, 0); - builtin(this,"exp", V_REAL, fn_exp, 1,V_REAL); - builtin(this,"false", V_INTEGER,fn_false, 0); - builtin(this,"find$", V_STRING, fn_find, 1,V_STRING); - builtin(this,"find$", V_STRING, fn_findi, 2,V_STRING,V_INTEGER); - builtin(this,"find$", V_STRING, fn_findd, 2,V_STRING,V_REAL); - builtin(this,"fix", V_REAL, fn_fix, 1,V_REAL); - builtin(this,"frac", V_REAL, fn_frac, 1,V_REAL); - builtin(this,"freefile",V_INTEGER,fn_freefile, 0); - builtin(this,"fp", V_REAL, fn_frac, 1,V_REAL); - builtin(this,"hex$", V_STRING, fn_hexi, 1,V_INTEGER); - builtin(this,"hex$", V_STRING, fn_hexd, 1,V_REAL); - builtin(this,"hex$", V_STRING, fn_hexii, 2,V_INTEGER,V_INTEGER); - builtin(this,"hex$", V_STRING, fn_hexdi, 2,V_REAL,V_INTEGER); - builtin(this,"hex$", V_STRING, fn_hexid, 2,V_INTEGER,V_REAL); - builtin(this,"hex$", V_STRING, fn_hexdd, 2,V_REAL,V_REAL); - builtin(this,"inkey$", V_STRING, fn_inkey, 0); - builtin(this,"inkey$", V_STRING, fn_inkeyi, 1,V_INTEGER); - builtin(this,"inkey$", V_STRING, fn_inkeyd, 1,V_REAL); - builtin(this,"inkey$", V_STRING, fn_inkeyii, 2,V_INTEGER,V_INTEGER); - builtin(this,"inkey$", V_STRING, fn_inkeyid, 2,V_INTEGER,V_REAL); - builtin(this,"inkey$", V_STRING, fn_inkeydi, 2,V_REAL,V_INTEGER); - builtin(this,"inkey$", V_STRING, fn_inkeydd, 2,V_REAL,V_REAL); - builtin(this,"inp", V_INTEGER,fn_inp, 1,V_INTEGER); - builtin(this,"input$", V_STRING, fn_input1, 1,V_INTEGER); - builtin(this,"input$", V_STRING, fn_input2, 2,V_INTEGER,V_INTEGER); - builtin(this,"instr", V_INTEGER,fn_instr2, 2,V_STRING,V_STRING); - builtin(this,"instr", V_INTEGER,fn_instr3iss, 3,V_INTEGER,V_STRING,V_STRING); - builtin(this,"instr", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER); - builtin(this,"instr", V_INTEGER,fn_instr3dss, 3,V_REAL,V_STRING,V_STRING); - builtin(this,"instr", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL); - builtin(this,"instr", V_INTEGER,fn_instr4ii, 4,V_STRING,V_STRING,V_INTEGER,V_INTEGER); - builtin(this,"instr", V_INTEGER,fn_instr4id, 4,V_STRING,V_STRING,V_INTEGER,V_REAL); - builtin(this,"instr", V_INTEGER,fn_instr4di, 4,V_STRING,V_STRING,V_REAL,V_INTEGER); - builtin(this,"instr", V_INTEGER,fn_instr4dd, 4,V_STRING,V_STRING,V_REAL,V_REAL); - builtin(this,"int", V_REAL, fn_int, 1,V_REAL); - builtin(this,"int%", V_INTEGER,fn_intp, 1,V_REAL); - builtin(this,"ip", V_REAL, fn_fix, 1,V_REAL); - builtin(this,"lcase$", V_STRING, fn_lcase, 1,V_STRING); - builtin(this,"lower$", V_STRING, fn_lcase, 1,V_STRING); - builtin(this,"left$", V_STRING, fn_left, 2,V_STRING,V_INTEGER); - builtin(this,"len", V_INTEGER,fn_len, 1,V_STRING); - builtin(this,"loc", V_INTEGER,fn_loc, 1,V_INTEGER); - builtin(this,"lof", V_INTEGER,fn_lof, 1,V_INTEGER); - builtin(this,"log", V_REAL, fn_log, 1,V_REAL); - builtin(this,"log10", V_REAL, fn_log10, 1,V_REAL); - builtin(this,"log2", V_REAL, fn_log2, 1,V_REAL); - builtin(this,"ltrim$", V_STRING, fn_ltrim, 1,V_STRING); - builtin(this,"match", V_INTEGER,fn_match, 3,V_STRING,V_STRING,V_INTEGER); - builtin(this,"max", V_INTEGER,fn_maxii, 2,V_INTEGER,V_INTEGER); - builtin(this,"max", V_REAL, fn_maxdi, 2,V_REAL,V_INTEGER); - builtin(this,"max", V_REAL, fn_maxid, 2,V_INTEGER,V_REAL); - builtin(this,"max", V_REAL, fn_maxdd, 2,V_REAL,V_REAL); - builtin(this,"mid$", V_STRING, fn_mid2i, 2,V_STRING,V_INTEGER); - builtin(this,"mid$", V_STRING, fn_mid2d, 2,V_STRING,V_REAL); - builtin(this,"mid$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER); - builtin(this,"mid$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL); - builtin(this,"mid$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER); - builtin(this,"mid$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL); - builtin(this,"min", V_INTEGER,fn_minii, 2,V_INTEGER,V_INTEGER); - builtin(this,"min", V_REAL, fn_mindi, 2,V_REAL,V_INTEGER); - builtin(this,"min", V_REAL, fn_minid, 2,V_INTEGER,V_REAL); - builtin(this,"min", V_REAL, fn_mindd, 2,V_REAL,V_REAL); - builtin(this,"mki$", V_STRING, fn_mki, 1,V_INTEGER); - builtin(this,"mks$", V_STRING, fn_mks, 1,V_REAL); - builtin(this,"mkd$", V_STRING, fn_mkd, 1,V_REAL); - builtin(this,"oct$", V_STRING, fn_oct, 1,V_INTEGER); - builtin(this,"peek", V_INTEGER,fn_peek, 1,V_INTEGER); - builtin(this,"pi", V_REAL, fn_pi, 0); - builtin(this,"pos", V_INTEGER,fn_pos, 1,V_INTEGER); - builtin(this,"pos", V_INTEGER,fn_pos, 1,V_REAL); - builtin(this,"pos", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER); - builtin(this,"pos", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL); - builtin(this,"rad", V_REAL, fn_rad, 1,V_REAL); - builtin(this,"right$", V_STRING, fn_right, 2,V_STRING,V_INTEGER); - builtin(this,"rnd", V_INTEGER,fn_rnd, 0); - builtin(this,"rnd", V_INTEGER,fn_rndd, 1,V_REAL); - builtin(this,"rnd", V_INTEGER,fn_rndi, 1,V_INTEGER); - builtin(this,"rtrim$", V_STRING, fn_rtrim, 1,V_STRING); - builtin(this,"seg$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER); - builtin(this,"seg$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL); - builtin(this,"seg$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER); - builtin(this,"seg$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL); - builtin(this,"sgn", V_INTEGER,fn_sgn, 1,V_REAL); - builtin(this,"sin", V_REAL, fn_sin, 1,V_REAL); - builtin(this,"space$", V_STRING, fn_space, 1,V_INTEGER); - builtin(this,"sqr", V_REAL, fn_sqr, 1,V_REAL); - builtin(this,"str$", V_STRING, fn_str, 1,V_REAL); - builtin(this,"str$", V_STRING, fn_str, 1,V_INTEGER); - builtin(this,"string$", V_STRING, fn_stringii, 2,V_INTEGER,V_INTEGER); - builtin(this,"string$", V_STRING, fn_stringid, 2,V_INTEGER,V_REAL); - builtin(this,"string$", V_STRING, fn_stringdi, 2,V_REAL,V_INTEGER); - builtin(this,"string$", V_STRING, fn_stringdd, 2,V_REAL,V_REAL); - builtin(this,"string$", V_STRING, fn_stringis, 2,V_INTEGER,V_STRING); - builtin(this,"string$", V_STRING, fn_stringds, 2,V_REAL,V_STRING); - builtin(this,"strip$", V_STRING, fn_strip, 1,V_STRING); - builtin(this,"tan", V_REAL, fn_tan, 1,V_REAL); - builtin(this,"time", V_INTEGER,fn_timei, 0); - builtin(this,"time$", V_STRING, fn_times, 0); - builtin(this,"timer", V_REAL, fn_timer, 0); - builtin(this,"tl$", V_STRING, fn_tl, 1,V_STRING); - builtin(this,"true", V_INTEGER,fn_true, 0); - builtin(this,"ucase$", V_STRING, fn_ucase, 1,V_STRING); - builtin(this,"upper$", V_STRING, fn_ucase, 1,V_STRING); - builtin(this,"val", V_REAL, fn_val, 1,V_STRING); + builtin(this, "abs", V_REAL, fn_abs, 1, V_REAL); + builtin(this, "asc", V_INTEGER, fn_asc, 1, V_STRING); + builtin(this, "atn", V_REAL, fn_atn, 1, V_REAL); + builtin(this, "bin$", V_STRING, fn_bini, 1, V_INTEGER); + builtin(this, "bin$", V_STRING, fn_bind, 1, V_REAL); + builtin(this, "bin$", V_STRING, fn_binii, 2, V_INTEGER, V_INTEGER); + builtin(this, "bin$", V_STRING, fn_bindi, 2, V_REAL, V_INTEGER); + builtin(this, "bin$", V_STRING, fn_binid, 2, V_INTEGER, V_REAL); + builtin(this, "bin$", V_STRING, fn_bindd, 2, V_REAL, V_REAL); + builtin(this, "chr$", V_STRING, fn_chr, 1, V_INTEGER); + builtin(this, "cint", V_REAL, fn_cint, 1, V_REAL); + builtin(this, "code", V_INTEGER, fn_asc, 1, V_STRING); + builtin(this, "command$", V_STRING, fn_command, 0); + builtin(this, "command$", V_STRING, fn_commandi, 1, V_INTEGER); + builtin(this, "command$", V_STRING, fn_commandd, 1, V_REAL); + builtin(this, "cos", V_REAL, fn_cos, 1, V_REAL); + builtin(this, "cvi", V_INTEGER, fn_cvi, 1, V_STRING); + builtin(this, "cvs", V_REAL, fn_cvs, 1, V_STRING); + builtin(this, "cvd", V_REAL, fn_cvd, 1, V_STRING); + builtin(this, "date$", V_STRING, fn_date, 0); + builtin(this, "dec$", V_STRING, fn_dec, 2, V_REAL, V_STRING); + builtin(this, "dec$", V_STRING, fn_dec, 2, V_INTEGER, V_STRING); + builtin(this, "dec$", V_STRING, fn_dec, 2, V_STRING, V_STRING); + builtin(this, "deg", V_REAL, fn_deg, 1, V_REAL); + builtin(this, "det", V_REAL, fn_det, 0); + builtin(this, "edit$", V_STRING, fn_edit, 2, V_STRING, V_INTEGER); + builtin(this, "environ$", V_STRING, fn_environi, 1, V_INTEGER); + builtin(this, "environ$", V_STRING, fn_environd, 1, V_REAL); + builtin(this, "environ$", V_STRING, fn_environs, 1, V_STRING); + builtin(this, "eof", V_INTEGER, fn_eof, 1, V_INTEGER); + builtin(this, "erl", V_INTEGER, fn_erl, 0); + builtin(this, "err", V_INTEGER, fn_err, 0); + builtin(this, "exp", V_REAL, fn_exp, 1, V_REAL); + builtin(this, "false", V_INTEGER, fn_false, 0); + builtin(this, "find$", V_STRING, fn_find, 1, V_STRING); + builtin(this, "find$", V_STRING, fn_findi, 2, V_STRING, V_INTEGER); + builtin(this, "find$", V_STRING, fn_findd, 2, V_STRING, V_REAL); + builtin(this, "fix", V_REAL, fn_fix, 1, V_REAL); + builtin(this, "frac", V_REAL, fn_frac, 1, V_REAL); + builtin(this, "freefile", V_INTEGER, fn_freefile, 0); + builtin(this, "fp", V_REAL, fn_frac, 1, V_REAL); + builtin(this, "hex$", V_STRING, fn_hexi, 1, V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexd, 1, V_REAL); + builtin(this, "hex$", V_STRING, fn_hexii, 2, V_INTEGER, V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexdi, 2, V_REAL, V_INTEGER); + builtin(this, "hex$", V_STRING, fn_hexid, 2, V_INTEGER, V_REAL); + builtin(this, "hex$", V_STRING, fn_hexdd, 2, V_REAL, V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkey, 0); + builtin(this, "inkey$", V_STRING, fn_inkeyi, 1, V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeyd, 1, V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkeyii, 2, V_INTEGER, V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeyid, 2, V_INTEGER, V_REAL); + builtin(this, "inkey$", V_STRING, fn_inkeydi, 2, V_REAL, V_INTEGER); + builtin(this, "inkey$", V_STRING, fn_inkeydd, 2, V_REAL, V_REAL); + builtin(this, "inp", V_INTEGER, fn_inp, 1, V_INTEGER); + builtin(this, "input$", V_STRING, fn_input1, 1, V_INTEGER); + builtin(this, "input$", V_STRING, fn_input2, 2, V_INTEGER, V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr2, 2, V_STRING, V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3iss, 3, V_INTEGER, V_STRING, + V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3ssi, 3, V_STRING, V_STRING, + V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr3dss, 3, V_REAL, V_STRING, + V_STRING); + builtin(this, "instr", V_INTEGER, fn_instr3ssd, 3, V_STRING, V_STRING, + V_REAL); + builtin(this, "instr", V_INTEGER, fn_instr4ii, 4, V_STRING, V_STRING, + V_INTEGER, V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr4id, 4, V_STRING, V_STRING, + V_INTEGER, V_REAL); + builtin(this, "instr", V_INTEGER, fn_instr4di, 4, V_STRING, V_STRING, V_REAL, + V_INTEGER); + builtin(this, "instr", V_INTEGER, fn_instr4dd, 4, V_STRING, V_STRING, V_REAL, + V_REAL); + builtin(this, "int", V_REAL, fn_int, 1, V_REAL); + builtin(this, "int%", V_INTEGER, fn_intp, 1, V_REAL); + builtin(this, "ip", V_REAL, fn_fix, 1, V_REAL); + builtin(this, "lcase$", V_STRING, fn_lcase, 1, V_STRING); + builtin(this, "lower$", V_STRING, fn_lcase, 1, V_STRING); + builtin(this, "left$", V_STRING, fn_left, 2, V_STRING, V_INTEGER); + builtin(this, "len", V_INTEGER, fn_len, 1, V_STRING); + builtin(this, "loc", V_INTEGER, fn_loc, 1, V_INTEGER); + builtin(this, "lof", V_INTEGER, fn_lof, 1, V_INTEGER); + builtin(this, "log", V_REAL, fn_log, 1, V_REAL); + builtin(this, "log10", V_REAL, fn_log10, 1, V_REAL); + builtin(this, "log2", V_REAL, fn_log2, 1, V_REAL); + builtin(this, "ltrim$", V_STRING, fn_ltrim, 1, V_STRING); + builtin(this, "match", V_INTEGER, fn_match, 3, V_STRING, V_STRING, + V_INTEGER); + builtin(this, "max", V_INTEGER, fn_maxii, 2, V_INTEGER, V_INTEGER); + builtin(this, "max", V_REAL, fn_maxdi, 2, V_REAL, V_INTEGER); + builtin(this, "max", V_REAL, fn_maxid, 2, V_INTEGER, V_REAL); + builtin(this, "max", V_REAL, fn_maxdd, 2, V_REAL, V_REAL); + builtin(this, "mid$", V_STRING, fn_mid2i, 2, V_STRING, V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid2d, 2, V_STRING, V_REAL); + builtin(this, "mid$", V_STRING, fn_mid3ii, 3, V_STRING, V_INTEGER, + V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid3id, 3, V_STRING, V_INTEGER, V_REAL); + builtin(this, "mid$", V_STRING, fn_mid3di, 3, V_STRING, V_REAL, V_INTEGER); + builtin(this, "mid$", V_STRING, fn_mid3dd, 3, V_STRING, V_REAL, V_REAL); + builtin(this, "min", V_INTEGER, fn_minii, 2, V_INTEGER, V_INTEGER); + builtin(this, "min", V_REAL, fn_mindi, 2, V_REAL, V_INTEGER); + builtin(this, "min", V_REAL, fn_minid, 2, V_INTEGER, V_REAL); + builtin(this, "min", V_REAL, fn_mindd, 2, V_REAL, V_REAL); + builtin(this, "mki$", V_STRING, fn_mki, 1, V_INTEGER); + builtin(this, "mks$", V_STRING, fn_mks, 1, V_REAL); + builtin(this, "mkd$", V_STRING, fn_mkd, 1, V_REAL); + builtin(this, "oct$", V_STRING, fn_oct, 1, V_INTEGER); + builtin(this, "peek", V_INTEGER, fn_peek, 1, V_INTEGER); + builtin(this, "pi", V_REAL, fn_pi, 0); + builtin(this, "pos", V_INTEGER, fn_pos, 1, V_INTEGER); + builtin(this, "pos", V_INTEGER, fn_pos, 1, V_REAL); + builtin(this, "pos", V_INTEGER, fn_instr3ssi, 3, V_STRING, V_STRING, + V_INTEGER); + builtin(this, "pos", V_INTEGER, fn_instr3ssd, 3, V_STRING, V_STRING, + V_REAL); + builtin(this, "rad", V_REAL, fn_rad, 1, V_REAL); + builtin(this, "right$", V_STRING, fn_right, 2, V_STRING, V_INTEGER); + builtin(this, "rnd", V_INTEGER, fn_rnd, 0); + builtin(this, "rnd", V_INTEGER, fn_rndd, 1, V_REAL); + builtin(this, "rnd", V_INTEGER, fn_rndi, 1, V_INTEGER); + builtin(this, "rtrim$", V_STRING, fn_rtrim, 1, V_STRING); + builtin(this, "seg$", V_STRING, fn_mid3ii, 3, V_STRING, V_INTEGER, + V_INTEGER); + builtin(this, "seg$", V_STRING, fn_mid3id, 3, V_STRING, V_INTEGER, V_REAL); + builtin(this, "seg$", V_STRING, fn_mid3di, 3, V_STRING, V_REAL, V_INTEGER); + builtin(this, "seg$", V_STRING, fn_mid3dd, 3, V_STRING, V_REAL, V_REAL); + builtin(this, "sgn", V_INTEGER, fn_sgn, 1, V_REAL); + builtin(this, "sin", V_REAL, fn_sin, 1, V_REAL); + builtin(this, "space$", V_STRING, fn_space, 1, V_INTEGER); + builtin(this, "sqr", V_REAL, fn_sqr, 1, V_REAL); + builtin(this, "str$", V_STRING, fn_str, 1, V_REAL); + builtin(this, "str$", V_STRING, fn_str, 1, V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringii, 2, V_INTEGER, V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringid, 2, V_INTEGER, V_REAL); + builtin(this, "string$", V_STRING, fn_stringdi, 2, V_REAL, V_INTEGER); + builtin(this, "string$", V_STRING, fn_stringdd, 2, V_REAL, V_REAL); + builtin(this, "string$", V_STRING, fn_stringis, 2, V_INTEGER, V_STRING); + builtin(this, "string$", V_STRING, fn_stringds, 2, V_REAL, V_STRING); + builtin(this, "strip$", V_STRING, fn_strip, 1, V_STRING); + builtin(this, "tan", V_REAL, fn_tan, 1, V_REAL); + builtin(this, "time", V_INTEGER, fn_timei, 0); + builtin(this, "time$", V_STRING, fn_times, 0); + builtin(this, "timer", V_REAL, fn_timer, 0); + builtin(this, "tl$", V_STRING, fn_tl, 1, V_STRING); + builtin(this, "true", V_INTEGER, fn_true, 0); + builtin(this, "ucase$", V_STRING, fn_ucase, 1, V_STRING); + builtin(this, "upper$", V_STRING, fn_ucase, 1, V_STRING); + builtin(this, "val", V_REAL, fn_val, 1, V_STRING); return this; } -/*}}}*/ -int Global_find(struct Global *this, struct Identifier *ident, int oparen) /*{{{*/ + +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); + 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) /*{{{*/ + +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); + 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; - } + { + ident->sym = (*r); + break; + } + case BUILTINFUNCTION: - { - return 0; - } + { + 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; } - default: assert(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; } -/*}}}*/ -int Global_function(struct Global *this, struct Identifier *ident, enum ValueType type, struct Pc *deffn, struct Pc *begin, int argLength, enum ValueType *argTypes) /*{{{*/ + +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) - ); - 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)); - 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; + assert(*r != (struct Symbol *)0); + (*r)->u.sub.u.def.scope.end = *end; } -/*}}}*/ -void Global_clear(struct Global *this) /*{{{*/ + +void Global_clear(struct Global *this) { int i; - for (i=0; itable[i]; v; v=v->next) + for (i = 0; i < GLOBAL_HASHSIZE; ++i) { - if (v->type==GLOBALVAR || v->type==GLOBALARRAY) Var_clear(&(v->u.var)); - } - } -} -/*}}}*/ -void Global_clearFunctions(struct Global *this) /*{{{*/ -{ - int i; + struct Symbol *v; - for (i=0; itable[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; itable[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: + for (v = this->table[i]; v; v = v->next) { - 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) + if (v->type == GLOBALVAR || v->type == GLOBALARRAY) { - struct Symbol *n; - - if (sym->u.sub.argTypes) free(sym->u.sub.argTypes); - n=sym->u.sub.u.bltin.next; - free(sym); - sym=n; + Var_clear(&(v->u.var)); } - } - break; } - default: assert(0); - } - free(v->name); - free(v); - v=w; } - this->table[i]=(struct Symbol*)0; - } } -/*}}}*/ + +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; + } +}