"Fossies" - the Fresh Open Source Software Archive

Member "bas-2.6/global.c" (2 Jul 2019, 52961 Bytes) of package /linux/privat/bas-2.6.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "global.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.5_vs_2.6.

    1 /* Global variables and functions. */
    2 /* #includes */ /*{{{C}}}*//*{{{*/
    3 #include "config.h"
    4 
    5 #include <sys/times.h>
    6 #include <assert.h>
    7 #include <ctype.h>
    8 #include <dirent.h>
    9 #include <errno.h>
   10 #ifdef HAVE_GETTEXT
   11 #include <libintl.h>
   12 #define _(String) gettext(String)
   13 #else
   14 #define _(String) String
   15 #endif
   16 #include <math.h>
   17 #include <stdarg.h>
   18 #include <stdlib.h>
   19 #include <stdio.h>
   20 #include <string.h>
   21 #include <time.h>
   22 #include <unistd.h>
   23 
   24 #include "auto.h"
   25 #include "bas.h"
   26 #include "error.h"
   27 #include "fs.h"
   28 #include "global.h"
   29 #include "var.h"
   30 
   31 #ifdef USE_DMALLOC
   32 #include "dmalloc.h"
   33 #endif
   34 /*}}}*/
   35 /* #defines */ /*{{{*/
   36 #ifndef M_PI
   37 #define M_PI 3.14159265358979323846
   38 #endif
   39 /*}}}*/
   40 
   41 extern char **environ;
   42 
   43 static int wildcardmatch(const char *a, const char *pattern) /*{{{*/
   44 {
   45   while (*pattern)
   46   {
   47     switch (*pattern)
   48     {
   49       case '*':
   50       {
   51         ++pattern;
   52         while (*a) if (wildcardmatch(a,pattern)) return 1; else ++a;
   53         break;
   54       }
   55       case '?':
   56       {
   57         if (*a) { ++a; ++pattern; } else return 0;
   58         break;
   59       }
   60       default: if (*a==*pattern) { ++a; ++pattern; } else return 0;
   61     }
   62   }
   63   return (*pattern=='\0' && *a=='\0');
   64 }
   65 /*}}}*/
   66 
   67 static long int intValue(struct Auto *stack, int l) /*{{{*/
   68 {
   69   struct Value value;
   70   struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
   71   assert(arg->type==V_INTEGER);
   72   return arg->u.integer;
   73 }
   74 /*}}}*/
   75 static double realValue(struct Auto *stack, int l) /*{{{*/
   76 {
   77   struct Value value;
   78   struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
   79   assert(arg->type==V_REAL);
   80   return arg->u.real;
   81 }
   82 /*}}}*/
   83 static struct String *stringValue(struct Auto *stack, int l) /*{{{*/
   84 {
   85   struct Value value;
   86   struct Value *arg=Var_value(Auto_local(stack,l),0,(int*)0,&value);
   87   assert(arg->type==V_STRING);
   88   return &(arg->u.string);
   89 }
   90 /*}}}*/
   91 
   92 static struct Value *bin(struct Value *v, unsigned long int value, long int digits) /*{{{*/
   93 {
   94   char buf[sizeof(long int)*8+1];
   95   char *s;
   96   
   97   Value_new_STRING(v);
   98   s=buf+sizeof(buf);
   99   *--s='\0';
  100   if (digits==0) digits=1;
  101   while (digits || value)
  102   {
  103     *--s=value&1?'1':'0';
  104     if (digits) --digits;
  105     value>>=1;
  106   }
  107   String_appendChars(&v->u.string,s);
  108   return v;
  109 }
  110 /*}}}*/
  111 static struct Value *hex(struct Value *v, long int value, long int digits) /*{{{*/
  112 {
  113   char buf[sizeof(long int)*2+1];
  114 
  115   sprintf(buf,"%0*lx",(int)digits,value);
  116   Value_new_STRING(v);
  117   String_appendChars(&v->u.string,buf);
  118   return v;
  119 }
  120 /*}}}*/
  121 static struct Value *find(struct Value *v, struct String *pattern, long int occurence) /*{{{*/
  122 {
  123   struct String dirname,basename;
  124   char *slash;
  125   DIR *dir;
  126   struct dirent *ent;
  127   int currentdir;
  128   int found=0;
  129   
  130   Value_new_STRING(v);
  131   String_new(&dirname);
  132   String_new(&basename);
  133   String_appendString(&dirname,pattern);
  134   while (dirname.length>0 && dirname.character[dirname.length-1]=='/') String_delete(&dirname,dirname.length-1,1);
  135   if ((slash=strrchr(dirname.character,'/'))==(char*)0)
  136   {
  137     String_appendString(&basename,&dirname);
  138     String_delete(&dirname,0,dirname.length);
  139     String_appendChar(&dirname,'.');
  140     currentdir=1;
  141   }
  142   else
  143   {
  144     String_appendChars(&basename,slash+1);
  145     String_delete(&dirname,slash-dirname.character,dirname.length-(slash-dirname.character));
  146     currentdir=0;
  147   }
  148   if ((dir=opendir(dirname.character))!=(DIR*)0)
  149   {
  150     while ((ent=readdir(dir))!=(struct dirent*)0)
  151     {
  152       if (wildcardmatch(ent->d_name,basename.character))
  153       {
  154         if (found==occurence)
  155         {
  156           if (currentdir) String_appendChars(&v->u.string,ent->d_name);
  157           else String_appendPrintf(&v->u.string,"%s/%s",dirname.character,ent->d_name);
  158           break;
  159         }
  160         ++found;
  161       }
  162     }
  163     closedir(dir);
  164   }
  165   String_destroy(&dirname);
  166   String_destroy(&basename);
  167   return v;
  168 }
  169 /*}}}*/
  170 static struct Value *instr(struct Value *v, long int start, long int len, struct String *haystack, struct String *needle) /*{{{*/
  171 {
  172   const char *haystackChars=haystack->character;
  173   size_t haystackLength=haystack->length;
  174   const char *needleChars=needle->character;
  175   size_t needleLength=needle->length;
  176   int found;
  177 
  178   --start;
  179   if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
  180   if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  181   if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0);
  182   haystackChars+=start; haystackLength-=start;
  183   if (haystackLength>len) haystackLength=len;
  184   found=1+start;
  185   while (needleLength<=haystackLength)
  186   {
  187     if (memcmp(haystackChars,needleChars,needleLength)==0) return Value_new_INTEGER(v,found);
  188     ++haystackChars; --haystackLength;
  189     ++found;
  190   }
  191   return Value_new_INTEGER(v,0);
  192 }
  193 /*}}}*/
  194 static struct Value *string(struct Value *v, long int len, int c) /*{{{*/
  195 {
  196   if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  197   if (c<0 || c>255) return Value_new_ERROR(v,OUTOFRANGE,_("code"));
  198 
  199   Value_new_STRING(v);
  200   String_size(&v->u.string,len);
  201   if (len) memset(v->u.string.character,c,len);
  202   return v;
  203 }
  204 /*}}}*/
  205 static struct Value *mid(struct Value *v, struct String *s, long int position, long int length) /*{{{*/
  206 {
  207   --position;
  208   if (position<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
  209   if (length<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  210   if (((size_t)position)+length>s->length)
  211   {
  212     length=s->length-position;
  213     if (length<0) length=0;
  214   }
  215   Value_new_STRING(v);
  216   String_size(&v->u.string,length);
  217   if (length>0) memcpy(v->u.string.character,s->character+position,length);
  218   return v;
  219 }
  220 /*}}}*/
  221 static struct Value *inkey(struct Value *v, long int timeout, long int chn) /*{{{*/
  222 {
  223   int c;
  224 
  225   if ((c=FS_inkeyChar(chn,timeout*10))==-1)
  226   {
  227     if (FS_errmsg) return Value_new_ERROR(v,IOERROR,FS_errmsg);
  228     else return Value_new_STRING(v);
  229   }
  230   else
  231   {
  232     Value_new_STRING(v);
  233     String_appendChar(&v->u.string,c);
  234     return v;
  235   }
  236 }
  237 /*}}}*/
  238 static struct Value *input(struct Value *v, long int len, long int chn) /*{{{*/
  239 {
  240   int ch=-1;
  241 
  242   if (len<=0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  243   Value_new_STRING(v);
  244   while (len-- && (ch=FS_getChar(chn))!=-1) String_appendChar(&v->u.string,ch);
  245   if (ch==-1)
  246   {
  247     Value_destroy(v);
  248     return Value_new_ERROR(v,IOERROR,FS_errmsg);
  249   }
  250   return v;
  251 }
  252 /*}}}*/
  253 static struct Value *env(struct Value *v, long int n) /*{{{*/
  254 {
  255   int i;
  256 
  257   --n;
  258   if (n<0) return Value_new_ERROR(v,OUTOFRANGE,_("variable number"));
  259   for (i=0; i<n && environ[i]; ++i);
  260   Value_new_STRING(v);
  261   if (i==n && environ[i]) String_appendChars(&v->u.string,environ[i]);
  262   return v;
  263 }
  264 /*}}}*/
  265 static struct Value *rnd(struct Value *v, long int x) /*{{{*/
  266 {
  267   if (x<0) srand(-x);
  268   if (x==0 || x==1) Value_new_REAL(v,rand()/(double)RAND_MAX);
  269   else Value_new_REAL(v,rand()%x+1);
  270   return v;
  271 }
  272 /*}}}*/
  273 
  274 static struct Value *fn_abs(struct Value *v, struct Auto *stack) /*{{{*/
  275 {
  276   return Value_new_REAL(v,fabs(realValue(stack,0)));
  277 }
  278 /*}}}*/
  279 static struct Value *fn_asc(struct Value *v, struct Auto *stack) /*{{{*/
  280 {
  281   struct String *s=stringValue(stack,0);
  282 
  283   if (s->length==0) return Value_new_ERROR(v,UNDEFINED,_("`asc' or `code' of empty string"));
  284   return Value_new_INTEGER(v,s->character[0]&0xff);
  285 }
  286 /*}}}*/
  287 static struct Value *fn_atn(struct Value *v, struct Auto *stack) /*{{{*/
  288 {
  289   return Value_new_REAL(v,atan(realValue(stack,0)));
  290 }
  291 /*}}}*/
  292 static struct Value *fn_bini(struct Value *v, struct Auto *stack) /*{{{*/
  293 {
  294   return bin(v,intValue(stack,0),0);
  295 }
  296 /*}}}*/
  297 static struct Value *fn_bind(struct Value *v, struct Auto *stack) /*{{{*/
  298 {
  299   int overflow;
  300   long int n;
  301 
  302   n=Value_toi(realValue(stack,0),&overflow);
  303   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  304   return bin(v,n,0);
  305 }
  306 /*}}}*/
  307 static struct Value *fn_binii(struct Value *v, struct Auto *stack) /*{{{*/
  308 {
  309   return bin(v,intValue(stack,0),intValue(stack,1));
  310 }
  311 /*}}}*/
  312 static struct Value *fn_bindi(struct Value *v, struct Auto *stack) /*{{{*/
  313 {
  314   int overflow;
  315   long int n;
  316 
  317   n=Value_toi(realValue(stack,0),&overflow);
  318   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  319   return bin(v,n,intValue(stack,1));
  320 }
  321 /*}}}*/
  322 static struct Value *fn_binid(struct Value *v, struct Auto *stack) /*{{{*/
  323 {
  324   int overflow;
  325   long int digits;
  326 
  327   digits=Value_toi(realValue(stack,1),&overflow);
  328   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
  329   return bin(v,intValue(stack,0),digits);
  330 }
  331 /*}}}*/
  332 static struct Value *fn_bindd(struct Value *v, struct Auto *stack) /*{{{*/
  333 {
  334   int overflow;
  335   long int n,digits;
  336 
  337   n=Value_toi(realValue(stack,0),&overflow);
  338   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  339   digits=Value_toi(realValue(stack,1),&overflow);
  340   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
  341   return bin(v,n,digits);
  342 }
  343 /*}}}*/
  344 static struct Value *fn_chr(struct Value *v, struct Auto *stack) /*{{{*/
  345 {
  346   long int chr=intValue(stack,0);
  347 
  348   if (chr<0 || chr>255) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
  349   Value_new_STRING(v);
  350   String_size(&v->u.string,1);
  351   v->u.string.character[0]=chr;
  352   return v;
  353 }
  354 /*}}}*/
  355 static struct Value *fn_cint(struct Value *v, struct Auto *stack) /*{{{*/
  356 {
  357   return Value_new_REAL(v,ceil(realValue(stack,0)));
  358 }
  359 /*}}}*/
  360 static struct Value *fn_cos(struct Value *v, struct Auto *stack) /*{{{*/
  361 {
  362   return Value_new_REAL(v,cos(realValue(stack,0)));
  363 }
  364 /*}}}*/
  365 static struct Value *fn_command(struct Value *v, struct Auto *stack) /*{{{*/
  366 {
  367   int i;
  368 
  369   Value_new_STRING(v);
  370   for (i=0; i<bas_argc; ++i)
  371   {
  372     if (i) String_appendChar(&v->u.string,' ');
  373     String_appendChars(&v->u.string,bas_argv[i]);
  374   }
  375   return v;
  376 }
  377 /*}}}*/
  378 static struct Value *fn_commandi(struct Value *v, struct Auto *stack) /*{{{*/
  379 {
  380   int a;
  381 
  382   a=intValue(stack,0);
  383   if (a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number"));
  384   Value_new_STRING(v);
  385   if (a==0)
  386   {
  387     if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0);
  388   }
  389   else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]);
  390   return v;
  391 }
  392 /*}}}*/
  393 static struct Value *fn_commandd(struct Value *v, struct Auto *stack) /*{{{*/
  394 {
  395   int overflow;
  396   long int a;
  397 
  398   a=Value_toi(realValue(stack,0),&overflow);
  399   if (overflow || a<0) return Value_new_ERROR(v,OUTOFRANGE,_("argument number"));
  400   Value_new_STRING(v);
  401   if (a==0)
  402   {
  403     if (bas_argv0!=(char*)0) String_appendChars(&v->u.string,bas_argv0);
  404   }
  405   else if (a<=bas_argc) String_appendChars(&v->u.string,bas_argv[a-1]);
  406   return v;
  407 }
  408 /*}}}*/
  409 static struct Value *fn_cvd(struct Value *v, struct Auto *stack) /*{{{*/
  410 {
  411   struct String *s=stringValue(stack,0);
  412   double n;
  413 
  414   if (s->length!=sizeof(double)) return Value_new_ERROR(v,BADCONVERSION,_("number"));
  415   memcpy(&n,s->character,sizeof(double));
  416   return Value_new_REAL(v,n);
  417 }
  418 /*}}}*/
  419 static struct Value *fn_cvi(struct Value *v, struct Auto *stack) /*{{{*/
  420 {
  421   struct String *s=stringValue(stack,0);
  422   long int n=(s->length && s->character[s->length-1]<0) ? -1 : 0;
  423   int i;
  424   
  425   for (i=s->length-1; i>=0; --i) n=(n<<8)|(s->character[i]&0xff);
  426   return Value_new_INTEGER(v,n);
  427 }
  428 /*}}}*/
  429 static struct Value *fn_cvs(struct Value *v, struct Auto *stack) /*{{{*/
  430 {
  431   struct String *s=stringValue(stack,0);
  432   float n;
  433 
  434   if (s->length!=sizeof(float)) return Value_new_ERROR(v,BADCONVERSION,_("number"));
  435   memcpy(&n,s->character,sizeof(float));
  436   return Value_new_REAL(v,(double)n);
  437 }
  438 /*}}}*/
  439 static struct Value *fn_date(struct Value *v, struct Auto *stack) /*{{{*/
  440 {
  441   time_t t;
  442   struct tm *now;
  443 
  444   Value_new_STRING(v);
  445   String_size(&v->u.string,10);
  446   time(&t);
  447   now=localtime(&t);
  448   sprintf(v->u.string.character,"%02d-%02d-%04d",now->tm_mon+1,now->tm_mday,now->tm_year+1900);
  449   return v;
  450 }
  451 /*}}}*/
  452 static struct Value *fn_dec(struct Value *v, struct Auto *stack) /*{{{*/
  453 {
  454   struct Value value,*arg;
  455   size_t using;
  456 
  457   Value_new_STRING(v);
  458   arg=Var_value(Auto_local(stack,0),0,(int*)0,&value);
  459   using=0;
  460   Value_toStringUsing(arg,&v->u.string,stringValue(stack,1),&using);
  461   return v;
  462 }
  463 /*}}}*/
  464 static struct Value *fn_deg(struct Value *v, struct Auto *stack) /*{{{*/
  465 {
  466   return Value_new_REAL(v,realValue(stack,0)*(180.0/M_PI));
  467 }
  468 /*}}}*/
  469 static struct Value *fn_det(struct Value *v, struct Auto *stack) /*{{{*/
  470 {
  471   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));
  472 }
  473 /*}}}*/
  474 static struct Value *fn_edit(struct Value *v, struct Auto *stack) /*{{{*/
  475 {
  476   int code;
  477   char *begin,*end,*rd,*wr;
  478   char quote;
  479 
  480   code=intValue(stack,1);
  481   Value_new_STRING(v);
  482   String_appendString(&v->u.string,stringValue(stack,0));
  483   begin=rd=wr=v->u.string.character;
  484   end=rd+v->u.string.length;
  485 
  486   /* 8 - Discard Leading Spaces and Tabs */
  487   if (code & 8) while (rd<end && (*rd==' ' || *rd=='\t')) ++rd;
  488 
  489   while (rd<end)
  490   {
  491     /*  1 - Discard parity bit */
  492     if (code&1) *rd=*rd&0x7f;
  493 
  494     /* 2 - Discard all spaces and tabs */
  495     if ((code&2) && (*rd==' ' || *rd=='\t')) { ++rd; continue; }
  496 
  497     /* 4 - Discard all carriage returns, line feeds, form feeds, deletes, escapes, and nulls */
  498     if ((code&4) && (*rd=='\r' || *rd=='\n' || *rd=='\f' || *rd==127 || *rd==27 || *rd=='\0')) { ++rd; continue; }
  499 
  500     /* 16 - Convert Multiple Spaces and Tabs to one space */
  501     if ((code&16) && ((*rd==' ') || (*rd=='\t')))
  502     {
  503       *wr++=' ';
  504       while (rd<end && (*rd==' ' || *rd=='\t')) ++rd; 
  505       continue;
  506     }
  507 
  508     /* 32 - Convert lower to upper case */
  509     if ((code&32) && islower((int)*rd)) { *wr++=toupper((int)*rd++); continue; }
  510 
  511     /* 64 - Convert brackets to parentheses */
  512     if (code&64)
  513     {
  514       if (*rd=='[') { *wr++='('; ++rd; continue; }
  515       else if (*rd==']') { *wr++=')'; ++rd; continue; }
  516     }
  517 
  518     /* 256 - Suppress all editing for characters within quotation marks */
  519     if ((code&256) && (*rd=='"' || *rd=='\''))
  520     {
  521       quote=*rd;
  522       *wr++=*rd++;
  523       while (rd<end && *rd!=quote) *wr++=*rd++;
  524       if (rd<end) { *wr++=*rd++; quote='\0'; }
  525       continue;
  526     }
  527 
  528     *wr++=*rd++;
  529   }
  530 
  531   /*  128 - Discard Trailing Spaces and Tabs */
  532   if ((code & 128) && wr>begin)
  533   {
  534     while (wr>begin && (*(wr-1)=='\0' || *(wr-1)=='\t')) --wr;
  535   }
  536 
  537   String_size(&v->u.string,wr-begin);
  538   return v;
  539 }
  540 /*}}}*/
  541 static struct Value *fn_environi(struct Value *v, struct Auto *stack) /*{{{*/
  542 {
  543   return env(v,intValue(stack,0));
  544 }
  545 /*}}}*/
  546 static struct Value *fn_environd(struct Value *v, struct Auto *stack) /*{{{*/
  547 {
  548   int overflow;
  549   long int n;
  550 
  551   n=Value_toi(realValue(stack,0),&overflow);
  552   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  553   return env(v,n);
  554 }
  555 /*}}}*/
  556 static struct Value *fn_environs(struct Value *v, struct Auto *stack) /*{{{*/
  557 {
  558   char *var;
  559 
  560   Value_new_STRING(v);
  561   if ((var=stringValue(stack,0)->character))
  562   {
  563     char *val=getenv(var);
  564 
  565     if (val) String_appendChars(&v->u.string,val);
  566   }
  567   return v;
  568 }
  569 /*}}}*/
  570 static struct Value *fn_eof(struct Value *v, struct Auto *stack) /*{{{*/
  571 {
  572   int e=FS_eof(intValue(stack,0));
  573 
  574   if (e==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
  575   return Value_new_INTEGER(v,e?-1:0);
  576 }
  577 /*}}}*/
  578 static struct Value *fn_erl(struct Value *v, struct Auto *stack) /*{{{*/
  579 {
  580   return Value_new_INTEGER(v,stack->erl);
  581 }
  582 /*}}}*/
  583 static struct Value *fn_err(struct Value *v, struct Auto *stack) /*{{{*/
  584 {
  585   return Value_new_INTEGER(v,stack->err.type==V_NIL?0:stack->err.u.error.code);
  586 }
  587 /*}}}*/
  588 static struct Value *fn_exp(struct Value *v, struct Auto *stack) /*{{{*/
  589 {
  590   return Value_new_REAL(v,exp(realValue(stack,0)));
  591 }
  592 /*}}}*/
  593 static struct Value *fn_false(struct Value *v, struct Auto *stack) /*{{{*/
  594 {
  595   return Value_new_INTEGER(v,0);
  596 }
  597 /*}}}*/
  598 static struct Value *fn_find(struct Value *v, struct Auto *stack) /*{{{*/
  599 {
  600   return find(v,stringValue(stack,0),0);
  601 }
  602 /*}}}*/
  603 static struct Value *fn_findi(struct Value *v, struct Auto *stack) /*{{{*/
  604 {
  605   return find(v,stringValue(stack,0),intValue(stack,1));
  606 }
  607 /*}}}*/
  608 static struct Value *fn_findd(struct Value *v, struct Auto *stack) /*{{{*/
  609 {
  610   int overflow;
  611   long int n;
  612 
  613   n=Value_toi(realValue(stack,1),&overflow);
  614   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  615   return find(v,stringValue(stack,0),n);
  616 }
  617 /*}}}*/
  618 static struct Value *fn_fix(struct Value *v, struct Auto *stack) /*{{{*/
  619 {
  620   double x=realValue(stack,0);
  621   return Value_new_REAL(v,x<0.0?ceil(x):floor(x));
  622 }
  623 /*}}}*/
  624 static struct Value *fn_frac(struct Value *v, struct Auto *stack) /*{{{*/
  625 {
  626   double x=realValue(stack,0);
  627   return Value_new_REAL(v,x<0.0 ? x-ceil(x) : x-floor(x));
  628 }
  629 /*}}}*/
  630 static struct Value *fn_freefile(struct Value *v, struct Auto *stack) /*{{{*/
  631 {
  632   return Value_new_INTEGER(v,FS_freechn());
  633 }
  634 /*}}}*/
  635 static struct Value *fn_hexi(struct Value *v, struct Auto *stack) /*{{{*/
  636 {
  637   char buf[sizeof(long int)*2+1];
  638 
  639   sprintf(buf,"%lx",intValue(stack,0));
  640   Value_new_STRING(v);
  641   String_appendChars(&v->u.string,buf);
  642   return v;
  643 }
  644 /*}}}*/
  645 static struct Value *fn_hexd(struct Value *v, struct Auto *stack) /*{{{*/
  646 {
  647   char buf[sizeof(long int)*2+1];
  648   int overflow;
  649   long int n;
  650 
  651   n=Value_toi(realValue(stack,0),&overflow);
  652   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  653   sprintf(buf,"%lx",n);
  654   Value_new_STRING(v);
  655   String_appendChars(&v->u.string,buf);
  656   return v;
  657 }
  658 /*}}}*/
  659 static struct Value *fn_hexii(struct Value *v, struct Auto *stack) /*{{{*/
  660 {
  661   return hex(v,intValue(stack,0),intValue(stack,1));
  662 }
  663 /*}}}*/
  664 static struct Value *fn_hexdi(struct Value *v, struct Auto *stack) /*{{{*/
  665 {
  666   int overflow;
  667   long int n;
  668 
  669   n=Value_toi(realValue(stack,0),&overflow);
  670   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  671   return hex(v,n,intValue(stack,1));
  672 }
  673 /*}}}*/
  674 static struct Value *fn_hexid(struct Value *v, struct Auto *stack) /*{{{*/
  675 {
  676   int overflow;
  677   long int digits;
  678 
  679   digits=Value_toi(realValue(stack,1),&overflow);
  680   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
  681   return hex(v,intValue(stack,0),digits);
  682 }
  683 /*}}}*/
  684 static struct Value *fn_hexdd(struct Value *v, struct Auto *stack) /*{{{*/
  685 {
  686   int overflow;
  687   long int n,digits;
  688 
  689   n=Value_toi(realValue(stack,0),&overflow);
  690   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  691   digits=Value_toi(realValue(stack,1),&overflow);
  692   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("digits"));
  693   return hex(v,n,digits);
  694 }
  695 /*}}}*/
  696 static struct Value *fn_int(struct Value *v, struct Auto *stack) /*{{{*/
  697 {
  698   return Value_new_REAL(v,floor(realValue(stack,0)));
  699 }
  700 /*}}}*/
  701 static struct Value *fn_intp(struct Value *v, struct Auto *stack) /*{{{*/
  702 {
  703   long int l;
  704 
  705   errno=0;
  706   l=lrint(floor(realValue(stack,0)));
  707   if (errno==EDOM) return Value_new_ERROR(v,OUTOFRANGE,_("number"));
  708   return Value_new_INTEGER(v,l);
  709 }
  710 /*}}}*/
  711 static struct Value *fn_inp(struct Value *v, struct Auto *stack) /*{{{*/
  712 {
  713   int r=FS_portInput(intValue(stack,0));
  714 
  715   if (r==-1)
  716   {
  717     return Value_new_ERROR(v,IOERROR,FS_errmsg);
  718   }
  719   else return Value_new_INTEGER(v,r);
  720 }
  721 /*}}}*/
  722 static struct Value *fn_input1(struct Value *v, struct Auto *stack) /*{{{*/
  723 {
  724   return input(v,intValue(stack,0),STDCHANNEL);
  725 }
  726 /*}}}*/
  727 static struct Value *fn_input2(struct Value *v, struct Auto *stack) /*{{{*/
  728 {
  729   return input(v,intValue(stack,0),intValue(stack,1));
  730 }
  731 /*}}}*/
  732 static struct Value *fn_inkey(struct Value *v, struct Auto *stack) /*{{{*/
  733 {
  734   return inkey(v,0,STDCHANNEL);
  735 }
  736 /*}}}*/
  737 static struct Value *fn_inkeyi(struct Value *v, struct Auto *stack) /*{{{*/
  738 {
  739   return inkey(v,intValue(stack,0),STDCHANNEL);
  740 }
  741 /*}}}*/
  742 static struct Value *fn_inkeyd(struct Value *v, struct Auto *stack) /*{{{*/
  743 {
  744   int overflow;
  745   long int t;
  746 
  747   t=Value_toi(realValue(stack,0),&overflow);
  748   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time"));
  749   return inkey(v,t,STDCHANNEL);
  750 }
  751 /*}}}*/
  752 static struct Value *fn_inkeyii(struct Value *v, struct Auto *stack) /*{{{*/
  753 {
  754   return inkey(v,intValue(stack,0),intValue(stack,1));
  755 }
  756 /*}}}*/
  757 static struct Value *fn_inkeyid(struct Value *v, struct Auto *stack) /*{{{*/
  758 {
  759   int overflow;
  760   long int chn;
  761 
  762   chn=Value_toi(realValue(stack,1),&overflow);
  763   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel"));
  764   return inkey(v,intValue(stack,0),chn);
  765 }
  766 /*}}}*/
  767 static struct Value *fn_inkeydi(struct Value *v, struct Auto *stack) /*{{{*/
  768 {
  769   return inkey(v,realValue(stack,0),intValue(stack,1));
  770 }
  771 /*}}}*/
  772 static struct Value *fn_inkeydd(struct Value *v, struct Auto *stack) /*{{{*/
  773 {
  774   int overflow;
  775   long int t,chn;
  776 
  777   t=Value_toi(realValue(stack,0),&overflow);
  778   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("time"));
  779   chn=Value_toi(realValue(stack,1),&overflow);
  780   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("channel"));
  781 
  782   return inkey(v,t,chn);
  783 }
  784 /*}}}*/
  785 static struct Value *fn_instr2(struct Value *v, struct Auto *stack) /*{{{*/
  786 {
  787   struct String *haystack=stringValue(stack,0);
  788 
  789   return instr(v,1,haystack->length,haystack,stringValue(stack,1));
  790 }
  791 /*}}}*/
  792 static struct Value *fn_instr3iss(struct Value *v, struct Auto *stack) /*{{{*/
  793 {
  794   struct String *haystack=stringValue(stack,1);
  795 
  796   return instr(v,intValue(stack,0),haystack->length,haystack,stringValue(stack,2));
  797 }
  798 /*}}}*/
  799 static struct Value *fn_instr3ssi(struct Value *v, struct Auto *stack) /*{{{*/
  800 {
  801   struct String *haystack=stringValue(stack,0);
  802 
  803   return instr(v,intValue(stack,2),haystack->length,haystack,stringValue(stack,1));
  804 }
  805 /*}}}*/
  806 static struct Value *fn_instr3dss(struct Value *v, struct Auto *stack) /*{{{*/
  807 {
  808   int overflow;
  809   long int start;
  810   struct String *haystack;
  811 
  812   start=Value_toi(realValue(stack,0),&overflow);
  813   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
  814   haystack=stringValue(stack,1);
  815   return instr(v,start,haystack->length,haystack,stringValue(stack,2));
  816 }
  817 /*}}}*/
  818 static struct Value *fn_instr3ssd(struct Value *v, struct Auto *stack) /*{{{*/
  819 {
  820   int overflow;
  821   long int start;
  822   struct String *haystack;
  823 
  824   start=Value_toi(realValue(stack,2),&overflow);
  825   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
  826   haystack=stringValue(stack,0);
  827   return instr(v,start,haystack->length,haystack,stringValue(stack,1));
  828 }
  829 /*}}}*/
  830 static struct Value *fn_instr4ii(struct Value *v, struct Auto *stack) /*{{{*/
  831 {
  832   return instr(v,intValue(stack,2),intValue(stack,3),stringValue(stack,0),stringValue(stack,1));
  833 }
  834 /*}}}*/
  835 static struct Value *fn_instr4id(struct Value *v, struct Auto *stack) /*{{{*/
  836 {
  837   int overflow;
  838   long int len;
  839 
  840   len=Value_toi(realValue(stack,3),&overflow);
  841   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  842   return instr(v,intValue(stack,2),len,stringValue(stack,0),stringValue(stack,1));
  843 }
  844 /*}}}*/
  845 static struct Value *fn_instr4di(struct Value *v, struct Auto *stack) /*{{{*/
  846 {
  847   int overflow;
  848   long int start;
  849 
  850   start=Value_toi(realValue(stack,2),&overflow);
  851   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
  852   return instr(v,start,intValue(stack,3),stringValue(stack,0),stringValue(stack,1));
  853 }
  854 /*}}}*/
  855 static struct Value *fn_instr4dd(struct Value *v, struct Auto *stack) /*{{{*/
  856 {
  857   int overflow;
  858   long int start,len;
  859 
  860   start=Value_toi(realValue(stack,2),&overflow);
  861   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
  862   len=Value_toi(realValue(stack,3),&overflow);
  863   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  864   return instr(v,start,len,stringValue(stack,0),stringValue(stack,1));
  865 }
  866 /*}}}*/
  867 static struct Value *fn_lcase(struct Value *v, struct Auto *stack) /*{{{*/
  868 {
  869   Value_new_STRING(v);
  870   String_appendString(&v->u.string,stringValue(stack,0));
  871   String_lcase(&v->u.string);
  872   return v;
  873 }
  874 /*}}}*/
  875 static struct Value *fn_len(struct Value *v, struct Auto *stack) /*{{{*/
  876 {
  877   return Value_new_INTEGER(v,stringValue(stack,0)->length);
  878 }
  879 /*}}}*/
  880 static struct Value *fn_left(struct Value *v, struct Auto *stack) /*{{{*/
  881 {
  882   struct String *s=stringValue(stack,0);
  883   long int len=intValue(stack,1);
  884   int left=((size_t)len)<s->length ? len : s->length;
  885 
  886   if (left<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
  887   Value_new_STRING(v);
  888   String_size(&v->u.string,left);
  889   if (left) memcpy(v->u.string.character,s->character,left);
  890   return v;
  891 }
  892 /*}}}*/
  893 static struct Value *fn_loc(struct Value *v, struct Auto *stack) /*{{{*/
  894 {
  895   long int l=FS_loc(intValue(stack,0));
  896 
  897   if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
  898   return Value_new_INTEGER(v,l);
  899 }
  900 /*}}}*/
  901 static struct Value *fn_lof(struct Value *v, struct Auto *stack) /*{{{*/
  902 {
  903   long int l=FS_lof(intValue(stack,0));
  904 
  905   if (l==-1) return Value_new_ERROR(v,IOERROR,FS_errmsg);
  906   return Value_new_INTEGER(v,l);
  907 }
  908 /*}}}*/
  909 static struct Value *fn_log(struct Value *v, struct Auto *stack) /*{{{*/
  910 {
  911   if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
  912   else Value_new_REAL(v,log(realValue(stack,0)));
  913   return v;
  914 }
  915 /*}}}*/
  916 static struct Value *fn_log10(struct Value *v, struct Auto *stack) /*{{{*/
  917 {
  918   if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
  919   else Value_new_REAL(v,log10(realValue(stack,0)));
  920   return v;
  921 }
  922 /*}}}*/
  923 static struct Value *fn_log2(struct Value *v, struct Auto *stack) /*{{{*/
  924 {
  925   if (realValue(stack,0)<=0.0) Value_new_ERROR(v,UNDEFINED,_("Logarithm of negative value"));
  926   else Value_new_REAL(v,log2(realValue(stack,0)));
  927   return v;
  928 }
  929 /*}}}*/
  930 static struct Value *fn_ltrim(struct Value *v, struct Auto *stack) /*{{{*/
  931 {
  932   struct String *s=stringValue(stack,0);
  933   int len=s->length;
  934   int spaces;
  935 
  936   for (spaces=0; spaces<len && s->character[spaces]==' '; ++spaces);
  937   Value_new_STRING(v);
  938   String_size(&v->u.string,len-spaces);
  939   if (len-spaces) memcpy(v->u.string.character,s->character+spaces,len-spaces);
  940   return v;
  941 }
  942 /*}}}*/
  943 static struct Value *fn_match(struct Value *v, struct Auto *stack) /*{{{*/
  944 {
  945   struct String *needle=stringValue(stack,0);
  946   const char *needleChars=needle->character;
  947   const char *needleEnd=needle->character+needle->length;
  948   struct String *haystack=stringValue(stack,1);
  949   const char *haystackChars=haystack->character;
  950   size_t haystackLength=haystack->length;
  951   long int start=intValue(stack,2);
  952   long int found;
  953   const char *n,*h;
  954 
  955   if (start<0) return Value_new_ERROR(v,OUTOFRANGE,_("position"));
  956   if (((size_t)start)>=haystackLength) return Value_new_INTEGER(v,0);
  957   haystackChars+=start; haystackLength-=start;
  958   found=1+start;
  959   while (haystackLength)
  960   {
  961     for (n=needleChars,h=haystackChars; n<needleEnd && h<(haystackChars+haystackLength); ++n,++h)
  962     {
  963       if (*n=='\\')
  964       {
  965         if (++n<needleEnd && *n!=*h) break;
  966       }
  967       else if (*n=='!')
  968       {
  969         if (!isalpha((int)*h)) break;
  970       }
  971       else if (*n=='#')
  972       {
  973         if (!isdigit((int)*h)) break;
  974       }
  975       else if (*n!='?' && *n!=*h) break;
  976     }
  977     if (n==needleEnd) return Value_new_INTEGER(v,found);
  978     ++haystackChars; --haystackLength;
  979     ++found;
  980   }
  981   return Value_new_INTEGER(v,0);
  982 }
  983 /*}}}*/
  984 static struct Value *fn_maxii(struct Value *v, struct Auto *stack) /*{{{*/
  985 {
  986   long int x,y;
  987 
  988   x=intValue(stack,0);
  989   y=intValue(stack,1);
  990   return Value_new_INTEGER(v,x>y?x:y);
  991 }
  992 /*}}}*/
  993 static struct Value *fn_maxdi(struct Value *v, struct Auto *stack) /*{{{*/
  994 {
  995   double x;
  996   long int y;
  997 
  998   x=realValue(stack,0);
  999   y=intValue(stack,1);
 1000   return Value_new_REAL(v,x>y?x:y);
 1001 }
 1002 /*}}}*/
 1003 static struct Value *fn_maxid(struct Value *v, struct Auto *stack) /*{{{*/
 1004 {
 1005   long int x;
 1006   double y;
 1007 
 1008   x=intValue(stack,0);
 1009   y=realValue(stack,1);
 1010   return Value_new_REAL(v,x>y?x:y);
 1011 }
 1012 /*}}}*/
 1013 static struct Value *fn_maxdd(struct Value *v, struct Auto *stack) /*{{{*/
 1014 {
 1015   double x,y;
 1016 
 1017   x=realValue(stack,0);
 1018   y=realValue(stack,1);
 1019   return Value_new_REAL(v,x>y?x:y);
 1020 }
 1021 /*}}}*/
 1022 static struct Value *fn_mid2i(struct Value *v, struct Auto *stack) /*{{{*/
 1023 {
 1024   return mid(v,stringValue(stack,0),intValue(stack,1),stringValue(stack,0)->length);
 1025 }
 1026 /*}}}*/
 1027 static struct Value *fn_mid2d(struct Value *v, struct Auto *stack) /*{{{*/
 1028 {
 1029   int overflow;
 1030   long int start;
 1031 
 1032   start=Value_toi(realValue(stack,1),&overflow);
 1033   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
 1034   return mid(v,stringValue(stack,0),start,stringValue(stack,0)->length);
 1035 }
 1036 /*}}}*/
 1037 static struct Value *fn_mid3ii(struct Value *v, struct Auto *stack) /*{{{*/
 1038 {
 1039   return mid(v,stringValue(stack,0),intValue(stack,1),intValue(stack,2));
 1040 }
 1041 /*}}}*/
 1042 static struct Value *fn_mid3id(struct Value *v, struct Auto *stack) /*{{{*/
 1043 {
 1044   int overflow;
 1045   long int len;
 1046 
 1047   len=Value_toi(realValue(stack,2),&overflow);
 1048   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1049   return mid(v,stringValue(stack,0),intValue(stack,1),len);
 1050 }
 1051 /*}}}*/
 1052 static struct Value *fn_mid3di(struct Value *v, struct Auto *stack) /*{{{*/
 1053 {
 1054   int overflow;
 1055   long int start;
 1056 
 1057   start=Value_toi(realValue(stack,1),&overflow);
 1058   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
 1059 
 1060   return mid(v,stringValue(stack,0),start,intValue(stack,2));
 1061 }
 1062 /*}}}*/
 1063 static struct Value *fn_mid3dd(struct Value *v, struct Auto *stack) /*{{{*/
 1064 {
 1065   int overflow;
 1066   long int start,len;
 1067 
 1068   start=Value_toi(realValue(stack,1),&overflow);
 1069   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("start"));
 1070   len=Value_toi(realValue(stack,2),&overflow);
 1071   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1072   return mid(v,stringValue(stack,0),start,len);
 1073 }
 1074 /*}}}*/
 1075 static struct Value *fn_minii(struct Value *v, struct Auto *stack) /*{{{*/
 1076 {
 1077   long int x,y;
 1078 
 1079   x=intValue(stack,0);
 1080   y=intValue(stack,1);
 1081   return Value_new_INTEGER(v,x<y?x:y);
 1082 }
 1083 /*}}}*/
 1084 static struct Value *fn_mindi(struct Value *v, struct Auto *stack) /*{{{*/
 1085 {
 1086   double x;
 1087   long int y;
 1088 
 1089   x=realValue(stack,0);
 1090   y=intValue(stack,1);
 1091   return Value_new_REAL(v,x<y?x:y);
 1092 }
 1093 /*}}}*/
 1094 static struct Value *fn_minid(struct Value *v, struct Auto *stack) /*{{{*/
 1095 {
 1096   long int x;
 1097   double y;
 1098 
 1099   x=intValue(stack,0);
 1100   y=realValue(stack,1);
 1101   return Value_new_REAL(v,x<y?x:y);
 1102 }
 1103 /*}}}*/
 1104 static struct Value *fn_mindd(struct Value *v, struct Auto *stack) /*{{{*/
 1105 {
 1106   double x,y;
 1107 
 1108   x=realValue(stack,0);
 1109   y=realValue(stack,1);
 1110   return Value_new_REAL(v,x<y?x:y);
 1111 }
 1112 /*}}}*/
 1113 static struct Value *fn_mki(struct Value *v, struct Auto *stack) /*{{{*/
 1114 {
 1115   long int x=intValue(stack,0);
 1116   size_t i;
 1117 
 1118   Value_new_STRING(v);
 1119   String_size(&v->u.string,sizeof(long int));
 1120   for (i=0; i<sizeof(long int); ++i,x>>=8) v->u.string.character[i]=(x&0xff);
 1121   return v;
 1122 }
 1123 /*}}}*/
 1124 static struct Value *fn_mks(struct Value *v, struct Auto *stack) /*{{{*/
 1125 {
 1126   float x=realValue(stack,0);
 1127 
 1128   Value_new_STRING(v);
 1129   String_size(&v->u.string,sizeof(float));
 1130   memcpy(v->u.string.character,&x,sizeof(float));
 1131   return v;
 1132 }
 1133 /*}}}*/
 1134 static struct Value *fn_mkd(struct Value *v, struct Auto *stack) /*{{{*/
 1135 {
 1136   double x=realValue(stack,0);
 1137 
 1138   Value_new_STRING(v);
 1139   String_size(&v->u.string,sizeof(double));
 1140   memcpy(v->u.string.character,&x,sizeof(double));
 1141   return v;
 1142 }
 1143 /*}}}*/
 1144 static struct Value *fn_oct(struct Value *v, struct Auto *stack) /*{{{*/
 1145 {
 1146   char buf[sizeof(long int)*3+1];
 1147 
 1148   sprintf(buf,"%lo",intValue(stack,0));
 1149   Value_new_STRING(v);
 1150   String_appendChars(&v->u.string,buf);
 1151   return v;
 1152 }
 1153 /*}}}*/
 1154 static struct Value *fn_pi(struct Value *v, struct Auto *stack) /*{{{*/
 1155 {
 1156   return Value_new_REAL(v,M_PI);
 1157 }
 1158 /*}}}*/
 1159 static struct Value *fn_peek(struct Value *v, struct Auto *stack) /*{{{*/
 1160 {
 1161   int r=FS_memInput(intValue(stack,0));
 1162 
 1163   if (r==-1)
 1164   {
 1165     return Value_new_ERROR(v,IOERROR,FS_errmsg);
 1166   }
 1167   else return Value_new_INTEGER(v,r);
 1168 }
 1169 /*}}}*/
 1170 static struct Value *fn_pos(struct Value *v, struct Auto *stack) /*{{{*/
 1171 {
 1172   return Value_new_INTEGER(v,FS_charpos(STDCHANNEL)+1);
 1173 }
 1174 /*}}}*/
 1175 static struct Value *fn_rad(struct Value *v, struct Auto *stack) /*{{{*/
 1176 {
 1177   return Value_new_REAL(v,(realValue(stack,0)*M_PI)/180.0);
 1178 }
 1179 /*}}}*/
 1180 static struct Value *fn_right(struct Value *v, struct Auto *stack) /*{{{*/
 1181 {
 1182   struct String *s=stringValue(stack,0);
 1183   int len=s->length;
 1184   int right=intValue(stack,1)<len ? intValue(stack,1) : len;
 1185   if (right<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1186   Value_new_STRING(v);
 1187   String_size(&v->u.string,right);
 1188   if (right) memcpy(v->u.string.character,s->character+len-right,right);
 1189   return v;
 1190 }
 1191 /*}}}*/
 1192 static struct Value *fn_rnd(struct Value *v, struct Auto *stack) /*{{{*/
 1193 {
 1194   return rnd(v,0);
 1195 }
 1196 /*}}}*/
 1197 static struct Value *fn_rndi(struct Value *v, struct Auto *stack) /*{{{*/
 1198 {
 1199   return rnd(v,intValue(stack,0));
 1200 }
 1201 /*}}}*/
 1202 static struct Value *fn_rndd(struct Value *v, struct Auto *stack) /*{{{*/
 1203 {
 1204   int overflow;
 1205   long int limit;
 1206 
 1207   limit=Value_toi(realValue(stack,0),&overflow);
 1208   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("limit"));
 1209   return rnd(v,limit);
 1210 }
 1211 /*}}}*/
 1212 static struct Value *fn_rtrim(struct Value *v, struct Auto *stack) /*{{{*/
 1213 {
 1214   struct String *s=stringValue(stack,0);
 1215   int len=s->length;
 1216   int lastSpace;
 1217 
 1218   for (lastSpace=len; lastSpace>0 && s->character[lastSpace-1]==' '; --lastSpace);
 1219   Value_new_STRING(v);
 1220   String_size(&v->u.string,lastSpace);
 1221   if (lastSpace) memcpy(v->u.string.character,s->character,lastSpace);
 1222   return v;
 1223 }
 1224 /*}}}*/
 1225 static struct Value *fn_sgn(struct Value *v, struct Auto *stack) /*{{{*/
 1226 {
 1227   double x=realValue(stack,0);
 1228   return Value_new_INTEGER(v,x<0.0 ? -1 : (x==0.0 ? 0 : 1));
 1229 }
 1230 /*}}}*/
 1231 static struct Value *fn_sin(struct Value *v, struct Auto *stack) /*{{{*/
 1232 {
 1233   return Value_new_REAL(v,sin(realValue(stack,0)));
 1234 }
 1235 /*}}}*/
 1236 static struct Value *fn_space(struct Value *v, struct Auto *stack) /*{{{*/
 1237 {
 1238   long int len=intValue(stack,0);
 1239 
 1240   if (len<0) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1241   Value_new_STRING(v);
 1242   String_size(&v->u.string,len);
 1243   if (len) memset(v->u.string.character,' ',len);
 1244   return v;
 1245 }
 1246 /*}}}*/
 1247 static struct Value *fn_sqr(struct Value *v, struct Auto *stack) /*{{{*/
 1248 {
 1249   if (realValue(stack,0)<0.0) Value_new_ERROR(v,OUTOFRANGE,_("Square root argument"));
 1250   else Value_new_REAL(v,sqrt(realValue(stack,0)));
 1251   return v;
 1252 }
 1253 /*}}}*/
 1254 static struct Value *fn_str(struct Value *v, struct Auto *stack) /*{{{*/
 1255 {
 1256   struct Value value,*arg;
 1257   struct String s;
 1258 
 1259   arg=Var_value(Auto_local(stack,0),0,(int*)0,&value);
 1260   assert(arg->type!=V_ERROR);
 1261   String_new(&s);
 1262   Value_toString(arg,&s,' ',-1,0,0,0,0,-1,0,0);
 1263   v->type=V_STRING;
 1264   v->u.string=s;
 1265   return v;
 1266 }
 1267 /*}}}*/
 1268 static struct Value *fn_stringii(struct Value *v, struct Auto *stack) /*{{{*/
 1269 {
 1270   return string(v,intValue(stack,0),intValue(stack,1));
 1271 }
 1272 /*}}}*/
 1273 static struct Value *fn_stringid(struct Value *v, struct Auto *stack) /*{{{*/
 1274 {
 1275   int overflow;
 1276   long int chr;
 1277 
 1278   chr=Value_toi(realValue(stack,1),&overflow);
 1279   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
 1280   return string(v,intValue(stack,0),chr);
 1281 }
 1282 /*}}}*/
 1283 static struct Value *fn_stringdi(struct Value *v, struct Auto *stack) /*{{{*/
 1284 {
 1285   int overflow;
 1286   long int len;
 1287 
 1288   len=Value_toi(realValue(stack,0),&overflow);
 1289   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1290   return string(v,len,intValue(stack,1));
 1291 }
 1292 /*}}}*/
 1293 static struct Value *fn_stringdd(struct Value *v, struct Auto *stack) /*{{{*/
 1294 {
 1295   int overflow;
 1296   long int len,chr;
 1297 
 1298   len=Value_toi(realValue(stack,0),&overflow);
 1299   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1300   chr=Value_toi(realValue(stack,1),&overflow);
 1301   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("character code"));
 1302   return string(v,len,chr);
 1303 }
 1304 /*}}}*/
 1305 static struct Value *fn_stringis(struct Value *v, struct Auto *stack) /*{{{*/
 1306 {
 1307   if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string"));
 1308 
 1309   return string(v,intValue(stack,0),stringValue(stack,1)->character[0]);
 1310 }
 1311 /*}}}*/
 1312 static struct Value *fn_stringds(struct Value *v, struct Auto *stack) /*{{{*/
 1313 {
 1314   int overflow;
 1315   long int len;
 1316 
 1317   len=Value_toi(realValue(stack,0),&overflow);
 1318   if (overflow) return Value_new_ERROR(v,OUTOFRANGE,_("length"));
 1319   if (stringValue(stack,1)->length==0) return Value_new_ERROR(v,UNDEFINED,_("`string$' of empty string"));
 1320   return string(v,len,stringValue(stack,1)->character[0]);
 1321 }
 1322 /*}}}*/
 1323 static struct Value *fn_strip(struct Value *v, struct Auto *stack) /*{{{*/
 1324 {
 1325   size_t i;
 1326 
 1327   Value_new_STRING(v);
 1328   String_appendString(&v->u.string,stringValue(stack,0));
 1329   for (i=0; i<v->u.string.length; ++i) v->u.string.character[i]&=0x7f;
 1330   return v;
 1331 }
 1332 /*}}}*/
 1333 static struct Value *fn_tan(struct Value *v, struct Auto *stack) /*{{{*/
 1334 {
 1335   return Value_new_REAL(v,tan(realValue(stack,0)));
 1336 }
 1337 /*}}}*/
 1338 static struct Value *fn_timei(struct Value *v, struct Auto *stack) /*{{{*/
 1339 {
 1340   return Value_new_INTEGER(v,(unsigned long)(times((struct tms*)0)/(sysconf(_SC_CLK_TCK)/100.0)));
 1341 }
 1342 /*}}}*/
 1343 static struct Value *fn_times(struct Value *v, struct Auto *stack) /*{{{*/
 1344 {
 1345   time_t t;
 1346   struct tm *now;
 1347 
 1348   Value_new_STRING(v);
 1349   String_size(&v->u.string,8);
 1350   time(&t);
 1351   now=localtime(&t);
 1352   sprintf(v->u.string.character,"%02d:%02d:%02d",now->tm_hour,now->tm_min,now->tm_sec);
 1353   return v;
 1354 }
 1355 /*}}}*/
 1356 static struct Value *fn_timer(struct Value *v, struct Auto *stack) /*{{{*/
 1357 {
 1358   time_t t;
 1359   struct tm *l;
 1360 
 1361   time(&t);
 1362   l=localtime(&t);
 1363   return Value_new_REAL(v,l->tm_hour*3600+l->tm_min*60+l->tm_sec);
 1364 }
 1365 /*}}}*/
 1366 static struct Value *fn_tl(struct Value *v, struct Auto *stack) /*{{{*/
 1367 {
 1368   struct String *s=stringValue(stack,0);
 1369   
 1370   Value_new_STRING(v);
 1371   if (s->length)
 1372   {
 1373     int tail=s->length-1;
 1374 
 1375     String_size(&v->u.string,tail);
 1376     if (s->length) memcpy(v->u.string.character,s->character+1,tail);
 1377   }
 1378   return v;
 1379 }
 1380 /*}}}*/
 1381 static struct Value *fn_true(struct Value *v, struct Auto *stack) /*{{{*/
 1382 {
 1383   return Value_new_INTEGER(v,-1);
 1384 }
 1385 /*}}}*/
 1386 static struct Value *fn_ucase(struct Value *v, struct Auto *stack) /*{{{*/
 1387 {
 1388   Value_new_STRING(v);
 1389   String_appendString(&v->u.string,stringValue(stack,0));
 1390   String_ucase(&v->u.string);
 1391   return v;
 1392 }
 1393 /*}}}*/
 1394 static struct Value *fn_val(struct Value *v, struct Auto *stack) /*{{{*/
 1395 {
 1396   struct String *s=stringValue(stack,0);
 1397   char *end;
 1398   long int i;
 1399   int overflow;
 1400   
 1401   if (s->character==(char*)0) return Value_new_REAL(v,0.0);
 1402   i=Value_vali(s->character,&end,&overflow);
 1403   if (*end=='\0') return Value_new_INTEGER(v,i);
 1404   else return Value_new_REAL(v,Value_vald(s->character,(char**)0,&overflow));
 1405 }
 1406 /*}}}*/
 1407 
 1408 static unsigned int hash(const char *s) /*{{{*/
 1409 {
 1410   unsigned int h=0;
 1411 
 1412   while (*s)
 1413   {
 1414     h=h*256+tolower(*s);
 1415     ++s;
 1416   }
 1417   return h%GLOBAL_HASHSIZE;
 1418 }
 1419 /*}}}*/
 1420 static void builtin(struct Global *this, const char *ident, enum ValueType type, struct Value *(* func)(struct Value *value, struct Auto *stack), int argLength, ...) /*{{{*/
 1421 {
 1422   struct Symbol **r;
 1423   struct Symbol *s,**sptr;
 1424   int i;
 1425   va_list ap;
 1426 
 1427   for
 1428   (
 1429     r=&this->table[hash(ident)];
 1430     *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident);
 1431     r=&((*r)->next)
 1432   );
 1433   if (*r==(struct Symbol*)0)
 1434   {
 1435     *r=malloc(sizeof(struct Symbol));
 1436     (*r)->name=strcpy(malloc(strlen(ident)+1),ident);
 1437     (*r)->next=(struct Symbol*)0;
 1438     s=(*r);
 1439   }
 1440   else
 1441   {
 1442     for (sptr=&((*r)->u.sub.u.bltin.next); *sptr; sptr=&((*sptr)->u.sub.u.bltin.next));
 1443     *sptr=s=malloc(sizeof(struct Symbol));
 1444   }
 1445   s->u.sub.u.bltin.next=(struct Symbol*)0;
 1446   s->type=BUILTINFUNCTION;
 1447   s->u.sub.argLength=argLength;
 1448   s->u.sub.argTypes=argLength ? malloc(sizeof(enum ValueType)*argLength) : (enum ValueType*)0;
 1449   s->u.sub.retType=type;
 1450   va_start(ap,argLength);
 1451   for (i=0; i<argLength; ++i)
 1452   {
 1453     s->u.sub.argTypes[i]=va_arg(ap,enum ValueType);
 1454   }
 1455   va_end(ap);
 1456   s->u.sub.u.bltin.call=func;
 1457 }
 1458 /*}}}*/
 1459 
 1460 struct Global *Global_new(struct Global *this) /*{{{*/
 1461 {
 1462   builtin(this,"abs",     V_REAL,   fn_abs,       1,V_REAL);
 1463   builtin(this,"asc",     V_INTEGER,fn_asc,       1,V_STRING);
 1464   builtin(this,"atn",     V_REAL,   fn_atn,       1,V_REAL);
 1465   builtin(this,"bin$",    V_STRING, fn_bini,      1,V_INTEGER);
 1466   builtin(this,"bin$",    V_STRING, fn_bind,      1,V_REAL);
 1467   builtin(this,"bin$",    V_STRING, fn_binii,     2,V_INTEGER,V_INTEGER);
 1468   builtin(this,"bin$",    V_STRING, fn_bindi,     2,V_REAL,V_INTEGER);
 1469   builtin(this,"bin$",    V_STRING, fn_binid,     2,V_INTEGER,V_REAL);
 1470   builtin(this,"bin$",    V_STRING, fn_bindd,     2,V_REAL,V_REAL);
 1471   builtin(this,"chr$",    V_STRING, fn_chr,       1,V_INTEGER);
 1472   builtin(this,"cint",    V_REAL,   fn_cint,      1,V_REAL);
 1473   builtin(this,"code",    V_INTEGER,fn_asc,       1,V_STRING);
 1474   builtin(this,"command$",V_STRING, fn_command,   0);
 1475   builtin(this,"command$",V_STRING, fn_commandi,  1,V_INTEGER);
 1476   builtin(this,"command$",V_STRING, fn_commandd,  1,V_REAL);
 1477   builtin(this,"cos",     V_REAL,   fn_cos,       1,V_REAL);
 1478   builtin(this,"cvd",     V_REAL,   fn_cvd,       1,V_STRING);
 1479   builtin(this,"cvi",     V_INTEGER,fn_cvi,       1,V_STRING);
 1480   builtin(this,"cvs",     V_REAL,   fn_cvs,       1,V_STRING);
 1481   builtin(this,"date$",   V_STRING, fn_date,      0);
 1482   builtin(this,"dec$",    V_STRING, fn_dec,       2,V_REAL,V_STRING);
 1483   builtin(this,"dec$",    V_STRING, fn_dec,       2,V_INTEGER,V_STRING);
 1484   builtin(this,"dec$",    V_STRING, fn_dec,       2,V_STRING,V_STRING);
 1485   builtin(this,"deg",     V_REAL,   fn_deg,       1,V_REAL);
 1486   builtin(this,"det",     V_REAL,   fn_det,       0);
 1487   builtin(this,"edit$",   V_STRING, fn_edit,      2,V_STRING,V_INTEGER);
 1488   builtin(this,"environ$",V_STRING, fn_environi,  1,V_INTEGER);
 1489   builtin(this,"environ$",V_STRING, fn_environd,  1,V_REAL);
 1490   builtin(this,"environ$",V_STRING, fn_environs,  1,V_STRING);
 1491   builtin(this,"eof",     V_INTEGER,fn_eof,       1,V_INTEGER);
 1492   builtin(this,"erl",     V_INTEGER,fn_erl,       0);
 1493   builtin(this,"err",     V_INTEGER,fn_err,       0);
 1494   builtin(this,"exp",     V_REAL,   fn_exp,       1,V_REAL);
 1495   builtin(this,"false",   V_INTEGER,fn_false,     0);
 1496   builtin(this,"find$",   V_STRING, fn_find,      1,V_STRING);
 1497   builtin(this,"find$",   V_STRING, fn_findi,     2,V_STRING,V_INTEGER);
 1498   builtin(this,"find$",   V_STRING, fn_findd,     2,V_STRING,V_REAL);
 1499   builtin(this,"fix",     V_REAL,   fn_fix,       1,V_REAL);
 1500   builtin(this,"frac",    V_REAL,   fn_frac,      1,V_REAL);
 1501   builtin(this,"freefile",V_INTEGER,fn_freefile,  0);
 1502   builtin(this,"fp",      V_REAL,   fn_frac,      1,V_REAL);
 1503   builtin(this,"hex$",    V_STRING, fn_hexi,      1,V_INTEGER);
 1504   builtin(this,"hex$",    V_STRING, fn_hexd,      1,V_REAL);
 1505   builtin(this,"hex$",    V_STRING, fn_hexii,     2,V_INTEGER,V_INTEGER);
 1506   builtin(this,"hex$",    V_STRING, fn_hexdi,     2,V_REAL,V_INTEGER);
 1507   builtin(this,"hex$",    V_STRING, fn_hexid,     2,V_INTEGER,V_REAL);
 1508   builtin(this,"hex$",    V_STRING, fn_hexdd,     2,V_REAL,V_REAL);
 1509   builtin(this,"inkey$",  V_STRING, fn_inkey,     0);
 1510   builtin(this,"inkey$",  V_STRING, fn_inkeyi,    1,V_INTEGER);
 1511   builtin(this,"inkey$",  V_STRING, fn_inkeyd,    1,V_REAL);
 1512   builtin(this,"inkey$",  V_STRING, fn_inkeyii,   2,V_INTEGER,V_INTEGER);
 1513   builtin(this,"inkey$",  V_STRING, fn_inkeyid,   2,V_INTEGER,V_REAL);
 1514   builtin(this,"inkey$",  V_STRING, fn_inkeydi,   2,V_REAL,V_INTEGER);
 1515   builtin(this,"inkey$",  V_STRING, fn_inkeydd,   2,V_REAL,V_REAL);
 1516   builtin(this,"inp",     V_INTEGER,fn_inp,       1,V_INTEGER);
 1517   builtin(this,"input$",  V_STRING, fn_input1,    1,V_INTEGER);
 1518   builtin(this,"input$",  V_STRING, fn_input2,    2,V_INTEGER,V_INTEGER);
 1519   builtin(this,"instr",   V_INTEGER,fn_instr2,    2,V_STRING,V_STRING);
 1520   builtin(this,"instr",   V_INTEGER,fn_instr3iss, 3,V_INTEGER,V_STRING,V_STRING);
 1521   builtin(this,"instr",   V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER);
 1522   builtin(this,"instr",   V_INTEGER,fn_instr3dss, 3,V_REAL,V_STRING,V_STRING);
 1523   builtin(this,"instr",   V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL);
 1524   builtin(this,"instr",   V_INTEGER,fn_instr4ii,  4,V_STRING,V_STRING,V_INTEGER,V_INTEGER);
 1525   builtin(this,"instr",   V_INTEGER,fn_instr4id,  4,V_STRING,V_STRING,V_INTEGER,V_REAL);
 1526   builtin(this,"instr",   V_INTEGER,fn_instr4di,  4,V_STRING,V_STRING,V_REAL,V_INTEGER);
 1527   builtin(this,"instr",   V_INTEGER,fn_instr4dd,  4,V_STRING,V_STRING,V_REAL,V_REAL);
 1528   builtin(this,"int",     V_REAL,   fn_int,       1,V_REAL);
 1529   builtin(this,"int%",    V_INTEGER,fn_intp,      1,V_REAL);
 1530   builtin(this,"ip",      V_REAL,   fn_fix,       1,V_REAL);
 1531   builtin(this,"lcase$",  V_STRING, fn_lcase,     1,V_STRING);
 1532   builtin(this,"lower$",  V_STRING, fn_lcase,     1,V_STRING);
 1533   builtin(this,"left$",   V_STRING, fn_left,      2,V_STRING,V_INTEGER);
 1534   builtin(this,"len",     V_INTEGER,fn_len,       1,V_STRING);
 1535   builtin(this,"loc",     V_INTEGER,fn_loc,       1,V_INTEGER);
 1536   builtin(this,"lof",     V_INTEGER,fn_lof,       1,V_INTEGER);
 1537   builtin(this,"log",     V_REAL,   fn_log,       1,V_REAL);
 1538   builtin(this,"log10",   V_REAL,   fn_log10,     1,V_REAL);
 1539   builtin(this,"log2",    V_REAL,   fn_log2,      1,V_REAL);
 1540   builtin(this,"ltrim$",  V_STRING, fn_ltrim,     1,V_STRING);
 1541   builtin(this,"match",   V_INTEGER,fn_match,     3,V_STRING,V_STRING,V_INTEGER);
 1542   builtin(this,"max",     V_INTEGER,fn_maxii,     2,V_INTEGER,V_INTEGER);
 1543   builtin(this,"max",     V_REAL,   fn_maxdi,     2,V_REAL,V_INTEGER);
 1544   builtin(this,"max",     V_REAL,   fn_maxid,     2,V_INTEGER,V_REAL);
 1545   builtin(this,"max",     V_REAL,   fn_maxdd,     2,V_REAL,V_REAL);
 1546   builtin(this,"mid$",    V_STRING, fn_mid2i,     2,V_STRING,V_INTEGER);
 1547   builtin(this,"mid$",    V_STRING, fn_mid2d,     2,V_STRING,V_REAL);
 1548   builtin(this,"mid$",    V_STRING, fn_mid3ii,    3,V_STRING,V_INTEGER,V_INTEGER);
 1549   builtin(this,"mid$",    V_STRING, fn_mid3id,    3,V_STRING,V_INTEGER,V_REAL);
 1550   builtin(this,"mid$",    V_STRING, fn_mid3di,    3,V_STRING,V_REAL,V_INTEGER);
 1551   builtin(this,"mid$",    V_STRING, fn_mid3dd,    3,V_STRING,V_REAL,V_REAL);
 1552   builtin(this,"min",     V_INTEGER,fn_minii,     2,V_INTEGER,V_INTEGER);
 1553   builtin(this,"min",     V_REAL,   fn_mindi,     2,V_REAL,V_INTEGER);
 1554   builtin(this,"min",     V_REAL,   fn_minid,     2,V_INTEGER,V_REAL);
 1555   builtin(this,"min",     V_REAL,   fn_mindd,     2,V_REAL,V_REAL);
 1556   builtin(this,"mki$",    V_STRING, fn_mki,       1,V_INTEGER);
 1557   builtin(this,"mks$",    V_STRING, fn_mks,       1,V_REAL);
 1558   builtin(this,"mkd$",    V_STRING, fn_mkd,       1,V_REAL);
 1559   builtin(this,"oct$",    V_STRING, fn_oct,       1,V_INTEGER);
 1560   builtin(this,"peek",    V_INTEGER,fn_peek,      1,V_INTEGER);
 1561   builtin(this,"pi",      V_REAL,   fn_pi,        0);
 1562   builtin(this,"pos",     V_INTEGER,fn_pos,       1,V_INTEGER);
 1563   builtin(this,"pos",     V_INTEGER,fn_pos,       1,V_REAL);
 1564   builtin(this,"pos",     V_INTEGER,fn_instr3ssi, 3,V_STRING,V_STRING,V_INTEGER);
 1565   builtin(this,"pos",     V_INTEGER,fn_instr3ssd, 3,V_STRING,V_STRING,V_REAL);
 1566   builtin(this,"rad",     V_REAL,   fn_rad,       1,V_REAL);
 1567   builtin(this,"right$",  V_STRING, fn_right,     2,V_STRING,V_INTEGER);
 1568   builtin(this,"rnd",     V_INTEGER,fn_rnd,       0);
 1569   builtin(this,"rnd",     V_INTEGER,fn_rndd,      1,V_REAL);
 1570   builtin(this,"rnd",     V_INTEGER,fn_rndi,      1,V_INTEGER);
 1571   builtin(this,"rtrim$",  V_STRING, fn_rtrim,     1,V_STRING);
 1572   builtin(this,"seg$",    V_STRING, fn_mid3ii,    3,V_STRING,V_INTEGER,V_INTEGER);
 1573   builtin(this,"seg$",    V_STRING, fn_mid3id,    3,V_STRING,V_INTEGER,V_REAL);
 1574   builtin(this,"seg$",    V_STRING, fn_mid3di,    3,V_STRING,V_REAL,V_INTEGER);
 1575   builtin(this,"seg$",    V_STRING, fn_mid3dd,    3,V_STRING,V_REAL,V_REAL);
 1576   builtin(this,"sgn",     V_INTEGER,fn_sgn,       1,V_REAL);
 1577   builtin(this,"sin",     V_REAL,   fn_sin,       1,V_REAL);
 1578   builtin(this,"space$",  V_STRING, fn_space,     1,V_INTEGER);
 1579   builtin(this,"sqr",     V_REAL,   fn_sqr,       1,V_REAL);
 1580   builtin(this,"str$",    V_STRING, fn_str,       1,V_REAL);
 1581   builtin(this,"str$",    V_STRING, fn_str,       1,V_INTEGER);
 1582   builtin(this,"string$", V_STRING, fn_stringii,  2,V_INTEGER,V_INTEGER);
 1583   builtin(this,"string$", V_STRING, fn_stringid,  2,V_INTEGER,V_REAL);
 1584   builtin(this,"string$", V_STRING, fn_stringdi,  2,V_REAL,V_INTEGER);
 1585   builtin(this,"string$", V_STRING, fn_stringdd,  2,V_REAL,V_REAL);
 1586   builtin(this,"string$", V_STRING, fn_stringis,  2,V_INTEGER,V_STRING);
 1587   builtin(this,"string$", V_STRING, fn_stringds,  2,V_REAL,V_STRING);
 1588   builtin(this,"strip$",  V_STRING, fn_strip,     1,V_STRING);
 1589   builtin(this,"tan",     V_REAL,   fn_tan,       1,V_REAL);
 1590   builtin(this,"time",    V_INTEGER,fn_timei,     0);
 1591   builtin(this,"time$",   V_STRING, fn_times,     0);
 1592   builtin(this,"timer",   V_REAL,   fn_timer,     0);
 1593   builtin(this,"tl$",     V_STRING, fn_tl,        1,V_STRING);
 1594   builtin(this,"true",    V_INTEGER,fn_true,      0);
 1595   builtin(this,"ucase$",  V_STRING, fn_ucase,     1,V_STRING);
 1596   builtin(this,"upper$",  V_STRING, fn_ucase,     1,V_STRING);
 1597   builtin(this,"val",     V_REAL,   fn_val,       1,V_STRING);
 1598   return this;
 1599 }
 1600 /*}}}*/
 1601 int Global_find(struct Global *this, struct Identifier *ident, int oparen) /*{{{*/
 1602 {
 1603   struct Symbol **r;
 1604 
 1605   for
 1606   (
 1607     r=&this->table[hash(ident->name)];
 1608     *r!=(struct Symbol*)0 && ((((*r)->type==GLOBALVAR && oparen) || ((*r)->type==GLOBALARRAY && !oparen)) || cistrcmp((*r)->name,ident->name));
 1609     r=&((*r)->next)
 1610   );
 1611   if (*r==(struct Symbol*)0) return 0;
 1612   ident->sym=(*r);
 1613   return 1;
 1614 }
 1615 /*}}}*/
 1616 int Global_variable(struct Global *this, struct Identifier *ident, enum ValueType type, enum SymbolType symbolType, int redeclare) /*{{{*/
 1617 {
 1618   struct Symbol **r;
 1619 
 1620   for
 1621   (
 1622     r=&this->table[hash(ident->name)];
 1623     *r!=(struct Symbol*)0 && ((*r)->type!=symbolType || cistrcmp((*r)->name,ident->name));
 1624     r=&((*r)->next)
 1625   );
 1626   if (*r==(struct Symbol*)0)
 1627   {
 1628     *r=malloc(sizeof(struct Symbol));
 1629     (*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name);
 1630     (*r)->next=(struct Symbol*)0;
 1631     (*r)->type=symbolType;
 1632     Var_new(&((*r)->u.var),type,0,(unsigned int*)0,0);
 1633   }
 1634   else if (redeclare) Var_retype(&((*r)->u.var),type);
 1635   switch ((*r)->type)
 1636   {
 1637     case GLOBALVAR:
 1638     case GLOBALARRAY:
 1639     {
 1640       ident->sym=(*r);
 1641       break;
 1642     }
 1643     case BUILTINFUNCTION:
 1644     {
 1645       return 0;
 1646     }
 1647     case USERFUNCTION:
 1648     {
 1649       return 0;
 1650     }
 1651     default: assert(0);
 1652   }
 1653   return 1;
 1654 }
 1655 /*}}}*/
 1656 int Global_function(struct Global *this, struct Identifier *ident, enum ValueType type, struct Pc *deffn, struct Pc *begin, int argLength, enum ValueType *argTypes) /*{{{*/
 1657 {
 1658   struct Symbol **r;
 1659 
 1660   for
 1661   (
 1662     r=&this->table[hash(ident->name)];
 1663     *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name);
 1664     r=&((*r)->next)
 1665   );
 1666   if (*r!=(struct Symbol*)0) return 0;
 1667   *r=malloc(sizeof(struct Symbol));
 1668   (*r)->name=strcpy(malloc(strlen(ident->name)+1),ident->name);
 1669   (*r)->next=(struct Symbol*)0;
 1670   (*r)->type=USERFUNCTION;
 1671   (*r)->u.sub.u.def.scope.start=*deffn;
 1672   (*r)->u.sub.u.def.scope.begin=*begin;
 1673   (*r)->u.sub.argLength=argLength;
 1674   (*r)->u.sub.argTypes=argTypes;
 1675   (*r)->u.sub.retType=type;
 1676   (*r)->u.sub.u.def.localLength=0;
 1677   (*r)->u.sub.u.def.localTypes=(enum ValueType*)0;
 1678   ident->sym=(*r);
 1679   return 1;
 1680 }
 1681 /*}}}*/
 1682 void Global_endfunction(struct Global *this, struct Identifier *ident, struct Pc *end) /*{{{*/
 1683 {
 1684   struct Symbol **r;
 1685 
 1686   for
 1687   (
 1688     r=&this->table[hash(ident->name)];
 1689     *r!=(struct Symbol*)0 && cistrcmp((*r)->name,ident->name);
 1690     r=&((*r)->next)
 1691   );
 1692   assert(*r!=(struct Symbol*)0);
 1693   (*r)->u.sub.u.def.scope.end=*end;
 1694 }
 1695 /*}}}*/
 1696 void Global_clear(struct Global *this) /*{{{*/
 1697 {
 1698   int i;
 1699 
 1700   for (i=0; i<GLOBAL_HASHSIZE; ++i)
 1701   {
 1702     struct Symbol *v;
 1703 
 1704     for (v=this->table[i]; v; v=v->next)
 1705     {
 1706       if (v->type==GLOBALVAR || v->type==GLOBALARRAY) Var_clear(&(v->u.var));
 1707     }
 1708   }
 1709 }
 1710 /*}}}*/
 1711 void Global_clearFunctions(struct Global *this) /*{{{*/
 1712 {
 1713   int i;
 1714 
 1715   for (i=0; i<GLOBAL_HASHSIZE; ++i)
 1716   {
 1717     struct Symbol **v=&this->table[i],*w;
 1718     struct Symbol *sym;
 1719 
 1720     while (*v)
 1721     {
 1722       sym=*v;
 1723       w=sym->next;
 1724       if (sym->type==USERFUNCTION)
 1725       {
 1726         if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes);
 1727         if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
 1728         free(sym->name);
 1729         free(sym);
 1730         *v=w;
 1731       }
 1732       else v=&sym->next;
 1733     }
 1734   }
 1735 }
 1736 /*}}}*/
 1737 void Global_destroy(struct Global *this) /*{{{*/
 1738 {
 1739   int i;
 1740 
 1741   for (i=0; i<GLOBAL_HASHSIZE; ++i)
 1742   {
 1743     struct Symbol *v=this->table[i],*w;
 1744     struct Symbol *sym;
 1745 
 1746     while (v)
 1747     {
 1748       sym=v;
 1749       w=v->next;
 1750       switch (sym->type)
 1751       {
 1752         case GLOBALVAR:
 1753         case GLOBALARRAY: Var_destroy(&(sym->u.var)); break;
 1754         case USERFUNCTION:
 1755         {
 1756           if (sym->u.sub.u.def.localTypes) free(sym->u.sub.u.def.localTypes);
 1757           if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
 1758           break;
 1759         }
 1760         case BUILTINFUNCTION:
 1761         {
 1762           if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
 1763           if (sym->u.sub.u.bltin.next)
 1764           {
 1765             sym=sym->u.sub.u.bltin.next;
 1766             while (sym)
 1767             {
 1768               struct Symbol *n;
 1769 
 1770               if (sym->u.sub.argTypes) free(sym->u.sub.argTypes);
 1771               n=sym->u.sub.u.bltin.next;
 1772               free(sym);
 1773               sym=n;
 1774             }
 1775           }
 1776           break;
 1777         }
 1778         default: assert(0);
 1779       }
 1780       free(v->name);
 1781       free(v);
 1782       v=w;
 1783     }
 1784     this->table[i]=(struct Symbol*)0;
 1785   }
 1786 }
 1787 /*}}}*/