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