simgear/nasal/lib.c

   1 #include <math.h>
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4 #include <stdarg.h>
   5 #include <string.h>
   6
   7 #ifdef _MSC_VER // sigh...
   8 #define vsnprintf _vsnprintf
   9 #endif
  10
  11 #include "nasal.h"
  12 #include "code.h"
  13
  14 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
  15 #define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
  16
  17 static naRef size(naContext c, naRef me, int argc, naRef* args)
  18 {
  19     if(argc == 0) return naNil();
  20     if(naIsString(args[0])) return naNum(naStr_len(args[0]));
  21     if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
  22     if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
  23     naRuntimeError(c, "object has no size()");
  24     return naNil();
  25 }
  26
  27 static naRef keys(naContext c, naRef me, int argc, naRef* args)
  28 {
  29     naRef v, h = args[0];
  30     if(!naIsHash(h)) return naNil();
  31     v = naNewVector(c);
  32     naHash_keys(v, h);
  33     return v;
  34 }
  35
  36 static naRef append(naContext c, naRef me, int argc, naRef* args)
  37 {
  38     int i;
  39     if(argc < 2) return naNil();
  40     if(!naIsVector(args[0])) return naNil();
  41     for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
  42     return args[0];
  43 }
  44
  45 static naRef pop(naContext c, naRef me, int argc, naRef* args)
  46 {
  47     if(argc < 1 || !naIsVector(args[0])) return naNil();
  48     return naVec_removelast(args[0]);
  49 }
  50
  51 static naRef setsize(naContext c, naRef me, int argc, naRef* args)
  52 {
  53     int sz;
  54     if(argc < 2) return naNil();
  55     sz = (int)naNumValue(args[1]).num;
  56     if(!naIsVector(args[0])) return naNil();
  57     naVec_setsize(args[0], sz);
  58     return args[0];
  59 }
  60
  61 static naRef subvec(naContext c, naRef me, int argc, naRef* args)
  62 {
  63     int i;
  64     naRef nlen, result, v = args[0];
  65     int len = 0, start = (int)naNumValue(args[1]).num;
  66     if(argc < 2) return naNil();
  67     nlen = argc > 2 ? naNumValue(args[2]) : naNil();
  68     if(!naIsNil(nlen))
  69         len = (int)nlen.num;
  70     if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
  71         return naNil();
  72     if(naIsNil(nlen) || len > naVec_size(v) - start)
  73         len = naVec_size(v) - start;
  74     result = naNewVector(c);
  75     naVec_setsize(result, len);
  76     for(i=0; i<len; i++)
  77         naVec_set(result, i, naVec_get(v, start + i));
  78     return result;
  79 }
  80
  81 static naRef delete(naContext c, naRef me, int argc, naRef* args)
  82 {
  83     if(argc > 1 && naIsHash(args[0])) naHash_delete(args[0], args[1]);
  84     return naNil();
  85 }
  86
  87 static naRef intf(naContext c, naRef me, int argc, naRef* args)
  88 {
  89     if(argc > 0) {
  90         naRef n = naNumValue(args[0]);
  91         if(naIsNil(n)) return n;
  92         if(n.num < 0) n.num = -floor(-n.num);
  93         else n.num = floor(n.num);
  94         return n;
  95     } else return naNil();
  96 }
  97
  98 static naRef num(naContext c, naRef me, int argc, naRef* args)
  99 {
 100     return argc > 0 ? naNumValue(args[0]) : naNil();
 101 }
 102
 103 static naRef streq(naContext c, naRef me, int argc, naRef* args)
 104 {
 105     return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
 106 }
 107
 108 static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
 109 {
 110     char *a, *b;
 111     int i, alen, blen;
 112     if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
 113         naRuntimeError(c, "bad argument to cmp");
 114     a = naStr_data(args[0]);
 115     alen = naStr_len(args[0]);
 116     b = naStr_data(args[1]);
 117     blen = naStr_len(args[1]);
 118     for(i=0; i<alen && i<blen; i++) {
 119         int diff = a[i] - b[i];
 120         if(diff) return naNum(diff < 0 ? -1 : 1);
 121     }
 122     return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
 123 }
 124
 125 static naRef substr(naContext c, naRef me, int argc, naRef* args)
 126 {
 127     naRef src = argc > 1 ? args[0] : naNil();
 128     naRef startR = argc > 1 ? naNumValue(args[1]) : naNil();
 129     naRef lenR = argc > 2 ? naNumValue(args[2]) : naNil();
 130     int start, len;
 131     if(!naIsString(src)) return naNil();
 132     if(naIsNil(startR)) return naNil();
 133     start = (int)startR.num;
 134     if(naIsNil(lenR)) {
 135         len = naStr_len(src) - start;
 136         if(len < 0) return naNil();
 137     } else {
 138         lenR = naNumValue(lenR);
 139         if(naIsNil(lenR)) return naNil();
 140         len = (int)lenR.num;
 141     }
 142     return naStr_substr(naNewString(c), src, start, len);
 143 }
 144
 145 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
 146 {
 147     char chr[1];
 148     naRef cr = argc ? naNumValue(args[0]) : naNil();
 149     if(IS_NIL(cr)) naRuntimeError(c, "chr argument not string");
 150     chr[0] = (char)cr.num;
 151     return NEWSTR(c, chr, 1);
 152 }
 153
 154 static naRef contains(naContext c, naRef me, int argc, naRef* args)
 155 {
 156     naRef hash = argc > 0 ? args[0] : naNil();
 157     naRef key = argc > 1 ? args[1] : naNil();
 158     if(naIsNil(hash) || naIsNil(key)) return naNil();
 159     if(!naIsHash(hash)) return naNil();
 160     return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
 161 }
 162
 163 static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
 164 {
 165     naRef r = argc > 0 ? args[0] : naNil();
 166     char* t = "unknown";
 167     if(naIsNil(r)) t = "nil";
 168     else if(naIsNum(r)) t = "scalar";
 169     else if(naIsString(r)) t = "scalar";
 170     else if(naIsVector(r)) t = "vector";
 171     else if(naIsHash(r)) t = "hash";
 172     else if(naIsFunc(r)) t = "func";
 173     else if(naIsGhost(r)) t = "ghost";
 174     r = NEWCSTR(c, t);
 175     return r;
 176 }
 177
 178 static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
 179 {
 180     int errLine;
 181     naRef script, code, fname;
 182     script = argc > 0 ? args[0] : naNil();
 183     fname = argc > 1 ? args[1] : NEWCSTR(c, "<compile>");
 184     if(!naIsString(script) || !naIsString(fname)) return naNil();
 185     code = naParseCode(c, fname, 1,
 186                        naStr_data(script), naStr_len(script), &errLine);
 187     if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
 188     return naBindToContext(c, code);
 189 }
 190
 191 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
 192 {
 193     naContext subc;
 194     naRef callargs, callme, callns, result;
 195     struct VecRec* vr;
 196     callargs = argc > 1 ? args[1] : naNil();
 197     callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
 198     callns = argc > 3 ? args[3] : naNil(); // ditto
 199     if(!IS_HASH(callme)) callme = naNil();
 200     if(!IS_HASH(callns)) callns = naNil();
 201     if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
 202         naRuntimeError(c, "bad argument to call()");
 203     subc = naNewContext();
 204     subc->callParent = c;
 205     c->callChild = subc;
 206     vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
 207     result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
 208                     callme, callns);
 209     c->callChild = 0;
 210     if(argc > 2 && IS_VEC(args[argc-1])) {
 211         naRef v = args[argc-1];
 212         if(!IS_NIL(subc->dieArg)) naVec_append(v, subc->dieArg);
 213         else if(naGetError(subc))
 214             naVec_append(v, NEWCSTR(subc, naGetError(subc)));
 215         if(naVec_size(v)) {
 216             int i, sd = naStackDepth(subc);
 217             for(i=0; i<sd; i++) {
 218                 naVec_append(v, naGetSourceFile(subc, i));
 219                 naVec_append(v, naNum(naGetLine(subc, i)));
 220             }
 221         }
 222     }
 223     naFreeContext(subc);
 224     return result;
 225 }
 226
 227 static naRef f_die(naContext c, naRef me, int argc, naRef* args)
 228 {
 229     c->dieArg = argc > 0 ? args[0] : naNil();
 230     naRuntimeError(c, "__die__");
 231     return naNil(); // never executes
 232 }
 233
 234 // Wrapper around vsnprintf, iteratively increasing the buffer size
 235 // until it fits.  Returned buffer should be freed by the caller.
 236 char* dosprintf(char* f, ...)
 237 {
 238     char* buf;
 239     va_list va;
 240     int olen, len = 16;
 241     while(1) {
 242         buf = naAlloc(len);
 243         va_start(va, f);
 244         olen = vsnprintf(buf, len, f, va);
 245         if(olen >= 0 && olen < len) {
 246             va_end(va);
 247             return buf;
 248         }
 249         va_end(va);
 250         naFree(buf);
 251         len *= 2;
 252     }
 253 }
 254
 255 // Inspects a printf format string f, and finds the next "%..." format
 256 // specifier.  Stores the start of the specifier in out, the length in
 257 // len, and the type in type.  Returns a pointer to the remainder of
 258 // the format string, or 0 if no format string was found.  Recognizes
 259 // all of ANSI C's syntax except for the "length modifier" feature.
 260 // Note: this does not validate the format character returned in
 261 // "type". That is the caller's job.
 262 static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type)
 263 {
 264     // Skip to the start of the format string
 265     while(*f && *f != '%') f++;
 266     if(!*f) return 0;
 267     *out = f++;
 268
 269     while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
 270
 271     // Test for duplicate flags.  This is pure pedantry and could
 272     // be removed on all known platforms, but just to be safe...
 273     {   char *p1, *p2;
 274         for(p1 = *out + 1; p1 < f; p1++)
 275             for(p2 = p1+1; p2 < f; p2++)
 276                 if(*p1 == *p2)
 277                     naRuntimeError(ctx, "duplicate flag in format string"); }
 278
 279     while(*f && *f >= '0' && *f <= '9') f++;
 280     if(*f && *f == '.') f++;
 281     while(*f && *f >= '0' && *f <= '9') f++;
 282     if(!*f) naRuntimeError(ctx, "invalid format string");
 283
 284     *type = *f++;
 285     *len = f - *out;
 286     return f;
 287 }
 288
 289 #define ERR(m) naRuntimeError(ctx, m)
 290 #define APPEND(r) result = naStr_concat(naNewString(ctx), result, r)
 291 static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
 292 {
 293     char t, nultmp, *fstr, *next, *fout=0, *s;
 294     int flen, argn=1;
 295     naRef format, arg, result = naNewString(ctx);
 296
 297     if(argc < 1) ERR("not enough arguments to sprintf");
 298     format = naStringValue(ctx, argc > 0 ? args[0] : naNil());
 299     if(naIsNil(format)) ERR("bad format string in sprintf");
 300     s = naStr_data(format);
 301
 302     while((next = nextFormat(ctx, s, &fstr, &flen, &t))) {
 303         APPEND(NEWSTR(ctx, s, fstr-s)); // stuff before the format string
 304         if(flen == 2 && fstr[1] == '%') {
 305             APPEND(NEWSTR(ctx, "%", 1));
 306             s = next;
 307             continue;
 308         }
 309         if(argn >= argc) ERR("not enough arguments to sprintf");
 310         arg = args[argn++];
 311         nultmp = fstr[flen]; // sneaky nul termination...
 312         fstr[flen] = 0;
 313         if(t == 's') {
 314             arg = naStringValue(ctx, arg);
 315             if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
 316             else             fout = dosprintf(fstr, naStr_data(arg));
 317         } else {
 318             arg = naNumValue(arg);
 319             if(naIsNil(arg))
 320                 fout = dosprintf(fstr, "nil");
 321             else if(t=='d' || t=='i' || t=='c')
 322                 fout = dosprintf(fstr, (int)naNumValue(arg).num);
 323             else if(t=='o' || t=='u' || t=='x' || t=='X')
 324                 fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
 325             else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
 326                 fout = dosprintf(fstr, naNumValue(arg).num);
 327             else
 328                 ERR("invalid sprintf format type");
 329         }
 330         fstr[flen] = nultmp;
 331         APPEND(NEWSTR(ctx, fout, strlen(fout)));
 332         naFree(fout);
 333         s = next;
 334     }
 335     APPEND(NEWSTR(ctx, s, strlen(s)));
 336     return result;
 337 }
 338
 339 // FIXME: handle ctx->callParent frames too!
 340 static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
 341 {
 342     int fidx;
 343     struct Frame* frame;
 344     naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
 345     if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
 346     fidx = (int)fr.num;
 347     if(fidx > ctx->fTop - 1) return naNil();
 348     frame = &ctx->fStack[ctx->fTop - 1 - fidx];
 349     result = naNewVector(ctx);
 350     naVec_append(result, frame->locals);
 351     naVec_append(result, frame->func);
 352     naVec_append(result, frame->func.ref.ptr.func->code.ref.ptr.code->srcFile);
 353     naVec_append(result, naNum(naGetLine(ctx, fidx)));
 354     return result;
 355 }
 356
 357 static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
 358 {
 359     int i;
 360     struct naFunc* f;
 361     naRef func = argc > 0 ? args[0] : naNil();
 362     naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
 363     if(!IS_FUNC(func) || IS_NIL(idx))
 364         naRuntimeError(ctx, "bad arguments to closure()");
 365     i = (int)idx.num;
 366     f = func.ref.ptr.func;
 367     while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
 368     if(!f) return naNil();
 369     return f->namespace;
 370 }
 371
 372 static int match(unsigned char* a, unsigned char* b, int l)
 373 {
 374     int i;
 375     for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
 376     return 1;
 377 }
 378
 379 static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
 380 {
 381     int i;
 382     if(al == 0) return 0;
 383     for(i=start; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
 384     return -1;
 385 }
 386
 387 static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
 388 {
 389     int start = 0;
 390     if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
 391         naRuntimeError(ctx, "bad/missing argument to find");
 392     if(argc > 2) start = (int)(naNumValue(args[2]).num);
 393     return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
 394                       args[1].ref.ptr.str->data, args[1].ref.ptr.str->len,
 395                       start));
 396 }
 397
 398 static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
 399 {
 400     int sl, dl, i;
 401     char *s, *d, *s0;
 402     naRef result;
 403     if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
 404         naRuntimeError(ctx, "bad/missing argument to split");
 405     d = naStr_data(args[0]); dl = naStr_len(args[0]);
 406     s = naStr_data(args[1]); sl = naStr_len(args[1]);
 407     result = naNewVector(ctx);
 408     if(dl == 0) { // special case zero-length delimiter
 409         for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
 410         return result;
 411     }
 412     s0 = s;
 413     for(i=0; i <= sl-dl; i++) {
 414         if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
 415             naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
 416             s0 = s + i + dl;
 417             i += dl - 1;
 418         }
 419     }
 420     if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
 421     return result;
 422 }
 423
 424 // This is a comparatively weak RNG, based on the C library's rand()
 425 // function, which is usually not threadsafe and often of limited
 426 // precision.  The 5x loop guarantees that we get a full double worth
 427 // of precision even for 15 bit (Win32...) rand() implementations.
 428 static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
 429 {
 430     int i;
 431     double r = 0;
 432     if(argc) {
 433         if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
 434         srand((unsigned int)args[0].num);
 435         return naNil();
 436     }
 437     for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
 438     return naNum(r);
 439 }
 440
 441 static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
 442 {
 443     naRef func = argc > 0 ? args[0] : naNil();
 444     naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
 445     naRef next = argc > 2 ? args[2] : naNil();
 446     if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
 447         naRuntimeError(ctx, "bad argument to bind");
 448     func = naNewFunc(ctx, func.ref.ptr.func->code);
 449     func.ref.ptr.func->namespace = hash;
 450     func.ref.ptr.func->next = next;
 451     return func;
 452 }
 453
 454 struct func { char* name; naCFunction func; };
 455 static struct func funcs[] = {
 456     { "size", size },
 457     { "keys", keys },
 458     { "append", append },
 459     { "pop", pop },
 460     { "setsize", setsize },
 461     { "subvec", subvec },
 462     { "delete", delete },
 463     { "int", intf },
 464     { "num", num },
 465     { "streq", streq },
 466     { "cmp", f_cmp },
 467     { "substr", substr },
 468     { "chr", f_chr },
 469     { "contains", contains },
 470     { "typeof", typeOf },
 471     { "compile", f_compile },
 472     { "call", f_call },
 473     { "die", f_die },
 474     { "sprintf", f_sprintf },
 475     { "caller", f_caller },
 476     { "closure", f_closure },
 477     { "find", f_find },
 478     { "split", f_split },
 479     { "rand", f_rand },
 480     { "bind", f_bind },
 481 };
 482
 483 naRef naStdLib(naContext c)
 484 {
 485     naRef namespace = naNewHash(c);
 486     int i, n = sizeof(funcs)/sizeof(struct func);
 487     for(i=0; i<n; i++) {
 488         naRef code = naNewCCode(c, funcs[i].func);
 489         naRef name = NEWSTR(c, funcs[i].name, strlen(funcs[i].name));
 490         name = naInternSymbol(name);
 491         naHash_set(namespace, name, naNewFunc(c, code));
 492     }
 493     return namespace;
 494 }