7 #ifdef _MSC_VER // sigh...
8 #define snprintf _snprintf
9 #define vsnprintf _vsnprintf
15 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
16 #define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
18 // Generic argument error, assumes that the symbol "c" is a naContext,
19 // and that the __FUNCTION__ string is of the form "f_NASALSYMBOL".
21 naRuntimeError(c, "bad/missing argument to %s()", (__FUNCTION__ + 2))
23 static naRef f_size(naContext c, naRef me, int argc, naRef* args)
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()");
33 static naRef f_keys(naContext c, naRef me, int argc, naRef* args)
35 naRef v, h = argc > 0 ? args[0] : naNil();
36 if(!naIsHash(h)) ARGERR();
42 static naRef f_append(naContext c, naRef me, int argc, naRef* args)
45 if(argc < 2 || !naIsVector(args[0])) ARGERR();
46 for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
50 static naRef f_pop(naContext c, naRef me, int argc, naRef* args)
52 if(argc < 1 || !naIsVector(args[0])) ARGERR();
53 return naVec_removelast(args[0]);
56 static naRef f_setsize(naContext c, naRef me, int argc, naRef* args)
58 if(argc < 2 || !naIsVector(args[0])) ARGERR();
59 naVec_setsize(args[0], (int)naNumValue(args[1]).num);
63 static naRef f_subvec(naContext c, naRef me, int argc, naRef* args)
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();
72 if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
74 if(naIsNil(nlen) || len > naVec_size(v) - start)
75 len = naVec_size(v) - start;
76 result = naNewVector(c);
77 naVec_setsize(result, len);
79 naVec_set(result, i, naVec_get(v, start + i));
83 static naRef f_delete(naContext c, naRef me, int argc, naRef* args)
85 if(argc < 2 || !naIsHash(args[0])) ARGERR();
86 naHash_delete(args[0], args[1]);
90 static naRef f_int(naContext c, naRef me, int argc, naRef* args)
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);
102 static naRef f_num(naContext c, naRef me, int argc, naRef* args)
104 return argc > 0 ? naNumValue(args[0]) : naNil();
107 static naRef f_streq(naContext c, naRef me, int argc, naRef* args)
109 return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
112 static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
116 if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
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);
126 return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
129 static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
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;
145 if(len > srclen - start) len = srclen - start;
146 return naStr_substr(naNewString(c), src, start, len);
149 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
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);
158 static naRef f_contains(naContext c, naRef me, int argc, naRef* args)
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);
167 static naRef f_typeof(naContext c, naRef me, int argc, naRef* args)
169 naRef r = argc > 0 ? args[0] : naNil();
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);
181 static naRef f_ghosttype(naContext c, naRef me, int argc, naRef* args)
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);
189 sprintf(buf, "%p", naGhost_type(g));
190 return NEWCSTR(c, buf);
194 static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
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);
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__");
210 return naBindToContext(c, code);
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 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
220 naRef callargs, callme, callns, result;
222 callargs = argc > 1 ? args[1] : naNil();
223 callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
224 callns = argc > 3 ? args[3] : naNil(); // ditto
225 if(!IS_HASH(callme)) callme = naNil();
226 if(!IS_HASH(callns)) callns = naNil();
227 if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
230 // Note that we don't free the subcontext, in case the user
231 // re-throws the same error. That happens at the next OP_RETURN
232 // or naSubContext().
233 subc = naSubContext(c);
234 vr = IS_NIL(callargs) ? 0 : PTR(callargs).vec->rec;
235 result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
237 if(naGetError(subc)) {
238 if(argc <= 2 || !IS_VEC(args[argc-1])) {
239 naRethrowError(subc);
242 naRef errv = args[argc-1];
243 if(!IS_NIL(subc->dieArg)) naVec_append(errv, subc->dieArg);
244 else naVec_append(errv, NEWCSTR(subc, naGetError(subc)));
245 sd = naStackDepth(subc);
246 for(i=0; i<sd; i++) {
247 naVec_append(errv, naGetSourceFile(subc, i));
248 naVec_append(errv, naNum(naGetLine(subc, i)));
255 static naRef f_die(naContext c, naRef me, int argc, naRef* args)
257 naRef darg = argc > 0 ? args[0] : naNil();
258 if(!naIsNil(darg) && c->callChild && IDENTICAL(c->callChild->dieArg, darg))
259 naRethrowError(c->callChild);
261 naRuntimeError(c, "__die__");
262 return naNil(); // never executes
265 // Wrapper around vsnprintf, iteratively increasing the buffer size
266 // until it fits. Returned buffer should be freed by the caller.
267 static char* dosprintf(char* f, ...)
275 olen = vsnprintf(buf, len, f, va);
276 if(olen >= 0 && olen < len) {
286 // Inspects a printf format string f, and finds the next "%..." format
287 // specifier. Stores the start of the specifier in out, the length in
288 // len, and the type in type. Returns a pointer to the remainder of
289 // the format string, or 0 if no format string was found. Recognizes
290 // all of ANSI C's syntax except for the "length modifier" feature.
291 // Note: this does not validate the format character returned in
292 // "type". That is the caller's job.
293 static char* nextFormat(naContext c, char* f, char** out, int* len, char* type)
295 // Skip to the start of the format string
296 while(*f && *f != '%') f++;
300 while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
302 // Test for duplicate flags. This is pure pedantry and could
303 // be removed on all known platforms, but just to be safe...
305 for(p1 = *out + 1; p1 < f; p1++)
306 for(p2 = p1+1; p2 < f; p2++)
308 naRuntimeError(c, "duplicate flag in format string"); }
310 while(*f && *f >= '0' && *f <= '9') f++;
311 if(*f && *f == '.') f++;
312 while(*f && *f >= '0' && *f <= '9') f++;
313 if(!*f) naRuntimeError(c, "invalid format string");
320 #define ERR(m) naRuntimeError(c, m)
321 #define APPEND(r) result = naStr_concat(naNewString(c), result, r)
322 static naRef f_sprintf(naContext c, naRef me, int argc, naRef* args)
324 char t, nultmp, *fstr, *next, *fout=0, *s;
326 naRef format, arg, result = naNewString(c);
328 if(argc < 1) ERR("not enough arguments to sprintf()");
329 format = naStringValue(c, argc > 0 ? args[0] : naNil());
330 if(naIsNil(format)) ERR("bad format string in sprintf()");
331 s = naStr_data(format);
333 while((next = nextFormat(c, s, &fstr, &flen, &t))) {
334 APPEND(NEWSTR(c, s, fstr-s)); // stuff before the format string
335 if(flen == 2 && fstr[1] == '%') {
336 APPEND(NEWSTR(c, "%", 1));
340 if(argn >= argc) ERR("not enough arguments to sprintf()");
342 nultmp = fstr[flen]; // sneaky nul termination...
345 arg = naStringValue(c, arg);
346 if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
347 else fout = dosprintf(fstr, naStr_data(arg));
349 arg = naNumValue(arg);
351 fout = dosprintf(fstr, "nil");
352 else if(t=='d' || t=='i' || t=='c')
353 fout = dosprintf(fstr, (int)naNumValue(arg).num);
354 else if(t=='o' || t=='u' || t=='x' || t=='X')
355 fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
356 else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
357 fout = dosprintf(fstr, naNumValue(arg).num);
359 ERR("invalid sprintf format type");
362 APPEND(NEWSTR(c, fout, strlen(fout)));
366 APPEND(NEWSTR(c, s, strlen(s)));
370 // FIXME: needs to honor subcontext list
371 static naRef f_caller(naContext c, naRef me, int argc, naRef* args)
375 naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
376 if(IS_NIL(fr)) ARGERR();
378 if(fidx > c->fTop - 1) return naNil();
379 frame = &c->fStack[c->fTop - 1 - fidx];
380 result = naNewVector(c);
381 naVec_append(result, frame->locals);
382 naVec_append(result, frame->func);
383 naVec_append(result, PTR(PTR(frame->func).func->code).code->srcFile);
384 naVec_append(result, naNum(naGetLine(c, fidx)));
388 static naRef f_closure(naContext c, naRef me, int argc, naRef* args)
392 naRef func = argc > 0 ? args[0] : naNil();
393 naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
394 if(!IS_FUNC(func) || IS_NIL(idx)) ARGERR();
397 while(i > 0 && f) { i--; f = PTR(f->next).func; }
398 if(!f) return naNil();
402 static int match(unsigned char* a, unsigned char* b, int l)
405 for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
409 static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
412 if(al == 0) return 0;
413 for(i=start; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
417 static naRef f_find(naContext c, naRef me, int argc, naRef* args)
420 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
421 if(argc > 2) start = (int)(naNumValue(args[2]).num);
422 return naNum(find(PTR(args[0]).str->data, PTR(args[0]).str->len,
423 PTR(args[1]).str->data, PTR(args[1]).str->len,
427 static naRef f_split(naContext c, naRef me, int argc, naRef* args)
432 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
433 d = naStr_data(args[0]); dl = naStr_len(args[0]);
434 s = naStr_data(args[1]); sl = naStr_len(args[1]);
435 result = naNewVector(c);
436 if(dl == 0) { // special case zero-length delimiter
437 for(i=0; i<sl; i++) naVec_append(result, NEWSTR(c, s+i, 1));
441 for(i=0; i <= sl-dl; i++) {
442 if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
443 naVec_append(result, NEWSTR(c, s0, s+i-s0));
448 if(s0 - s <= sl) naVec_append(result, NEWSTR(c, s0, s+sl-s0));
452 // This is a comparatively weak RNG, based on the C library's rand()
453 // function, which is usually not threadsafe and often of limited
454 // precision. The 5x loop guarantees that we get a full double worth
455 // of precision even for 15 bit (Win32...) rand() implementations.
456 static naRef f_rand(naContext c, naRef me, int argc, naRef* args)
461 if(!IS_NUM(args[0])) naRuntimeError(c, "rand() seed not number");
462 srand((unsigned int)args[0].num);
465 for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
469 static naRef f_bind(naContext c, naRef me, int argc, naRef* args)
471 naRef func = argc > 0 ? args[0] : naNil();
472 naRef hash = argc > 1 ? args[1] : naNewHash(c);
473 naRef next = argc > 2 ? args[2] : naNil();
474 if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
476 func = naNewFunc(c, PTR(func).func->code);
477 PTR(func).func->namespace = hash;
478 PTR(func).func->next = next;
482 static naCFuncItem funcs[] = {
485 { "append", f_append },
487 { "setsize", f_setsize },
488 { "subvec", f_subvec },
489 { "delete", f_delete },
492 { "streq", f_streq },
494 { "substr", f_substr },
496 { "contains", f_contains },
497 { "typeof", f_typeof },
498 { "ghosttype", f_ghosttype },
499 { "compile", f_compile },
502 { "sprintf", f_sprintf },
503 { "caller", f_caller },
504 { "closure", f_closure },
506 { "split", f_split },
512 naRef naInit_std(naContext c)
514 return naGenLib(c, funcs);