sergiotarxz/nuttx-apps
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
e8fcc92609
nuttx-apps/interpreters/bas/global.c

1788 lines
52 KiB
C
Raw Blame History

/* Global variables and functions. */
/* #includes */ /*{{{C}}}*//*{{{*/
#include "config.h"
#include <sys/times.h>
#include <assert.h>
#include <ctype.h>
#include <dirent.h>
#include <errno.h>
#ifdef HAVE_GETTEXT
#include <libintl.h>
#define _(String) gettext(String)
#else
#define _(String) String
#endif
#include <math.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <time.h>
#include <unistd.h>
#include "auto.h"
#include "bas.h"
#include "error.h"
#include "fs.h"
#include "global.h"
#include "var.h"
#ifdef USE_DMALLOC
#include "dmalloc.h"
#endif
/*}}}*/
/* #defines */ /*{{{*/
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
/*}}}*/
extern char **environ;
static int wildcardmatch(const char *a, const char *pattern) /*{{{*/
{
while (*pattern)
{
switch (*pattern)
{
case '*':
{
++pattern;
while (*a) if (wildcardmatch(a,pattern)) return 1; else ++a;
break;
}
case '?':
{
if (*a) { ++a; ++pattern; } else return 0;
break;
}
default: if (*a==*pattern) { ++a; ++pattern; } else return 0;
}
}
return (*pattern=='\0' && *a=='\0');
}
/*}}}*/
static long int intValue(struct Auto *stack, int l) /*{{{*/
{
struct Value value;
struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
assert(arg->type==V_INTEGER);
return arg->u.integer;
}
/*}}}*/
static double realValue(struct Auto *stack, int l) /*{{{*/
{
struct Value value;
struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
assert(arg->type==V_REAL);
return arg->u.real;
}
/*}}}*/
static struct String *stringValue(struct Auto *stack, int l) /*{{{*/
{
struct Value value;
struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
assert(arg->type==V_STRING);
return &(arg->u.string);
}
/*}}}*/
static struct Value *bin(struct Value *v, unsigned long int value, long int digits) /*{{{*/
{
char buf[sizeof(long int)*8+1];
char *s;
Value_new_STRING(v);
s=buf+sizeof(buf);
*--s='\0';
if (digits==0) digits=1;
while (digits || value)
{
*--s=value&1?'1':'0';
if (digits) --digits;
value>>=1;
}
String_appendChars(&v->u.string,s);
return v;
}
/*}}}*/
static struct Value *hex(struct Value *v, long int value, long int digits) /*{{{*/
{
char buf[sizeof(long int)*2+1];
sprintf(buf,"%0*lx",(int)digits,value);
Value_new_STRING(v);
String_appendChars(&v->u.string,buf);
return v;
}
/*}}}*/
static struct Value *find(struct Value *v, struct String *pattern, long int occurence) /*{{{*/
{
struct String dirname,basename;
char *slash;
DIR *dir;
struct dirent *ent;
int currentdir;
int found=0;
Value_new_STRING(v);
String_new(&dirname);
String_new(&basename);
String_appendString(&dirname,pattern);
while (dirname.length>0 && dirname.character[dirname.length-1]=='/') String_delete(&dirname,dirname.length-1,1);
if ((slash=strrchr(dirname.character,'/'))==(char*)0)
{
String_appendString(&basename,&dirname);
String_delete(&dirname,0,dirname.length);
String_appendChar(&dirname,'.');
currentdir=1;
}
else
{
String_appendChars(&basename,slash+1);
String_delete(&dirname,slash-dirname.character,dirname.length-(slash-dirname.character));
currentdir=0;
}
if ((dir=opendir(dirname.character))!=(DIR*)0)
{
while ((ent=readdir(dir))!=(struct dirent*)0)
{
if (wildcardmatch(ent->d_name,basename.character))
{
if (found==occurence)
{
if (currentdir) String_appendChars(&v->u.string,ent->d_name);
else String_appendPrintf(&v->u.string,"%s/%s",dirname.character,ent->d_name);
break;
}
++found;
}
}
closedir(dir);
}
String_destroy(&dirname);
String_destroy(&basename);
return v;
}
/*}}}*/
static struct Value *instr(struct Value *v, long int start, long int len, struct String *haystack, struct String *needle) /*{{{*/
{
const char *haystackChars=haystack->character;
size_t haystackLength=haystack->length;
const char *needleChars=needle->character;
size_t needleLength=needle->length;
int found;
--start;
if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0);
haystackChars+=start; haystackLength-=start;
if (haystackLength>len) haystackLength=len;
found=1+start;
while (needleLength<=haystackLength)
{
if (memcmp(haystackChars,needleChars,needleLength)==0) return Value_new_INTEGER(v,found);
++haystackChars; --haystackLength;
++found;
}
return Value_new_INTEGER(v,0);
}
/*}}}*/
static struct Value *string(struct Value *v, long int len, int c) /*{{{*/
{
if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
if (c<0 || c>255) return Value_new_ERROR(v,OUTOFRANGE,_("code"));
Value_new_STRING(v);
String_size(&v->u.string,len);
if (len) memset(v->u.string.character,c,len);
return v;
}
/*}}}*/
static struct Value *mid(struct Value *v, struct String *s, long int position, long int length) /*{{{*/
{
--position;
if (position<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
if (length<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
if (((size_t)position)+length>s->length)
{
length=s->length-position;
if (length<0) length=0;
}
Value_new_STRING(v);
String_size(&v->u.string,length);
if (length>0) memcpy(v->u.string.character,s->character+position,length);
return v;
}
/*}}}*/
static struct Value *inkey(struct Value *v, long int timeout, long int chn) /*{{{*/
{
int c;
if ((c=FS_inkeyChar(chn,timeout*10))==-1)
{
if (FS_errmsg) return Value_new_ERROR(v,IOERROR,FS_errmsg);
else return Value_new_STRING(v);
}
else
{
Value_new_STRING(v);
String_appendChar(&v->u.string,c);
return v;
}
}
/*}}}*/
static struct Value *input(struct Value *v, long int len, long int chn) /*{{{*/
{
int ch=-1;
if (len<=0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
Value_new_STRING(v);
while (len-- && (ch=FS_getChar(chn))!=-1) String_appendChar(&v->u.string,ch);
if (ch==-1)
{
Value_destroy(v);
return Value_new_ERROR(v,IOERROR,FS_errmsg);
}
return v;
}
/*}}}*/
static struct Value *env(struct Value *v, long int n) /*{{{*/
{
int i;
--n;
if (n<0) return Value_new_ERROR(v,OUTOFRANGE,_("variable number"));
for (i=0; i<n && environ[i]; ++i);
Value_new_STRING(v);
if (i==n && environ[i]) String_appendChars(&v->u.string,environ[i]);
return v;
}
/*}}}*/
static struct Value *rnd(struct Value *v, long int x) /*{{{*/
{
if (x<0) srand(-x);
if (x==0 || x==1) Value_new_REAL(v,rand()/(double)RAND_MAX);
else Value_new_REAL(v,rand()%x+1);
return v;
}
/*}}}*/
static struct Value *fn_abs(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,fabs(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_asc(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
if (s->length==0) return Value_new_ERROR(v,UNDEFINED,_("`asc' or `code' of empty string"));
return Value_new_INTEGER(v,s->character[0]&0xff);
}
/*}}}*/
static struct Value *fn_atn(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,atan(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_bini(struct Value *v, struct Auto *stack) /*{{{*/
{
return bin(v,intValue(stack,0),0);
}
/*}}}*/
static struct Value *fn_bind(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return bin(v,n,0);
}
/*}}}*/
static struct Value *fn_binii(struct Value *v, struct Auto *stack) /*{{{*/
{
return bin(v,intValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_bindi(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return bin(v,n,intValue(stack,1));
}
/*}}}*/
static struct Value *fn_binid(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int digits;
digits=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
return bin(v,intValue(stack,0),digits);
}
/*}}}*/
static struct Value *fn_bindd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n,digits;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
digits=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
return bin(v,n,digits);
}
/*}}}*/
static struct Value *fn_chr(struct Value *v, struct Auto *stack) /*{{{*/
{
long int chr=intValue(stack,0);
if (chr<0 || chr>255) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
Value_new_STRING(v);
String_size(&v->u.string,1);
v->u.string.character[0]=chr;
return v;
}
/*}}}*/
static struct Value *fn_cint(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,ceil(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_cos(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,cos(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_command(struct Value *v, struct Auto *stack) /*{{{*/
{
int i;
Value_new_STRING(v);
for (i=0; i<bas_argc; ++i)
{
if (i) String_appendChar(&v->u.string,' ');
String_appendChars(&v->u.string,bas_argv[i]);
}
return v;
}
/*}}}*/
static struct Value *fn_commandi(struct Value *v, struct Auto *stack) /*{{{*/
{
int a;
a=intValue(stack,0);
if (a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number"));
Value_new_STRING(v);
if (a==0)
{
if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0);
}
else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]);
return v;
}
/*}}}*/
static struct Value *fn_commandd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int a;
a=Value_toi(realValue(stack,0),&overflow);
if (overflow || a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number"));
Value_new_STRING(v);
if (a==0)
{
if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0);
}
else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]);
return v;
}
/*}}}*/
static struct Value *fn_cvi(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
long int n=(s->length && s->character[s->length-1]<0) ? -1 : 0;
int i;
for (i=s->length-1; i>=0; --i) n=(n<<8)|(s->character[i]&0xff);
return Value_new_INTEGER(v,n);
}
/*}}}*/
static struct Value *fn_cvs(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
float n;
if (s->length!=sizeof(float)) return Value_new_ERROR(v,BADCONVERSION,_("number"));
memcpy(&n,s->character,sizeof(float));
return Value_new_REAL(v,(double)n);
}
/*}}}*/
static struct Value *fn_cvd(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
double n;
if (s->length!=sizeof(double)) return Value_new_ERROR(v,BADCONVERSION,_("number"));
memcpy(&n,s->character,sizeof(double));
return Value_new_REAL(v,n);
}
/*}}}*/
static struct Value *fn_date(struct Value *v, struct Auto *stack) /*{{{*/
{
time_t t;
struct tm *now;
Value_new_STRING(v);
String_size(&v->u.string,10);
time(&t);
now=localtime(&t);
sprintf(v->u.string.character,"%02d-%02d-%04d",now->tm_mon+1,now->tm_mday,now->tm_year+1900);
return v;
}
/*}}}*/
static struct Value *fn_dec(struct Value *v, struct Auto *stack) /*{{{*/
{
struct Value value,*arg;
size_t using;
Value_new_STRING(v);
arg=Var_value(Auto_local(stack,0),0,(int*)0,&value);
using=0;
Value_toStringUsing(arg,&v->u.string,stringValue(stack,1),&using);
return v;
}
/*}}}*/
static struct Value *fn_deg(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,realValue(stack,0)*(180.0/M_PI));
}
/*}}}*/
static struct Value *fn_det(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,stack->lastdet.type==V_NIL?0.0:(stack->lastdet.type==V_REAL?stack->lastdet.u.real:stack->lastdet.u.integer));
}
/*}}}*/
static struct Value *fn_edit(struct Value *v, struct Auto *stack) /*{{{*/
{
int code;
char *begin,*end,*rd,*wr;
char quote;
code=intValue(stack,1);
Value_new_STRING(v);
String_appendString(&v->u.string,stringValue(stack,0));
begin=rd=wr=v->u.string.character;
end=rd+v->u.string.length;
/* 8 - Discard Leading Spaces and Tabs */
if (code & 8) while (rd<end && (*rd==' ' || *rd=='\t')) ++rd;
while (rd<end)
{
/* 1 - Discard parity bit */
if (code&1) *rd=*rd&0x7f;
/* 2 - Discard all spaces and tabs */
if ((code&2) && (*rd==' ' || *rd=='\t')) { ++rd; continue; }
/* 4 - Discard all carriage returns, line feeds, form feeds, deletes, escapes, and nulls */
if ((code&4) && (*rd=='\r' || *rd=='\n' || *rd=='\f' || *rd==127 || *rd==27 || *rd=='\0')) { ++rd; continue; }
/* 16 - Convert Multiple Spaces and Tabs to one space */
if ((code&16) && ((*rd==' ') || (*rd=='\t')))
{
*wr++=' ';
while (rd<end && (*rd==' ' || *rd=='\t')) ++rd;
continue;
}
/* 32 - Convert lower to upper case */
if ((code&32) && islower((int)*rd)) { *wr++=toupper((int)*rd++); continue; }
/* 64 - Convert brackets to parentheses */
if (code&64)
{
if (*rd=='[') { *wr++='('; ++rd; continue; }
else if (*rd==']') { *wr++=')'; ++rd; continue; }
}
/* 256 - Suppress all editing for characters within quotation marks */
if ((code&256) && (*rd=='"' || *rd=='\''))
{
quote=*rd;
*wr++=*rd++;
while (rd<end && *rd!=quote) *wr++=*rd++;
if (rd<end) { *wr++=*rd++; quote='\0'; }
continue;
}
*wr++=*rd++;
}
/* 128 - Discard Trailing Spaces and Tabs */
if ((code & 128) && wr>begin)
{
while (wr>begin && (*(wr-1)=='\0' || *(wr-1)=='\t')) --wr;
}
String_size(&v->u.string,wr-begin);
return v;
}
/*}}}*/
static struct Value *fn_environi(struct Value *v, struct Auto *stack) /*{{{*/
{
return env(v,intValue(stack,0));
}
/*}}}*/
static struct Value *fn_environd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return env(v,n);
}
/*}}}*/
static struct Value *fn_environs(struct Value *v, struct Auto *stack) /*{{{*/
{
char *var;
Value_new_STRING(v);
if ((var=stringValue(stack,0)->character))
{
char *val=getenv(var);
if (val) String_appendChars(&v->u.string,val);
}
return v;
}
/*}}}*/
static struct Value *fn_eof(struct Value *v, struct Auto *stack) /*{{{*/
{
int e=FS_eof(intValue(stack,0));
if (e==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
return Value_new_INTEGER(v,e?-1:0);
}
/*}}}*/
static struct Value *fn_erl(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,stack->erl);
}
/*}}}*/
static struct Value *fn_err(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,stack->err.type==V_NIL?0:stack->err.u.error.code);
}
/*}}}*/
static struct Value *fn_exp(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,exp(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_false(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,0);
}
/*}}}*/
static struct Value *fn_find(struct Value *v, struct Auto *stack) /*{{{*/
{
return find(v,stringValue(stack,0),0);
}
/*}}}*/
static struct Value *fn_findi(struct Value *v, struct Auto *stack) /*{{{*/
{
return find(v,stringValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_findd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n;
n=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return find(v,stringValue(stack,0),n);
}
/*}}}*/
static struct Value *fn_fix(struct Value *v, struct Auto *stack) /*{{{*/
{
double x=realValue(stack,0);
return Value_new_REAL(v,x<0.0?ceil(x):floor(x));
}
/*}}}*/
static struct Value *fn_frac(struct Value *v, struct Auto *stack) /*{{{*/
{
double x=realValue(stack,0);
return Value_new_REAL(v,x<0.0 ? x-ceil(x) : x-floor(x));
}
/*}}}*/
static struct Value *fn_freefile(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,FS_freechn());
}
/*}}}*/
static struct Value *fn_hexi(struct Value *v, struct Auto *stack) /*{{{*/
{
char buf[sizeof(long int)*2+1];
sprintf(buf,"%lx",intValue(stack,0));
Value_new_STRING(v);
String_appendChars(&v->u.string,buf);
return v;
}
/*}}}*/
static struct Value *fn_hexd(struct Value *v, struct Auto *stack) /*{{{*/
{
char buf[sizeof(long int)*2+1];
int overflow;
long int n;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
sprintf(buf,"%lx",n);
Value_new_STRING(v);
String_appendChars(&v->u.string,buf);
return v;
}
/*}}}*/
static struct Value *fn_hexii(struct Value *v, struct Auto *stack) /*{{{*/
{
return hex(v,intValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_hexdi(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return hex(v,n,intValue(stack,1));
}
/*}}}*/
static struct Value *fn_hexid(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int digits;
digits=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
return hex(v,intValue(stack,0),digits);
}
/*}}}*/
static struct Value *fn_hexdd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int n,digits;
n=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
digits=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
return hex(v,n,digits);
}
/*}}}*/
static struct Value *fn_int(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,floor(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_intp(struct Value *v, struct Auto *stack) /*{{{*/
{
long int l;
errno=0;
l=lrint(floor(realValue(stack,0)));
if (errno==EDOM) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
return Value_new_INTEGER(v,l);
}
/*}}}*/
static struct Value *fn_inp(struct Value *v, struct Auto *stack) /*{{{*/
{
int r=FS_portInput(intValue(stack,0));
if (r==-1)
{
return Value_new_ERROR(v,IOERROR,FS_errmsg);
}
else return Value_new_INTEGER(v,r);
}
/*}}}*/
static struct Value *fn_input1(struct Value *v, struct Auto *stack) /*{{{*/
{
return input(v,intValue(stack,0),STDCHANNEL);
}
/*}}}*/
static struct Value *fn_input2(struct Value *v, struct Auto *stack) /*{{{*/
{
return input(v,intValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_inkey(struct Value *v, struct Auto *stack) /*{{{*/
{
return inkey(v,0,STDCHANNEL);
}
/*}}}*/
static struct Value *fn_inkeyi(struct Value *v, struct Auto *stack) /*{{{*/
{
return inkey(v,intValue(stack,0),STDCHANNEL);
}
/*}}}*/
static struct Value *fn_inkeyd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int t;
t=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time"));
return inkey(v,t,STDCHANNEL);
}
/*}}}*/
static struct Value *fn_inkeyii(struct Value *v, struct Auto *stack) /*{{{*/
{
return inkey(v,intValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_inkeyid(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int chn;
chn=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel"));
return inkey(v,intValue(stack,0),chn);
}
/*}}}*/
static struct Value *fn_inkeydi(struct Value *v, struct Auto *stack) /*{{{*/
{
return inkey(v,realValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int t,chn;
t=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time"));
chn=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel"));
return inkey(v,t,chn);
}
/*}}}*/
static struct Value *fn_instr2(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *haystack=stringValue(stack,0);
return instr(v,1,haystack->length,haystack,stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *haystack=stringValue(stack,1);
return instr(v,intValue(stack,0),haystack->length,haystack,stringValue(stack,2));
}
/*}}}*/
static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *haystack=stringValue(stack,0);
return instr(v,intValue(stack,2),haystack->length,haystack,stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr3dss(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start;
struct String *haystack;
start=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
haystack=stringValue(stack,1);
return instr(v,start,haystack->length,haystack,stringValue(stack,2));
}
/*}}}*/
static struct Value *fn_instr3ssd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start;
struct String *haystack;
start=Value_toi(realValue(stack,2),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
haystack=stringValue(stack,0);
return instr(v,start,haystack->length,haystack,stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr4ii(struct Value *v, struct Auto *stack) /*{{{*/
{
return instr(v,intValue(stack,2),intValue(stack,3),stringValue(stack,0),stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr4id(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int len;
len=Value_toi(realValue(stack,3),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
return instr(v,intValue(stack,2),len,stringValue(stack,0),stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr4di(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start;
start=Value_toi(realValue(stack,2),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
return instr(v,start,intValue(stack,3),stringValue(stack,0),stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_instr4dd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start,len;
start=Value_toi(realValue(stack,2),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
len=Value_toi(realValue(stack,3),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
return instr(v,start,len,stringValue(stack,0),stringValue(stack,1));
}
/*}}}*/
static struct Value *fn_lcase(struct Value *v, struct Auto *stack) /*{{{*/
{
Value_new_STRING(v);
String_appendString(&v->u.string,stringValue(stack,0));
String_lcase(&v->u.string);
return v;
}
/*}}}*/
static struct Value *fn_len(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,stringValue(stack,0)->length);
}
/*}}}*/
static struct Value *fn_left(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
long int len=intValue(stack,1);
int left=((size_t)len)<s->length ? len : s->length;
if (left<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
Value_new_STRING(v);
String_size(&v->u.string,left);
if (left) memcpy(v->u.string.character,s->character,left);
return v;
}
/*}}}*/
static struct Value *fn_loc(struct Value *v, struct Auto *stack) /*{{{*/
{
long int l=FS_loc(intValue(stack,0));
if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
return Value_new_INTEGER(v,l);
}
/*}}}*/
static struct Value *fn_lof(struct Value *v, struct Auto *stack) /*{{{*/
{
long int l=FS_lof(intValue(stack,0));
if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
return Value_new_INTEGER(v,l);
}
/*}}}*/
static struct Value *fn_log(struct Value *v, struct Auto *stack) /*{{{*/
{
if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
else Value_new_REAL(v,log(realValue(stack,0)));
return v;
}
/*}}}*/
static struct Value *fn_log10(struct Value *v, struct Auto *stack) /*{{{*/
{
if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
else Value_new_REAL(v,log10(realValue(stack,0)));
return v;
}
/*}}}*/
static struct Value *fn_log2(struct Value *v, struct Auto *stack) /*{{{*/
{
if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
else Value_new_REAL(v,log2(realValue(stack,0)));
return v;
}
/*}}}*/
static struct Value *fn_ltrim(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
int len=s->length;
int spaces;
for (spaces=0; spaces<len && s->character[spaces]==' '; ++spaces);
Value_new_STRING(v);
String_size(&v->u.string,len-spaces);
if (len-spaces) memcpy(v->u.string.character,s->character+spaces,len-spaces);
return v;
}
/*}}}*/
static struct Value *fn_match(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *needle=stringValue(stack,0);
const char *needleChars=needle->character;
const char *needleEnd=needle->character+needle->length;
struct String *haystack=stringValue(stack,1);
const char *haystackChars=haystack->character;
size_t haystackLength=haystack->length;
long int start=intValue(stack,2);
long int found;
const char *n,*h;
if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0);
haystackChars+=start; haystackLength-=start;
found=1+start;
while (haystackLength)
{
for (n=needleChars,h=haystackChars; n<needleEnd && h<(haystackChars+haystackLength); ++n,++h)
{
if (*n=='\\')
{
if (++n<needleEnd && *n!=*h) break;
}
else if (*n=='!')
{
if (!isalpha((int)*h)) break;
}
else if (*n=='#')
{
if (!isdigit((int)*h)) break;
}
else if (*n!='?' && *n!=*h) break;
}
if (n==needleEnd) return Value_new_INTEGER(v,found);
++haystackChars; --haystackLength;
++found;
}
return Value_new_INTEGER(v,0);
}
/*}}}*/
static struct Value *fn_maxii(struct Value *v, struct Auto *stack) /*{{{*/
{
long int x,y;
x=intValue(stack,0);
y=intValue(stack,1);
return Value_new_INTEGER(v,x>y?x:y);
}
/*}}}*/
static struct Value *fn_maxdi(struct Value *v, struct Auto *stack) /*{{{*/
{
double x;
long int y;
x=realValue(stack,0);
y=intValue(stack,1);
return Value_new_REAL(v,x>y?x:y);
}
/*}}}*/
static struct Value *fn_maxid(struct Value *v, struct Auto *stack) /*{{{*/
{
long int x;
double y;
x=intValue(stack,0);
y=realValue(stack,1);
return Value_new_REAL(v,x>y?x:y);
}
/*}}}*/
static struct Value *fn_maxdd(struct Value *v, struct Auto *stack) /*{{{*/
{
double x,y;
x=realValue(stack,0);
y=realValue(stack,1);
return Value_new_REAL(v,x>y?x:y);
}
/*}}}*/
static struct Value *fn_mid2i(struct Value *v, struct Auto *stack) /*{{{*/
{
return mid(v,stringValue(stack,0),intValue(stack,1),stringValue(stack,0)->length);
}
/*}}}*/
static struct Value *fn_mid2d(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start;
start=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
return mid(v,stringValue(stack,0),start,stringValue(stack,0)->length);
}
/*}}}*/
static struct Value *fn_mid3ii(struct Value *v, struct Auto *stack) /*{{{*/
{
return mid(v,stringValue(stack,0),intValue(stack,1),intValue(stack,2));
}
/*}}}*/
static struct Value *fn_mid3id(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int len;
len=Value_toi(realValue(stack,2),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
return mid(v,stringValue(stack,0),intValue(stack,1),len);
}
/*}}}*/
static struct Value *fn_mid3di(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start;
start=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
return mid(v,stringValue(stack,0),start,intValue(stack,2));
}
/*}}}*/
static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int start,len;
start=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
len=Value_toi(realValue(stack,2),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
return mid(v,stringValue(stack,0),start,len);
}
/*}}}*/
static struct Value *fn_minii(struct Value *v, struct Auto *stack) /*{{{*/
{
long int x,y;
x=intValue(stack,0);
y=intValue(stack,1);
return Value_new_INTEGER(v,x<y?x:y);
}
/*}}}*/
static struct Value *fn_mindi(struct Value *v, struct Auto *stack) /*{{{*/
{
double x;
long int y;
x=realValue(stack,0);
y=intValue(stack,1);
return Value_new_REAL(v,x<y?x:y);
}
/*}}}*/
static struct Value *fn_minid(struct Value *v, struct Auto *stack) /*{{{*/
{
long int x;
double y;
x=intValue(stack,0);
y=realValue(stack,1);
return Value_new_REAL(v,x<y?x:y);
}
/*}}}*/
static struct Value *fn_mindd(struct Value *v, struct Auto *stack) /*{{{*/
{
double x,y;
x=realValue(stack,0);
y=realValue(stack,1);
return Value_new_REAL(v,x<y?x:y);
}
/*}}}*/
static struct Value *fn_mki(struct Value *v, struct Auto *stack) /*{{{*/
{
long int x=intValue(stack,0);
size_t i;
Value_new_STRING(v);
String_size(&v->u.string,sizeof(long int));
for (i=0; i<sizeof(long int); ++i,x>>=8) v->u.string.character[i]=(x&0xff);
return v;
}
/*}}}*/
static struct Value *fn_mks(struct Value *v, struct Auto *stack) /*{{{*/
{
float x=realValue(stack,0);
Value_new_STRING(v);
String_size(&v->u.string,sizeof(float));
memcpy(v->u.string.character,&x,sizeof(float));
return v;
}
/*}}}*/
static struct Value *fn_mkd(struct Value *v, struct Auto *stack) /*{{{*/
{
double x=realValue(stack,0);
Value_new_STRING(v);
String_size(&v->u.string,sizeof(double));
memcpy(v->u.string.character,&x,sizeof(double));
return v;
}
/*}}}*/
static struct Value *fn_oct(struct Value *v, struct Auto *stack) /*{{{*/
{
char buf[sizeof(long int)*3+1];
sprintf(buf,"%lo",intValue(stack,0));
Value_new_STRING(v);
String_appendChars(&v->u.string,buf);
return v;
}
/*}}}*/
static struct Value *fn_pi(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,M_PI);
}
/*}}}*/
static struct Value *fn_peek(struct Value *v, struct Auto *stack) /*{{{*/
{
int r=FS_memInput(intValue(stack,0));
if (r==-1)
{
return Value_new_ERROR(v,IOERROR,FS_errmsg);
}
else return Value_new_INTEGER(v,r);
}
/*}}}*/
static struct Value *fn_pos(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,FS_charpos(STDCHANNEL)+1);
}
/*}}}*/
static struct Value *fn_rad(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,(realValue(stack,0)*M_PI)/180.0);
}
/*}}}*/
static struct Value *fn_right(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
int len=s->length;
int right=intValue(stack,1)<len ? intValue(stack,1) : len;
if (right<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
Value_new_STRING(v);
String_size(&v->u.string,right);
if (right) memcpy(v->u.string.character,s->character+len-right,right);
return v;
}
/*}}}*/
static struct Value *fn_rnd(struct Value *v, struct Auto *stack) /*{{{*/
{
return rnd(v,0);
}
/*}}}*/
static struct Value *fn_rndi(struct Value *v, struct Auto *stack) /*{{{*/
{
return rnd(v,intValue(stack,0));
}
/*}}}*/
static struct Value *fn_rndd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int limit;
limit=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("limit"));
return rnd(v,limit);
}
/*}}}*/
static struct Value *fn_rtrim(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
int len=s->length;
int lastSpace;
for (lastSpace=len; lastSpace>0 && s->character[lastSpace-1]==' '; --lastSpace);
Value_new_STRING(v);
String_size(&v->u.string,lastSpace);
if (lastSpace) memcpy(v->u.string.character,s->character,lastSpace);
return v;
}
/*}}}*/
static struct Value *fn_sgn(struct Value *v, struct Auto *stack) /*{{{*/
{
double x=realValue(stack,0);
return Value_new_INTEGER(v,x<0.0 ? -1 : (x==0.0 ? 0 : 1));
}
/*}}}*/
static struct Value *fn_sin(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,sin(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_space(struct Value *v, struct Auto *stack) /*{{{*/
{
long int len=intValue(stack,0);
if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
Value_new_STRING(v);
String_size(&v->u.string,len);
if (len) memset(v->u.string.character,' ',len);
return v;
}
/*}}}*/
static struct Value *fn_sqr(struct Value *v, struct Auto *stack) /*{{{*/
{
if (realValue(stack,0)<0.0) Value_new_ERROR(v,OUTOFRANGE,_("Square root argument"));
else Value_new_REAL(v,sqrt(realValue(stack,0)));
return v;
}
/*}}}*/
static struct Value *fn_str(struct Value *v, struct Auto *stack) /*{{{*/
{
struct Value value,*arg;
struct String s;
arg=Var_value(Auto_local(stack,0),0,(int*)0,&value);
assert(arg->type!=V_ERROR);
String_new(&s);
Value_toString(arg,&s,' ',-1,0,0,0,0,-1,0,0);
v->type=V_STRING;
v->u.string=s;
return v;
}
/*}}}*/
static struct Value *fn_stringii(struct Value *v, struct Auto *stack) /*{{{*/
{
return string(v,intValue(stack,0),intValue(stack,1));
}
/*}}}*/
static struct Value *fn_stringid(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int chr;
chr=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
return string(v,intValue(stack,0),chr);
}
/*}}}*/
static struct Value *fn_stringdi(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int len;
len=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
return string(v,len,intValue(stack,1));
}
/*}}}*/
static struct Value *fn_stringdd(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int len,chr;
len=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
chr=Value_toi(realValue(stack,1),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
return string(v,len,chr);
}
/*}}}*/
static struct Value *fn_stringis(struct Value *v, struct Auto *stack) /*{{{*/
{
if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string"));
return string(v,intValue(stack,0),stringValue(stack,1)->character[0]);
}
/*}}}*/
static struct Value *fn_stringds(struct Value *v, struct Auto *stack) /*{{{*/
{
int overflow;
long int len;
len=Value_toi(realValue(stack,0),&overflow);
if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string"));
return string(v,len,stringValue(stack,1)->character[0]);
}
/*}}}*/
static struct Value *fn_strip(struct Value *v, struct Auto *stack) /*{{{*/
{
size_t i;
Value_new_STRING(v);
String_appendString(&v->u.string,stringValue(stack,0));
for (i=0; i<v->u.string.length; ++i) v->u.string.character[i]&=0x7f;
return v;
}
/*}}}*/
static struct Value *fn_tan(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_REAL(v,tan(realValue(stack,0)));
}
/*}}}*/
static struct Value *fn_timei(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,(unsigned long)(times((struct tms*)0)/(sysconf(_SC_CLK_TCK)/100.0)));
}
/*}}}*/
static struct Value *fn_times(struct Value *v, struct Auto *stack) /*{{{*/
{
time_t t;
struct tm *now;
Value_new_STRING(v);
String_size(&v->u.string,8);
time(&t);
now=localtime(&t);
sprintf(v->u.string.character,"%02d:%02d:%02d",now->tm_hour,now->tm_min,now->tm_sec);
return v;
}
/*}}}*/
static struct Value *fn_timer(struct Value *v, struct Auto *stack) /*{{{*/
{
time_t t;
struct tm *l;
time(&t);
l=localtime(&t);
return Value_new_REAL(v,l->tm_hour*3600+l->tm_min*60+l->tm_sec);
}
/*}}}*/
static struct Value *fn_tl(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
Value_new_STRING(v);
if (s->length)
{
int tail=s->length-1;
String_size(&v->u.string,tail);
if (s->length) memcpy(v->u.string.character,s->character+1,tail);
}
return v;
}
/*}}}*/
static struct Value *fn_true(struct Value *v, struct Auto *stack) /*{{{*/
{
return Value_new_INTEGER(v,-1);
}
/*}}}*/
static struct Value *fn_ucase(struct Value *v, struct Auto *stack) /*{{{*/
{
Value_new_STRING(v);
String_appendString(&v->u.string,stringValue(stack,0));
String_ucase(&v->u.string);
return v;
}
/*}}}*/
static struct Value *fn_val(struct Value *v, struct Auto *stack) /*{{{*/
{
struct String *s=stringValue(stack,0);
char *end;
long int i;
int overflow;
if (s->character==(char*)0) return Value_new_REAL(v,0.0);
i=Value_vali(s->character,&end,&overflow);
if (*end=='\0') return Value_new_INTEGER(v,i);
else return Value_new_REAL(v,Value_vald(s->character,(char**)0,&overflow));
}
/*}}}*/
static unsigned int hash(const char *s) /*{{{*/
{
unsigned int h=0;
while (*s)
{
h=h*256+tolower(*s);
++s;
}
return h%GLOBAL_HASHSIZE;
}
/*}}}*/
static void builtin(struct Global *this, const char *ident, enum ValueType type, struct Value *(* func)(struct Value *value, struct Auto *stack), int argLength, ...) /*{{{*/
{
struct Symbol **r;
struct Symbol *s,**sptr;
int i;
va_list ap;
for
(
r=&this->table[hash(ident)];
*r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident);
r=&((*r)->next)
);
if (*r==(struct Symbol*)0)
{
*r=malloc(sizeof(struct Symbol));
(*r)->name=strcpy(malloc(strlen(ident)+1),ident);
(*r)->next=(struct Symbol*)0;
s=(*r);
}
else
{
for (sptr=&((*r)->u.sub.u.bltin.next); *sptr; sptr=&((*sptr)->u.sub.u.bltin.next));
*sptr=s=malloc(sizeof(struct Symbol));
}
s->u.sub.u.bltin.next=(struct Symbol*)0;
s->type=BUILTINFUNCTION;
s->u.sub.argLength=argLength;
s->u.sub.argTypes=argLength ? malloc(sizeof(enum ValueType)*argLength) : (enum ValueType*)0;
s->u.sub.retType=type;
va_start(ap,argLength);
for (i=0; i<argLength; ++i)
{
s->u.sub.argTypes[i]=va_arg(ap,enum ValueType);
}
va_end(ap);
s->u.sub.u.bltin.call=func;
}
/*}}}*/
struct Global *Global_new(struct Global *this) /*{{{*/
{
builtin(this,"abs", V_REAL, fn_abs, 1,V_REAL);
builtin(this,"asc", V_INTEGER,fn_asc, 1,V_STRING);
builtin(this,"atn", V_REAL, fn_atn, 1,V_REAL);
builtin(this,"bin$", V_STRING, fn_bini, 1,V_INTEGER);
builtin(this,"bin$", V_STRING, fn_bind, 1,V_REAL);
builtin(this,"bin$", V_STRING, fn_binii, 2,V_INTEGER,V_INTEGER);
builtin(this,"bin$", V_STRING, fn_bindi, 2,V_REAL,V_INTEGER);
builtin(this,"bin$", V_STRING, fn_binid, 2,V_INTEGER,V_REAL);
builtin(this,"bin$", V_STRING, fn_bindd, 2,V_REAL,V_REAL);
builtin(this,"chr$", V_STRING, fn_chr, 1,V_INTEGER);
builtin(this,"cint", V_REAL, fn_cint, 1,V_REAL);
builtin(this,"code", V_INTEGER,fn_asc, 1,V_STRING);
builtin(this,"command$",V_STRING, fn_command, 0);
builtin(this,"command$",V_STRING, fn_commandi, 1,V_INTEGER);
builtin(this,"command$",V_STRING, fn_commandd, 1,V_REAL);
builtin(this,"cos", V_REAL, fn_cos, 1,V_REAL);
builtin(this,"cvi", V_INTEGER,fn_cvi, 1,V_STRING);
builtin(this,"cvs", V_REAL, fn_cvs, 1,V_STRING);
builtin(this,"cvd", V_REAL, fn_cvd, 1,V_STRING);
builtin(this,"date$", V_STRING, fn_date, 0);
builtin(this,"dec$", V_STRING, fn_dec, 2,V_REAL,V_STRING);
builtin(this,"dec$", V_STRING, fn_dec, 2,V_INTEGER,V_STRING);
builtin(this,"dec$", V_STRING, fn_dec, 2,V_STRING,V_STRING);
builtin(this,"deg", V_REAL, fn_deg, 1,V_REAL);
builtin(this,"det", V_REAL, fn_det, 0);
builtin(this,"edit$", V_STRING, fn_edit, 2,V_STRING,V_INTEGER);
builtin(this,"environ$",V_STRING, fn_environi, 1,V_INTEGER);
builtin(this,"environ$",V_STRING, fn_environd, 1,V_REAL);
builtin(this,"environ$",V_STRING, fn_environs, 1,V_STRING);
builtin(this,"eof", V_INTEGER,fn_eof, 1,V_INTEGER);
builtin(this,"erl", V_INTEGER,fn_erl, 0);
builtin(this,"err", V_INTEGER,fn_err, 0);
builtin(this,"exp", V_REAL, fn_exp, 1,V_REAL);
builtin(this,"false", V_INTEGER,fn_false, 0);
builtin(this,"find$", V_STRING, fn_find, 1,V_STRING);
builtin(this,"find$", V_STRING, fn_findi, 2,V_STRING,V_INTEGER);
builtin(this,"find$", V_STRING, fn_findd, 2,V_STRING,V_REAL);
builtin(this,"fix", V_REAL, fn_fix, 1,V_REAL);
builtin(this,"frac", V_REAL, fn_frac, 1,V_REAL);
builtin(this,"freefile",V_INTEGER,fn_freefile, 0);
builtin(this,"fp", V_REAL, fn_frac, 1,V_REAL);
builtin(this,"hex$", V_STRING, fn_hexi, 1,V_INTEGER);
builtin(this,"hex$", V_STRING, fn_hexd, 1,V_REAL);
builtin(this,"hex$", V_STRING, fn_hexii, 2,V_INTEGER,V_INTEGER);
builtin(this,"hex$", V_STRING, fn_hexdi, 2,V_REAL,V_INTEGER);
builtin(this,"hex$", V_STRING, fn_hexid, 2,V_INTEGER,V_REAL);
builtin(this,"hex$", V_STRING, fn_hexdd, 2,V_REAL,V_REAL);
builtin(this,"inkey$", V_STRING, fn_inkey, 0);
builtin(this,"inkey$", V_STRING, fn_inkeyi, 1,V_INTEGER);
builtin(this,"inkey$", V_STRING, fn_inkeyd, 1,V_REAL);
builtin(this,"inkey$", V_STRING, fn_inkeyii, 2,V_INTEGER,V_INTEGER);
builtin(this,"inkey$", V_STRING, fn_inkeyid, 2,V_INTEGER,V_REAL);
builtin(this,"inkey$", V_STRING, fn_inkeydi, 2,V_REAL,V_INTEGER);
builtin(this,"inkey$", V_STRING, fn_inkeydd, 2,V_REAL,V_REAL);
builtin(this,"inp", V_INTEGER,fn_inp, 1,V_INTEGER);
builtin(this,"input$", V_STRING, fn_input1, 1,V_INTEGER);
builtin(this,"input$", V_STRING, fn_input2, 2,V_INTEGER,V_INTEGER);
builtin(this,"instr", V_INTEGER,fn_instr2, 2,V_STRING,V_STRING);
builtin(this,"instr", V_INTEGER,fn_instr3iss, 3,V_INTEGER,V_STRING,V_STRING);
builtin(this,"instr", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER);
builtin(this,"instr", V_INTEGER,fn_instr3dss, 3,V_REAL,V_STRING,V_STRING);
builtin(this,"instr", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL);
builtin(this,"instr", V_INTEGER,fn_instr4ii, 4,V_STRING,V_STRING,V_INTEGER,V_INTEGER);
builtin(this,"instr", V_INTEGER,fn_instr4id, 4,V_STRING,V_STRING,V_INTEGER,V_REAL);
builtin(this,"instr", V_INTEGER,fn_instr4di, 4,V_STRING,V_STRING,V_REAL,V_INTEGER);
builtin(this,"instr", V_INTEGER,fn_instr4dd, 4,V_STRING,V_STRING,V_REAL,V_REAL);
builtin(this,"int", V_REAL, fn_int, 1,V_REAL);
builtin(this,"int%", V_INTEGER,fn_intp, 1,V_REAL);
builtin(this,"ip", V_REAL, fn_fix, 1,V_REAL);
builtin(this,"lcase$", V_STRING, fn_lcase, 1,V_STRING);
builtin(this,"lower$", V_STRING, fn_lcase, 1,V_STRING);
builtin(this,"left$", V_STRING, fn_left, 2,V_STRING,V_INTEGER);
builtin(this,"len", V_INTEGER,fn_len, 1,V_STRING);
builtin(this,"loc", V_INTEGER,fn_loc, 1,V_INTEGER);
builtin(this,"lof", V_INTEGER,fn_lof, 1,V_INTEGER);
builtin(this,"log", V_REAL, fn_log, 1,V_REAL);
builtin(this,"log10", V_REAL, fn_log10, 1,V_REAL);
builtin(this,"log2", V_REAL, fn_log2, 1,V_REAL);
builtin(this,"ltrim$", V_STRING, fn_ltrim, 1,V_STRING);
builtin(this,"match", V_INTEGER,fn_match, 3,V_STRING,V_STRING,V_INTEGER);
builtin(this,"max", V_INTEGER,fn_maxii, 2,V_INTEGER,V_INTEGER);
builtin(this,"max", V_REAL, fn_maxdi, 2,V_REAL,V_INTEGER);
builtin(this,"max", V_REAL, fn_maxid, 2,V_INTEGER,V_REAL);
builtin(this,"max", V_REAL, fn_maxdd, 2,V_REAL,V_REAL);
builtin(this,"mid$", V_STRING, fn_mid2i, 2,V_STRING,V_INTEGER);
builtin(this,"mid$", V_STRING, fn_mid2d, 2,V_STRING,V_REAL);
builtin(this,"mid$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER);
builtin(this,"mid$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL);
builtin(this,"mid$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER);
builtin(this,"mid$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL);
builtin(this,"min", V_INTEGER,fn_minii, 2,V_INTEGER,V_INTEGER);
builtin(this,"min", V_REAL, fn_mindi, 2,V_REAL,V_INTEGER);
builtin(this,"min", V_REAL, fn_minid, 2,V_INTEGER,V_REAL);
builtin(this,"min", V_REAL, fn_mindd, 2,V_REAL,V_REAL);
builtin(this,"mki$", V_STRING, fn_mki, 1,V_INTEGER);
builtin(this,"mks$", V_STRING, fn_mks, 1,V_REAL);
builtin(this,"mkd$", V_STRING, fn_mkd, 1,V_REAL);
builtin(this,"oct$", V_STRING, fn_oct, 1,V_INTEGER);
builtin(this,"peek", V_INTEGER,fn_peek, 1,V_INTEGER);
builtin(this,"pi", V_REAL, fn_pi, 0);
builtin(this,"pos", V_INTEGER,fn_pos, 1,V_INTEGER);
builtin(this,"pos", V_INTEGER,fn_pos, 1,V_REAL);
builtin(this,"pos", V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER);
builtin(this,"pos", V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL);
builtin(this,"rad", V_REAL, fn_rad, 1,V_REAL);
builtin(this,"right$", V_STRING, fn_right, 2,V_STRING,V_INTEGER);
builtin(this,"rnd", V_INTEGER,fn_rnd, 0);
builtin(this,"rnd", V_INTEGER,fn_rndd, 1,V_REAL);
builtin(this,"rnd", V_INTEGER,fn_rndi, 1,V_INTEGER);
builtin(this,"rtrim$", V_STRING, fn_rtrim, 1,V_STRING);
builtin(this,"seg$", V_STRING, fn_mid3ii, 3,V_STRING,V_INTEGER,V_INTEGER);
builtin(this,"seg$", V_STRING, fn_mid3id, 3,V_STRING,V_INTEGER,V_REAL);
builtin(this,"seg$", V_STRING, fn_mid3di, 3,V_STRING,V_REAL,V_INTEGER);
builtin(this,"seg$", V_STRING, fn_mid3dd, 3,V_STRING,V_REAL,V_REAL);
builtin(this,"sgn", V_INTEGER,fn_sgn, 1,V_REAL);
builtin(this,"sin", V_REAL, fn_sin, 1,V_REAL);
builtin(this,"space$", V_STRING, fn_space, 1,V_INTEGER);
builtin(this,"sqr", V_REAL, fn_sqr, 1,V_REAL);
builtin(this,"str$", V_STRING, fn_str, 1,V_REAL);
builtin(this,"str$", V_STRING, fn_str, 1,V_INTEGER);
builtin(this,"string$", V_STRING, fn_stringii, 2,V_INTEGER,V_INTEGER);
builtin(this,"string$", V_STRING, fn_stringid, 2,V_INTEGER,V_REAL);
builtin(this,"string$", V_STRING, fn_stringdi, 2,V_REAL,V_INTEGER);
builtin(this,"string$", V_STRING, fn_stringdd, 2,V_REAL,V_REAL);
builtin(this,"string$", V_STRING, fn_stringis, 2,V_INTEGER,V_STRING);
builtin(this,"string$", V_STRING, fn_stringds, 2,V_REAL,V_STRING);
builtin(this,"strip$", V_STRING, fn_strip, 1,V_STRING);
builtin(this,"tan", V_REAL, fn_tan, 1,V_REAL);
builtin(this,"time", V_INTEGER,fn_timei, 0);
builtin(this,"time$", V_STRING, fn_times, 0);
builtin(this,"timer", V_REAL, fn_timer, 0);
builtin(this,"tl$", V_STRING, fn_tl, 1,V_STRING);
builtin(this,"true", V_INTEGER,fn_true, 0);
builtin(this,"ucase$", V_STRING, fn_ucase, 1,V_STRING);
builtin(this,"upper$", V_STRING, fn_ucase, 1,V_STRING);
builtin(this,"val", V_REAL, fn_val, 1,V_STRING);
return this;
}
/*}}}*/
int Global_find(struct Global *this, struct Identifier *ident, int oparen) /*{{{*/
{
struct Symbol **r;
for
(
r=&this->table[hash(ident->name)];
*r!=(struct Symbol*)0 && ((((*r)->type==GLOBALVAR && oparen) || ((*r)->type==GLOBALARRAY && !oparen)) || cistrcmp((*r)->name,ident->name));
r=&((*r)->next)
);
if (*r==(struct Symbol*)0) return 0;
ident->sym=(*r);
return 1;
}
/*}}}*/
int Global_variable(struct Global *this, struct Identifier *ident, enum ValueType type, enum SymbolType symbolType, int redeclare) /*{{{*/
{
struct Symbol **r;
for
(
r=&this->table[hash(ident->name)];
*r!=(struct Symbol*)0 && ((*r)->type!=symbolType || cistrcmp((*r)->name,ident->name));
r=&((*r)->next)
);
if (*r==(struct Symbol*)0)
{
*r=malloc(sizeof(struct Symbol));
(*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name);
(*r)->next=(struct Symbol*)0;
(*r)->type=symbolType;
Var_new(&((*r)->u.var),type,0,(unsigned int*)0,0);
}
else if (redeclare) Var_retype(&((*r)->u.var),type);
switch ((*r)->type)
{
case GLOBALVAR:
case GLOBALARRAY:
{
ident->sym=(*r);
break;
}
case BUILTINFUNCTION:
{
return 0;
}
case USERFUNCTION:
{
return 0;
}
default: assert(0);
}
return 1;
}
/*}}}*/
int Global_function(struct Global *this, struct Identifier *ident, enum ValueType type, struct Pc *deffn, struct Pc *begin, int argLength, enum ValueType *argTypes) /*{{{*/
{
struct Symbol **r;
for
(
r=&this->table[hash(ident->name)];
*r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name);
r=&((*r)->next)
);
if (*r!=(struct Symbol*)0) return 0;
*r=malloc(sizeof(struct Symbol));
(*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name);
(*r)->next=(struct Symbol*)0;
(*r)->type=USERFUNCTION;
(*r)->u.sub.u.def.scope.start=*deffn;
(*r)->u.sub.u.def.scope.begin=*begin;
(*r)->u.sub.argLength=argLength;
(*r)->u.sub.argTypes=argTypes;
(*r)->u.sub.retType=type;
(*r)->u.sub.u.def.localLength=0;
(*r)->u.sub.u.def.localTypes=(enum ValueType*)0;
ident->sym=(*r);
return 1;
}
/*}}}*/
void Global_endfunction(struct Global *this, struct Identifier *ident, struct Pc *end) /*{{{*/
{
struct Symbol **r;
for
(
r=&this->table[hash(ident->name)];
*r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name);
r=&((*r)->next)
);
assert(*r!=(struct Symbol*)0);
(*r)->u.sub.u.def.scope.end=*end;
}
/*}}}*/
void Global_clear(struct Global *this) /*{{{*/
{
int i;
for (i=0; i<GLOBAL_HASHSIZE; ++i)
{
struct Symbol *v;
for (v=this->table[i]; v; v=v->next)
{
if (v->type==GLOBALVAR || v->type==GLOBALARRAY) Var_clear(&(v->u.var));
}
}
}
/*}}}*/
void Global_clearFunctions(struct Global *this) /*{{{*/
{
int i;
for (i=0; i<GLOBAL_HASHSIZE; ++i)
{
struct Symbol **v=&this->table[i],*w;
struct Symbol *sym;
while (*v)
{
sym=*v;
w=sym->next;
if (sym->type==USERFUNCTION)
{
if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes);
if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
free(sym->name);
free(sym);
*v=w;
}
else v=&sym->next;
}
}
}
/*}}}*/
void Global_destroy(struct Global *this) /*{{{*/
{
int i;
for (i=0; i<GLOBAL_HASHSIZE; ++i)
{
struct Symbol *v=this->table[i],*w;
struct Symbol *sym;
while (v)
{
sym=v;
w=v->next;
switch (sym->type)
{
case GLOBALVAR:
case GLOBALARRAY: Var_destroy(&(sym->u.var)); break;
case USERFUNCTION:
{
if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes);
if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
break;
}
case BUILTINFUNCTION:
{
if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
if (sym->u.sub.u.bltin.next)
{
sym=sym->u.sub.u.bltin.next;
while (sym)
{
struct Symbol *n;
if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
n=sym->u.sub.u.bltin.next;
free(sym);
sym=n;
}
}
break;
}
default: assert(0);
}
free(v->name);
free(v);
v=w;
}
this->table[i]=(struct Symbol*)0;
}
}
/*}}}*/
Reference in New Issue View Git Blame Copy Permalink