/* Global variables and functions. */ /* #includes */ /*{{{C}}}*//*{{{*/ #include "config.h" #include #include #include #include #include #ifdef HAVE_GETTEXT #include #define _(String) gettext(String) #else #define _(String) String #endif #include #include #include #include #include #include #include #include "auto.h" #include "bas.h" #include "error.h" #include "fs.h" #include "global.h" #include "var.h" #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; iu.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; iu.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 (rdbegin) { 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)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; spacescharacter[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; ny?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,xu.string,sizeof(long int)); for (i=0; i>=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)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; iu.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; iu.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; itable[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; 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: { 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; } } /*}}}*/