]> git.mxchange.org Git - simgear.git/blob - simgear/nasal/lib.c
Removal of PLIB/SG from SimGear
[simgear.git] / 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 snprintf _snprintf
9 #define vsnprintf _vsnprintf
10 #endif
11
12 #include "nasal.h"
13 #include "code.h"
14
15 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
16 #define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
17
18 // Generic argument error, assumes that the symbol "c" is a naContext,
19 // and that the __FUNCTION__ string is of the form "f_NASALSYMBOL".
20 #define ARGERR() \
21     naRuntimeError(c, "bad/missing argument to %s()", (__FUNCTION__ + 2))
22
23 static naRef f_size(naContext c, naRef me, int argc, naRef* args)
24 {
25     if(argc == 0) ARGERR();
26     if(naIsString(args[0])) return naNum(naStr_len(args[0]));
27     if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
28     if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
29     naRuntimeError(c, "object has no size()");
30     return naNil();
31 }
32
33 static naRef f_keys(naContext c, naRef me, int argc, naRef* args)
34 {
35     naRef v, h = argc > 0 ? args[0] : naNil();
36     if(!naIsHash(h)) ARGERR();
37     v = naNewVector(c);
38     naHash_keys(v, h);
39     return v;
40 }
41
42 static naRef f_append(naContext c, naRef me, int argc, naRef* args)
43 {
44     int i;
45     if(argc < 2 || !naIsVector(args[0])) ARGERR();
46     for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
47     return args[0];
48 }
49
50 static naRef f_pop(naContext c, naRef me, int argc, naRef* args)
51 {
52     if(argc < 1 || !naIsVector(args[0])) ARGERR();
53     return naVec_removelast(args[0]);
54 }
55
56 static naRef f_setsize(naContext c, naRef me, int argc, naRef* args)
57 {
58     if(argc < 2 || !naIsVector(args[0])) ARGERR();
59     naVec_setsize(args[0], (int)naNumValue(args[1]).num);
60     return args[0];
61 }
62
63 static naRef f_subvec(naContext c, naRef me, int argc, naRef* args)
64 {
65     int i;
66     naRef nlen, result, v = args[0];
67     int len = 0, start = (int)naNumValue(args[1]).num;
68     if(argc < 2) return naNil();
69     nlen = argc > 2 ? naNumValue(args[2]) : naNil();
70     if(!naIsNil(nlen))
71         len = (int)nlen.num;
72     if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
73         ARGERR();
74     if(naIsNil(nlen) || len > naVec_size(v) - start)
75         len = naVec_size(v) - start;
76     result = naNewVector(c);
77     naVec_setsize(result, len);
78     for(i=0; i<len; i++)
79         naVec_set(result, i, naVec_get(v, start + i));
80     return result;
81 }
82
83 static naRef f_delete(naContext c, naRef me, int argc, naRef* args)
84 {
85     if(argc < 2 || !naIsHash(args[0])) ARGERR();
86     naHash_delete(args[0], args[1]);
87     return args[0];
88 }
89
90 static naRef f_int(naContext c, naRef me, int argc, naRef* args)
91 {
92     if(argc > 0) {
93         naRef n = naNumValue(args[0]);
94         if(naIsNil(n)) return n;
95         if(n.num < 0) n.num = -floor(-n.num);
96         else n.num = floor(n.num);
97         return n;
98     } else ARGERR();
99     return naNil();
100 }
101
102 static naRef f_num(naContext c, naRef me, int argc, naRef* args)
103 {
104     return argc > 0 ? naNumValue(args[0]) : naNil();
105 }
106
107 static naRef f_streq(naContext c, naRef me, int argc, naRef* args)
108 {
109     return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
110 }
111
112 static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
113 {
114     char *a, *b;
115     int i, alen, blen;
116     if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
117         ARGERR();
118     a = naStr_data(args[0]);
119     alen = naStr_len(args[0]);
120     b = naStr_data(args[1]);
121     blen = naStr_len(args[1]);
122     for(i=0; i<alen && i<blen; i++) {
123         int diff = a[i] - b[i];
124         if(diff) return naNum(diff < 0 ? -1 : 1);
125     }
126     return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
127 }
128
129 static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
130 {
131     int start, len, srclen;
132     naRef src = argc > 0 ? args[0] : naNil();
133     naRef startr = argc > 1 ? naNumValue(args[1]) : naNil();
134     naRef lenr = argc > 2 ? naNumValue(args[2]) : naNil();
135     if(!naIsString(src)) ARGERR();
136     if(naIsNil(startr) || !naIsNum(startr)) ARGERR();
137     if(!naIsNil(lenr) && !naIsNum(lenr)) ARGERR();
138     srclen = naStr_len(src);
139     start = (int)startr.num;
140     len = naIsNum(lenr) ? (int)lenr.num : (srclen - start);
141     if(start < 0) start += srclen;
142     if(start < 0) start = len = 0;
143     if(start >= srclen) start = len = 0;
144     if(len < 0) len = 0;
145     if(len > srclen - start) len = srclen - start;
146     return naStr_substr(naNewString(c), src, start, len);
147 }
148
149 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
150 {
151     char chr[1];
152     naRef cr = argc > 0 ? naNumValue(args[0]) : naNil();
153     if(IS_NIL(cr)) ARGERR();
154     chr[0] = (char)cr.num;
155     return NEWSTR(c, chr, 1);
156 }
157
158 static naRef f_contains(naContext c, naRef me, int argc, naRef* args)
159 {
160     naRef hash = argc > 0 ? args[0] : naNil();
161     naRef key = argc > 1 ? args[1] : naNil();
162     if(naIsNil(hash) || naIsNil(key)) ARGERR();
163     if(!naIsHash(hash)) return naNil();
164     return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
165 }
166
167 static naRef f_typeof(naContext c, naRef me, int argc, naRef* args)
168 {
169     naRef r = argc > 0 ? args[0] : naNil();
170     char* t = "unknown";
171     if(naIsNil(r)) t = "nil";
172     else if(naIsNum(r)) t = "scalar";
173     else if(naIsString(r)) t = "scalar";
174     else if(naIsVector(r)) t = "vector";
175     else if(naIsHash(r)) t = "hash";
176     else if(naIsFunc(r)) t = "func";
177     else if(naIsGhost(r)) t = "ghost";
178     return NEWCSTR(c, t);
179 }
180
181 static naRef f_ghosttype(naContext c, naRef me, int argc, naRef* args)
182 {
183     naRef g = argc > 0 ? args[0] : naNil();
184     if(!naIsGhost(g)) return naNil();
185     if(naGhost_type(g)->name) {
186         return NEWCSTR(c, (char*)naGhost_type(g)->name);
187     } else {
188         char buf[32];
189         sprintf(buf, "%p", naGhost_type(g));
190         return NEWCSTR(c, buf);
191     }
192 }
193
194 static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
195 {
196     int errLine;
197     naRef script, code, fname;
198     script = argc > 0 ? args[0] : naNil();
199     fname = argc > 1 ? args[1] : NEWCSTR(c, "<compile>");
200     if(!naIsString(script) || !naIsString(fname)) return naNil();
201     code = naParseCode(c, fname, 1,
202                        naStr_data(script), naStr_len(script), &errLine);
203     if(naIsNil(code)) {
204         char buf[256];
205         snprintf(buf, sizeof(buf), "Parse error: %s at line %d",
206                  naGetError(c), errLine);
207         c->dieArg = NEWCSTR(c, buf);
208         naRuntimeError(c, "__die__");
209     }
210     return naBindToContext(c, code);
211 }
212
213 // FIXME: need a place to save the current IP when we get an error so
214 // that it can be reset if we get a die()/naRethrowError() situation
215 // later.  Right now, the IP on the stack trace is the line of the
216 // die() call, when it should be this one...
217 //
218 // FIXME: don't use naCall at all here, we don't need it.  Fix up the
219 // context stack to tail call the function directly.  There's no need
220 // for f_call() to live on the C stack at all.
221 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
222 {
223     naContext subc;
224     naRef callargs, callme, callns, result;
225     struct VecRec* vr;
226     callargs = argc > 1 ? args[1] : naNil();
227     callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
228     callns = argc > 3 ? args[3] : naNil(); // ditto
229     if(!IS_HASH(callme)) callme = naNil();
230     if(!IS_HASH(callns)) callns = naNil();
231     if(argc==0 || !IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
232         ARGERR();
233
234     subc = naSubContext(c);
235     vr = IS_NIL(callargs) ? 0 : PTR(callargs).vec->rec;
236     result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
237                     callme, callns);
238     if(!naGetError(subc)) {
239         naFreeContext(subc);
240         return result;
241     }
242
243     // Error handling. Note that we don't free the subcontext after an
244     // error, in case the user re-throws the same error or calls
245     // naContinue()
246     if(argc <= 2 || !IS_VEC(args[argc-1])) {
247         naRethrowError(subc);
248     } else {
249         int i, sd;
250         naRef errv = args[argc-1];
251         if(!IS_NIL(subc->dieArg)) naVec_append(errv, subc->dieArg);
252         else naVec_append(errv, NEWCSTR(subc, naGetError(subc)));
253         sd = naStackDepth(subc);
254         for(i=0; i<sd; i++) {
255             naVec_append(errv, naGetSourceFile(subc, i));
256             naVec_append(errv, naNum(naGetLine(subc, i)));
257         }
258     }
259     return naNil();
260 }
261
262 static naRef f_die(naContext c, naRef me, int argc, naRef* args)
263 {
264     naRef darg = argc > 0 ? args[0] : naNil();
265     if(!naIsNil(darg) && c->callChild && IDENTICAL(c->callChild->dieArg, darg))
266         naRethrowError(c->callChild);
267     c->dieArg = darg;
268     naRuntimeError(c, "__die__");
269     return naNil(); // never executes
270 }
271
272 // Wrapper around vsnprintf, iteratively increasing the buffer size
273 // until it fits.  Returned buffer should be freed by the caller.
274 static char* dosprintf(char* f, ...)
275 {
276     char* buf;
277     va_list va;
278     int olen, len = 16;
279     while(1) {
280         buf = naAlloc(len);
281         va_start(va, f);
282         olen = vsnprintf(buf, len, f, va);
283         if(olen >= 0 && olen < len) {
284             va_end(va);
285             return buf;
286         }
287         va_end(va);
288         naFree(buf);
289         len *= 2;
290     }
291 }
292
293 // Inspects a printf format string f, and finds the next "%..." format
294 // specifier.  Stores the start of the specifier in out, the length in
295 // len, and the type in type.  Returns a pointer to the remainder of
296 // the format string, or 0 if no format string was found.  Recognizes
297 // all of ANSI C's syntax except for the "length modifier" feature.
298 // Note: this does not validate the format character returned in
299 // "type". That is the caller's job.
300 static char* nextFormat(naContext c, char* f, char** out, int* len, char* type)
301 {
302     // Skip to the start of the format string
303     while(*f && *f != '%') f++;
304     if(!*f) return 0;
305     *out = f++;
306
307     while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
308
309     // Test for duplicate flags.  This is pure pedantry and could
310     // be removed on all known platforms, but just to be safe...
311     {   char *p1, *p2;
312         for(p1 = *out + 1; p1 < f; p1++)
313             for(p2 = p1+1; p2 < f; p2++)
314                 if(*p1 == *p2)
315                     naRuntimeError(c, "duplicate flag in format string"); }
316
317     while(*f && *f >= '0' && *f <= '9') f++;
318     if(*f && *f == '.') f++;
319     while(*f && *f >= '0' && *f <= '9') f++;
320     if(!*f) naRuntimeError(c, "invalid format string");
321
322     *type = *f++;
323     *len = f - *out;
324     return f;
325 }
326
327 #define ERR(m) naRuntimeError(c, m)
328 #define APPEND(r) result = naStr_concat(naNewString(c), result, r)
329 static naRef f_sprintf(naContext c, naRef me, int argc, naRef* args)
330 {
331     char t, nultmp, *fstr, *next, *fout=0, *s;
332     int flen, argn=1;
333     naRef format, arg, result = naNewString(c);
334
335     if(argc < 1) ERR("not enough arguments to sprintf()");
336     format = naStringValue(c, argc > 0 ? args[0] : naNil());
337     if(naIsNil(format)) ERR("bad format string in sprintf()");
338     s = naStr_data(format);
339                                
340     while((next = nextFormat(c, s, &fstr, &flen, &t))) {
341         APPEND(NEWSTR(c, s, fstr-s)); // stuff before the format string
342         if(flen == 2 && fstr[1] == '%') {
343             APPEND(NEWSTR(c, "%", 1));
344             s = next;
345             continue;
346         }
347         if(argn >= argc) ERR("not enough arguments to sprintf()");
348         arg = args[argn++];
349         nultmp = fstr[flen]; // sneaky nul termination...
350         fstr[flen] = 0;
351         if(t == 's') {
352             arg = naStringValue(c, arg);
353             if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
354             else             fout = dosprintf(fstr, naStr_data(arg));
355         } else {
356             arg = naNumValue(arg);
357             if(naIsNil(arg))
358                 fout = dosprintf(fstr, "nil");
359             else if(t=='d' || t=='i' || t=='c')
360                 fout = dosprintf(fstr, (int)naNumValue(arg).num);
361             else if(t=='o' || t=='u' || t=='x' || t=='X')
362                 fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
363             else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
364                 fout = dosprintf(fstr, naNumValue(arg).num);
365             else
366                 ERR("invalid sprintf format type");
367         }
368         fstr[flen] = nultmp;
369         APPEND(NEWSTR(c, fout, strlen(fout)));
370         naFree(fout);
371         s = next;
372     }
373     APPEND(NEWSTR(c, s, strlen(s)));
374     return result;
375 }
376
377 // FIXME: needs to honor subcontext list
378 static naRef f_caller(naContext c, naRef me, int argc, naRef* args)
379 {
380     int fidx;
381     struct Frame* frame;
382     naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
383     if(IS_NIL(fr)) ARGERR();
384     fidx = (int)fr.num;
385     if(fidx > c->fTop - 1) return naNil();
386     frame = &c->fStack[c->fTop - 1 - fidx];
387     result = naNewVector(c);
388     naVec_append(result, frame->locals);
389     naVec_append(result, frame->func);
390     naVec_append(result, PTR(PTR(frame->func).func->code).code->srcFile);
391     naVec_append(result, naNum(naGetLine(c, fidx)));
392     return result;
393 }
394
395 static naRef f_closure(naContext c, naRef me, int argc, naRef* args)
396 {
397     int i;
398     struct naFunc* f;
399     naRef func = argc > 0 ? args[0] : naNil();
400     naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
401     if(!IS_FUNC(func) || IS_NIL(idx)) ARGERR();
402     i = (int)idx.num;
403     f = PTR(func).func;
404     while(i > 0 && f) { i--; f = PTR(f->next).func; }
405     if(!f) return naNil();
406     return f->namespace;
407 }
408
409 static int match(unsigned char* a, unsigned char* b, int l)
410 {
411     int i;
412     for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
413     return 1;
414 }
415
416 static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
417 {
418     int i;
419     if(al == 0) return 0;
420     for(i=start; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
421     return -1;
422 }
423
424 static naRef f_find(naContext c, naRef me, int argc, naRef* args)
425 {
426     int start = 0;
427     if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
428     if(argc > 2) start = (int)(naNumValue(args[2]).num);
429     return naNum(find((void*)naStr_data(args[0]), naStr_len(args[0]),
430                       (void*)naStr_data(args[1]), naStr_len(args[1]),
431                       start));
432 }
433
434 static naRef f_split(naContext c, naRef me, int argc, naRef* args)
435 {
436     int sl, dl, i;
437     char *s, *d, *s0;
438     naRef result;
439     if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
440     d = naStr_data(args[0]); dl = naStr_len(args[0]);
441     s = naStr_data(args[1]); sl = naStr_len(args[1]);
442     result = naNewVector(c);
443     if(dl == 0) { // special case zero-length delimiter
444         for(i=0; i<sl; i++) naVec_append(result, NEWSTR(c, s+i, 1));
445         return result;
446     }
447     s0 = s;
448     for(i=0; i <= sl-dl; i++) {
449         if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
450             naVec_append(result, NEWSTR(c, s0, s+i-s0));
451             s0 = s + i + dl;
452             i += dl - 1;
453         }
454     }
455     if(s0 - s <= sl) naVec_append(result, NEWSTR(c, s0, s+sl-s0));
456     return result;
457 }
458
459 // This is a comparatively weak RNG, based on the C library's rand()
460 // function, which is usually not threadsafe and often of limited
461 // precision.  The 5x loop guarantees that we get a full double worth
462 // of precision even for 15 bit (Win32...) rand() implementations.
463 static naRef f_rand(naContext c, naRef me, int argc, naRef* args)
464 {
465     int i;
466     double r = 0;
467     if(argc) {
468         if(!IS_NUM(args[0])) naRuntimeError(c, "rand() seed not number");
469         srand((unsigned int)args[0].num);
470         return naNil();
471     }
472     for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
473     return naNum(r);
474 }
475
476 static naRef f_bind(naContext c, naRef me, int argc, naRef* args)
477 {
478     naRef func = argc > 0 ? args[0] : naNil();
479     naRef hash = argc > 1 ? args[1] : naNewHash(c);
480     naRef next = argc > 2 ? args[2] : naNil();
481     if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
482         ARGERR();
483     func = naNewFunc(c, PTR(func).func->code);
484     PTR(func).func->namespace = hash;
485     PTR(func).func->next = next;
486     return func;
487 }
488
489 /* We use the "SortRec" gadget for two reasons: first, because ANSI
490  * qsort() doesn't give us a mechanism for passing a "context" pointer
491  * to the comparison routine we have to store one in every sorted
492  * record.  Second, using an index into the original vector here
493  * allows us to make the sort stable in the event of a zero returned
494  * from the Nasal comparison function. */
495 struct SortData { naContext ctx, subc; struct SortRec* recs;
496                   naRef* elems; int n; naRef fn; };
497 struct SortRec { struct SortData* sd; int i; };
498
499 static int sortcmp(struct SortRec* a, struct SortRec* b)
500 {
501     struct SortData* sd = a->sd;
502     naRef args[2], d;
503     args[0] = sd->elems[a->i];
504     args[1] = sd->elems[b->i];
505     d = naCall(sd->subc, sd->fn, 2, args, naNil(), naNil());
506     if(naGetError(sd->subc)) {
507         naFree(sd->recs);
508         naRethrowError(sd->subc);
509     } else if(!naIsNum(d = naNumValue(d))) {
510         naFree(sd->recs);
511         naRuntimeError(sd->ctx, "sort() comparison returned non-number");
512     }
513     return (d.num > 0) ? 1 : ((d.num < 0) ? -1 : (a->i - b->i));
514 }
515
516 static naRef f_sort(naContext c, naRef me, int argc, naRef* args)
517 {
518     int i;
519     struct SortData sd;
520     naRef out;
521     if(argc != 2 || !naIsVector(args[0]) || !naIsFunc(args[1]))
522         naRuntimeError(c, "bad/missing argument to sort()");
523     sd.subc = naSubContext(c);
524     if(!PTR(args[0]).vec->rec) return naNewVector(c);
525     sd.elems = PTR(args[0]).vec->rec->array;
526     sd.n = PTR(args[0]).vec->rec->size;
527     sd.fn = args[1];
528     sd.recs = naAlloc(sizeof(struct SortRec) * sd.n);
529     for(i=0; i<sd.n; i++) {
530         sd.recs[i].sd = &sd;
531         sd.recs[i].i = i;
532     }
533     qsort(sd.recs, sd.n, sizeof(sd.recs[0]),
534           (int(*)(const void*,const void*))sortcmp);
535     out = naNewVector(c);
536     naVec_setsize(out, sd.n);
537     for(i=0; i<sd.n; i++)
538         PTR(out).vec->rec->array[i] = sd.elems[sd.recs[i].i];
539     naFree(sd.recs);
540     naFreeContext(sd.subc);
541     return out;
542 }
543
544 static naRef f_id(naContext c, naRef me, int argc, naRef* args)
545 {
546     char *t = "unk", buf[64];
547     if(argc != 1 || !IS_REF(args[0]))
548         naRuntimeError(c, "bad/missing argument to id()");
549     if     (IS_STR(args[0]))   t = "str";
550     else if(IS_VEC(args[0]))   t = "vec";
551     else if(IS_HASH(args[0]))  t = "hash";
552     else if(IS_CODE(args[0]))  t = "code";
553     else if(IS_FUNC(args[0]))  t = "func";
554     else if(IS_CCODE(args[0])) t = "ccode";
555     else if(IS_GHOST(args[0])) {
556         naGhostType *gt = PTR(args[0]).ghost->gtype;
557         t = gt->name ? (char*)gt->name : "ghost";
558     }
559     sprintf(buf, "%s:%p", (char*)t, (void*)PTR(args[0]).obj);
560     return NEWCSTR(c, buf);
561 }
562
563 static naCFuncItem funcs[] = {
564     { "size", f_size },
565     { "keys", f_keys }, 
566     { "append", f_append }, 
567     { "pop", f_pop }, 
568     { "setsize", f_setsize }, 
569     { "subvec", f_subvec }, 
570     { "delete", f_delete }, 
571     { "int", f_int },
572     { "num", f_num },
573     { "streq", f_streq },
574     { "cmp", f_cmp },
575     { "substr", f_substr },
576     { "chr", f_chr },
577     { "contains", f_contains },
578     { "typeof", f_typeof },
579     { "ghosttype", f_ghosttype },
580     { "compile", f_compile },
581     { "call", f_call },
582     { "die", f_die },
583     { "sprintf", f_sprintf },
584     { "caller", f_caller },
585     { "closure", f_closure },
586     { "find", f_find },
587     { "split", f_split },
588     { "rand", f_rand },
589     { "bind", f_bind },
590     { "sort", f_sort },
591     { "id", f_id },
592     { 0 }
593 };
594
595 naRef naInit_std(naContext c)
596 {
597     return naGenLib(c, funcs);
598 }