static int checkVec(struct Context* ctx, naRef vec, naRef idx)
{
int i = (int)numify(ctx, idx);
- if(i < 0 || !vec.ref.ptr.vec->rec || i >= vec.ref.ptr.vec->rec->size)
- ERR(ctx, "vector index out of bounds");
+ if(i < 0) i += naVec_size(vec);
+ if(i < 0 || i >= naVec_size(vec)) ERR(ctx, "vector index out of bounds");
+ return i;
+}
+
+static int checkStr(struct Context* ctx, naRef str, naRef idx)
+{
+ int i = (int)numify(ctx, idx);
+ if(i < 0) i += naStr_len(str);
+ if(i < 0 || i >= naStr_len(str)) ERR(ctx, "string index out of bounds");
return i;
}
ERR(ctx, "undefined value in container");
} else if(IS_VEC(box)) {
result = naVec_get(box, checkVec(ctx, box, key));
+ } else if(IS_STR(box)) {
+ result = naNum((unsigned char)naStr_data(box)[checkStr(ctx, box, key)]);
} else {
ERR(ctx, "extract from non-container");
}
if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
else if(IS_HASH(box)) naHash_set(box, key, val);
else if(IS_VEC(box)) naVec_set(box, checkVec(ctx, box, key), val);
- else ERR(ctx, "insert into non-container");
+ else if(IS_STR(box)) {
+ if(box.ref.ptr.str->hashcode)
+ ERR(ctx, "cannot change immutable string");
+ naStr_data(box)[checkStr(ctx, box, key)] = (char)numify(ctx, val);
+ } else ERR(ctx, "insert into non-container");
+}
+
+static void initTemps(struct Context* c)
+{
+ c->tempsz = 4;
+ c->temps = naAlloc(c->tempsz * sizeof(struct naObj*));
+ c->ntemps = 0;
}
static void initContext(struct Context* c)
c->fTop = c->opTop = c->markTop = 0;
for(i=0; i<NUM_NASAL_TYPES; i++)
c->nfree[i] = 0;
- naVec_setsize(c->temps, 4);
+
+ if(c->tempsz > 32) {
+ naFree(c->temps);
+ initTemps(c);
+ }
+
c->callParent = 0;
c->callChild = 0;
c->dieArg = naNil();
struct Context* naNewContext()
{
- int dummy;
struct Context* c;
if(globals == 0)
initGlobals();
} else {
UNLOCK();
c = (struct Context*)naAlloc(sizeof(struct Context));
- // Chicken and egg, can't use naNew because it requires temps to exist
- c->temps = naObj(T_VEC, (naGC_get(&globals->pools[T_VEC], 1, &dummy))[0]);
+ initTemps(c);
initContext(c);
LOCK();
c->nextAll = globals->allContexts;
void naFreeContext(struct Context* c)
{
- naVec_setsize(c->temps, 0);
+ c->ntemps = 0;
LOCK();
c->nextFree = globals->freeContexts;
globals->freeContexts = c;
ctx->opStack[ctx->opTop++] = r; \
} while(0)
-struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
+static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
{
int i;
+ struct naCode* c = f->func.ref.ptr.func->code.ref.ptr.code;
+
+ // Set the argument symbols, and put any remaining args in a vector
+ if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
+ for(i=0; i<c->nArgs; i++)
+ naHash_newsym(f->locals.ref.ptr.hash,
+ &c->constants[c->argSyms[i]], &args[i]);
+ args += c->nArgs;
+ nargs -= c->nArgs;
+ for(i=0; i<c->nOptArgs; i++, nargs--) {
+ naRef val = nargs > 0 ? args[i] : c->constants[c->optArgVals[i]];
+ if(IS_CODE(val))
+ val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
+ naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]],
+ &val);
+ }
+ args += c->nOptArgs;
+ if(c->needArgVector || nargs > 0) {
+ naRef argsv = naNewVector(ctx);
+ naVec_setsize(argsv, nargs > 0 ? nargs : 0);
+ for(i=0; i<nargs; i++)
+ argsv.ref.ptr.vec->rec->array[i] = *args++;
+ naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &argsv);
+ }
+}
+
+struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
+{
naRef *frame;
struct Frame* f;
- struct naCode* c;
DBG(printf("setupFuncall(nargs:%d, mcall:%d)\n", nargs, mcall);)
if(mcall)
naHash_set(f->locals, globals->meRef, frame[-1]);
- // Set the argument symbols, and put any remaining args in a vector
- c = (*frame++).ref.ptr.func->code.ref.ptr.code;
- if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
- for(i=0; i<c->nArgs; i++)
- naHash_newsym(f->locals.ref.ptr.hash,
- &c->constants[c->argSyms[i]], &frame[i]);
- frame += c->nArgs;
- nargs -= c->nArgs;
- for(i=0; i<c->nOptArgs; i++, nargs--) {
- naRef val = nargs > 0 ? frame[i] : c->constants[c->optArgVals[i]];
- if(IS_CODE(val))
- val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
- naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]],
- &val);
- }
- if(c->needArgVector || nargs > 0)
- {
- naRef args = naNewVector(ctx);
- naVec_setsize(args, nargs > 0 ? nargs : 0);
- for(i=0; i<nargs; i++)
- args.ref.ptr.vec->rec->array[i] = *frame++;
- naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &args);
- }
+ setupArgs(ctx, f, frame+1, nargs);
ctx->opTop = f->bp; // Pop the stack last, to avoid GC lossage
DBG(printf("Entering frame %d with %d args\n", ctx->fTop-1, nargs);)
default:
ERR(ctx, "BUG: bad opcode");
}
- ctx->temps.ref.ptr.vec->rec->size = 0; // reset GC temp vector
+ ctx->ntemps = 0; // reset GC temp vector
DBG(printStackDEBUG(ctx);)
}
return naNil(); // unreachable
char* naGetError(struct Context* ctx)
{
if(IS_STR(ctx->dieArg))
- return ctx->dieArg.ref.ptr.str->data;
+ return (char*)ctx->dieArg.ref.ptr.str->data;
return ctx->error;
}
return func;
}
-naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals)
+naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
+ naRef obj, naRef locals)
{
+ int i;
naRef result;
if(!ctx->callParent) naModLock(ctx);
// We might have to allocate objects, which can call the GC. But
// the call isn't on the Nasal stack yet, so the GC won't find our
// C-space arguments.
- naVec_append(ctx->temps, func);
- naVec_append(ctx->temps, args);
- naVec_append(ctx->temps, obj);
- naVec_append(ctx->temps, locals);
+ naTempSave(ctx, func);
+ for(i=0; i<argc; i++)
+ naTempSave(ctx, args[i]);
+ naTempSave(ctx, obj);
+ naTempSave(ctx, locals);
+
+ if(IS_CCODE(func.ref.ptr.func->code)) {
+ naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
+ result = (*fp)(ctx, obj, argc, args);
+ if(!ctx->callParent) naModUnlock(ctx);
+ return result;
+ }
if(IS_NIL(locals))
locals = naNewHash(ctx);
if(!IS_FUNC(func))
func = naNewFunc(ctx, func); // bind bare code objects
-
- if(!IS_NIL(args))
- naHash_set(locals, globals->argRef, args);
if(!IS_NIL(obj))
naHash_set(locals, globals->meRef, obj);
ctx->fStack[0].ip = 0;
ctx->fStack[0].bp = ctx->opTop;
+ setupArgs(ctx, ctx->fStack, args, argc);
+
// Return early if an error occurred. It will be visible to the
// caller via naGetError().
ctx->error = 0;
return naNil();
}
- if(IS_CCODE(func.ref.ptr.func->code)) {
- naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
- struct naVec* av = args.ref.ptr.vec;
- result = (*fp)(ctx, obj, av->rec->size, av->rec->array);
- } else
- result = run(ctx);
+ result = run(ctx);
if(!ctx->callParent) naModUnlock(ctx);
return result;
}
// GC-findable reference point for objects that may live on the
// processor ("real") stack during execution. naNew() places them
// here, and clears the array each instruction
- naRef temps;
+ struct naObj** temps;
+ int ntemps;
+ int tempsz;
// Error handling
jmp_buf jumpHandle;
static int findConstantIndex(struct Parser* p, struct Token* t)
{
- naRef c;
+ naRef c, dummy;
if(t->type == TOK_NIL) c = naNil();
else if(t->str) {
c = naStr_fromdata(naNewString(p->context), t->str, t->strlen);
+ naHash_get(globals->symbols, c, &dummy); // noop, make c immutable
if(t->type == TOK_SYMBOL) c = naInternSymbol(c);
} else if(t->type == TOK_FUNC) c = newLambda(p, t);
else if(t->type == TOK_LITERAL) c = naNum(t->num);
#include "nasal.h"
-// Notes: A CODE object is a compiled set of bytecode instructions.
-// What actually gets executed at runtime is a bound FUNC object,
-// which combines the raw code with a namespace and a pointer to
-// parent function in the lexical closure.
enum { T_STR, T_VEC, T_HASH, T_CODE, T_FUNC, T_CCODE, T_GHOST,
NUM_NASAL_TYPES }; // V. important that this come last!
#define IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) \
&& a.ref.ptr.obj == b.ref.ptr.obj)
+#define MUTABLE(r) (IS_STR(r) && (r).ref.ptr.str->hashcode == 0)
+
// This is a macro instead of a separate struct to allow compilers to
// avoid padding. GCC on x86, at least, will always padd the size of
// an embedded struct up to 32 bits. Doing it this way allows the
void naFree(void* m);
void* naAlloc(int n);
+void* naRealloc(void* buf, int sz);
void naBZero(void* m, int n);
int naTypeSize(int type);
int naStr_numeric(naRef str);
int naStr_parsenum(char* str, int len, double* result);
int naStr_tonum(naRef str, double* out);
+naRef naStr_buf(naRef str, int len);
int naHash_tryset(naRef hash, naRef key, naRef val); // sets if exists
int naHash_sym(struct naHash* h, struct naStr* sym, naRef* out);
#define MIN_BLOCK_SIZE 256
-// "type" for an object freed by the collector
-#define T_GCFREED 123 // DEBUG
-
static void reap(struct naPool* p);
static void mark(naRef r);
globals->ndead = 0;
}
+static void marktemps(struct Context* c)
+{
+ int i;
+ naRef r = naNil();
+ for(i=0; i<c->ntemps; i++) {
+ r.ref.ptr.obj = c->temps[i];
+ mark(r);
+ }
+}
// Must be called with the big lock!
static void garbageCollect()
for(i=0; i < c->opTop; i++)
mark(c->opStack[i]);
mark(c->dieArg);
- mark(c->temps);
+ marktemps(c);
c = c->nextAll;
}
void naModLock()
{
- naCheckBottleneck();
LOCK();
globals->nThreads++;
UNLOCK();
+ naCheckBottleneck();
}
void naModUnlock()
}
// And add it to the free list
- o->type = T_GCFREED; // DEBUG
p->free[p->nfree++] = o;
}
for(i=0; i < need; i++) {
struct naObj* o = (struct naObj*)(newb->block + i*p->elemsz);
o->mark = 0;
- o->type = T_GCFREED; // DEBUG
p->free[p->nfree++] = o;
}
p->freetop += need;
return result;
}
+static void markvec(naRef r)
+{
+ int i;
+ struct VecRec* vr = r.ref.ptr.vec->rec;
+ if(!vr) return;
+ for(i=0; i<vr->size; i++)
+ mark(vr->array[i]);
+}
+
+static void markhash(naRef r)
+{
+ int i;
+ struct HashRec* hr = r.ref.ptr.hash->rec;
+ if(!hr) return;
+ for(i=0; i < (1<<hr->lgalloced); i++) {
+ struct HashNode* hn = hr->table[i];
+ while(hn) {
+ mark(hn->key);
+ mark(hn->val);
+ hn = hn->next;
+ }
+ }
+}
+
// Sets the reference bit on the object, and recursively on all
// objects reachable from it. Uses the processor stack for recursion...
static void mark(naRef r)
if(r.ref.ptr.obj->mark == 1)
return;
- // Verify that the object hasn't been freed incorrectly:
- if(r.ref.ptr.obj->type == T_GCFREED) *(int*)0=0; // DEBUG
-
r.ref.ptr.obj->mark = 1;
switch(r.ref.ptr.obj->type) {
- case T_VEC:
- if(r.ref.ptr.vec->rec)
- for(i=0; i<r.ref.ptr.vec->rec->size; i++)
- mark(r.ref.ptr.vec->rec->array[i]);
- break;
- case T_HASH:
- if(r.ref.ptr.hash->rec != 0) {
- struct HashRec* hr = r.ref.ptr.hash->rec;
- for(i=0; i < (1<<hr->lgalloced); i++) {
- struct HashNode* hn = hr->table[i];
- while(hn) {
- mark(hn->key);
- mark(hn->val);
- hn = hn->next;
- }
- }
- }
- break;
+ case T_VEC: markvec(r); break;
+ case T_HASH: markhash(r); break;
case T_CODE:
mark(r.ref.ptr.code->srcFile);
for(i=0; i<r.ref.ptr.code->nConstants; i++)
p->freetop = p->nfree;
}
+// Does the swap, returning the old value
+static void* doswap(void** target, void* val)
+{
+ void* old = *target;
+ *target = val;
+ return old;
+}
+
// Atomically replaces target with a new pointer, and adds the old one
// to the list of blocks to free the next time something holds the
// giant lock.
void naGC_swapfree(void** target, void* val)
{
+ void* old;
LOCK();
+ old = doswap(target, val);
while(globals->ndead >= globals->deadsz)
bottleneck();
- globals->deadBlocks[globals->ndead++] = *target;
- *target = val;
+ globals->deadBlocks[globals->ndead++] = old;
UNLOCK();
}
static void tmpStr(naRef* out, struct naStr* str, char* key)
{
str->len = 0;
- str->data = key;
+ str->data = (unsigned char*)key;
while(key[str->len]) str->len++;
*out = naNil();
out->ref.ptr.str = str;
{
int col;
struct HashRec* h = hash->rec;
- if(!h || h->size >= 1<<h->lgalloced)
+ while(!h || h->size >= 1<<h->lgalloced)
h = realloc(hash);
col = (HASH_MAGIC * sym->ref.ptr.str->hashcode) >> (32 - h->lgalloced);
INSERT(h, *sym, *val, col);
p->tree.lastChild = tok;
}
-// Parse a hex nibble
-static int hexc(char c, struct Parser* p, int index)
+static int hex(char c)
{
if(c >= '0' && c <= '9') return c - '0';
if(c >= 'A' && c <= 'F') return c - 'A' + 10;
if(c >= 'a' && c <= 'f') return c - 'a' + 10;
- error(p, "bad hex constant", index);
- return 0;
+ return -1;
+}
+
+static int hexc(char c, struct Parser* p, int index)
+{
+ int n = hex(c);
+ if(n < 0) error(p, "bad hex constant", index);
+ return n;
}
// Escape and returns a single backslashed expression in a single
}
}
+// FIXME: should handle UTF8 too
+static void charLiteral(struct Parser* p, int index, char* s, int len)
+{
+ if(len != 1) error(p, "character constant not single character", index);
+ newToken(p, index, TOK_LITERAL, 0, 0, *s);
+}
+
// Read in a string literal
-static int lexStringLiteral(struct Parser* p, int index, int singleQuote)
+static int lexStringLiteral(struct Parser* p, int index, char q)
{
int i, j, len, iteration;
char* out = 0;
char* buf = p->buf;
- char endMark = singleQuote ? '\'' : '"';
for(iteration = 0; iteration<2; iteration++) {
i = index+1;
while(i < p->len) {
char c = buf[i];
int eaten = 1;
- if(c == endMark)
- break;
+ if(c == q) break;
if(c == '\\') {
- if(singleQuote) sqEscape(buf+i, p->len-i, i, p, &c, &eaten);
- else dqEscape(buf+i, p->len-i, i, p, &c, &eaten);
+ if(q == '\'') sqEscape(buf+i, p->len-i, i, p, &c, &eaten);
+ else dqEscape(buf+i, p->len-i, i, p, &c, &eaten);
}
if(iteration == 1) out[j++] = c;
i += eaten;
// Finished stage one -- allocate the buffer for stage two
if(iteration == 0) out = naParseAlloc(p, len);
}
- newToken(p, index, TOK_LITERAL, out, len, 0);
+ if(q == '`') charLiteral(p, index, out, len);
+ else newToken(p, index, TOK_LITERAL, out, len, 0);
return i+1;
}
+static int lexHexLiteral(struct Parser* p, int index)
+{
+ int nib, i = index;
+ double d = 0;
+ while(i < p->len && (nib = hex(p->buf[i])) >= 0) {
+ d = d*16 + nib;
+ i++;
+ }
+ newToken(p, index, TOK_LITERAL, 0, 0, d);
+ return i;
+}
+
static int lexNumLiteral(struct Parser* p, int index)
{
int len = p->len, i = index;
- unsigned char* buf = p->buf;
+ unsigned char* buf = (unsigned char*)p->buf;
double d;
+ if(i+1<len && buf[i+1] == 'x') return lexHexLiteral(p, index+2);
+
while(i<len && buf[i] >= '0' && buf[i] <= '9') i++;
if(i<len && buf[i] == '.') {
i++;
case '#':
i = lineEnd(p, getLine(p, i));
break;
- case '\'': case '"':
- i = lexStringLiteral(p, i, (c=='"' ? 0 : 1));
+ case '\'': case '"': case '`':
+ i = lexStringLiteral(p, i, c);
break;
default:
if(c >= '0' && c <= '9') i = lexNumLiteral(p, i);
- else handled = 0;
+ else handled = 0;
}
// Lexemes and symbols are a little more complicated. Pick
// symbol (e.g. "orchid"). If neither match, we have a bad
// character in the mix.
if(!handled) {
- int symlen=0, lexlen=0, lexeme;
+ int symlen=0, lexlen=0, lexeme=-1;
lexlen = tryLexemes(p, i, &lexeme);
if((c>='A' && c<='Z') || (c>='a' && c<='z') || (c=='_'))
symlen = trySymbol(p, i);
#include "code.h"
#define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
+#define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
static naRef size(naContext c, naRef me, int argc, naRef* args)
{
return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
}
+static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
+{
+ char *a, *b;
+ int i, len;
+ if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
+ naRuntimeError(c, "bad argument to cmp");
+ a = naStr_data(args[0]);
+ b = naStr_data(args[1]);
+ len = naStr_len(args[0]);
+ if(naStr_len(args[1]) < len)
+ len = naStr_len(args[1]);
+ for(i=0; i<len; i++) {
+ int diff = a - b;
+ if(diff < 0) return naNum(-1);
+ else if(diff > 0) return naNum(1);
+ }
+ return naNum(0);
+}
+
static naRef substr(naContext c, naRef me, int argc, naRef* args)
{
naRef src = argc > 1 ? args[0] : naNil();
- naRef startR = argc > 1 ? args[1] : naNil();
- naRef lenR = argc > 2 ? args[2] : naNil();
+ naRef startR = argc > 1 ? naNumValue(args[1]) : naNil();
+ naRef lenR = argc > 2 ? naNumValue(args[2]) : naNil();
int start, len;
if(!naIsString(src)) return naNil();
- startR = naNumValue(startR);
if(naIsNil(startR)) return naNil();
start = (int)startR.num;
if(naIsNil(lenR)) {
return naStr_substr(naNewString(c), src, start, len);
}
-static naRef f_strc(naContext c, naRef me, int argc, naRef* args)
-{
- int idx;
- struct naStr* str = args[0].ref.ptr.str;
- naRef idr = argc > 1 ? naNumValue(args[1]) : naNum(0);
- if(argc < 1 || IS_NIL(idr) || !IS_STR(args[0]))
- naRuntimeError(c, "bad arguments to strc");
- idx = (int)naNumValue(idr).num;
- if(idx > str->len) naRuntimeError(c, "strc index out of bounds");
- return naNum(str->data[idx]);
-}
-
static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
{
char chr[1];
else if(naIsHash(r)) t = "hash";
else if(naIsFunc(r)) t = "func";
else if(naIsGhost(r)) t = "ghost";
- r = NEWSTR(c, t, strlen(t));
+ r = NEWCSTR(c, t);
return r;
}
naRef script, code, fname;
script = argc > 0 ? args[0] : naNil();
if(!naIsString(script)) return naNil();
- fname = NEWSTR(c, "<compile>", 9);
+ fname = NEWCSTR(c, "<compile>");
code = naParseCode(c, fname, 1,
naStr_data(script), naStr_len(script), &errLine);
if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
return naBindToContext(c, code);
}
-// Funcation metacall API. Allows user code to generate an arg vector
-// at runtime and/or call function references on arbitrary objects.
static naRef f_call(naContext c, naRef me, int argc, naRef* args)
{
naContext subc;
- naRef callargs, callme, result;
+ naRef callargs, callme, callns, result;
+ struct VecRec* vr;
callargs = argc > 1 ? args[1] : naNil();
callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
- if(!naIsFunc(args[0])) naRuntimeError(c, "call() on non-function");
- if(naIsNil(callargs)) callargs = naNewVector(c);
- else if(!naIsVector(callargs)) naRuntimeError(c, "call() args not vector");
- if(!naIsHash(callme)) callme = naNil();
+ callns = argc > 3 ? args[3] : naNil(); // ditto
+ if(!IS_HASH(callme)) callme = naNil();
+ if(!IS_HASH(callns)) callns = naNil();
+ if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
+ naRuntimeError(c, "bad argument to call()");
subc = naNewContext();
subc->callParent = c;
c->callChild = subc;
- result = naCall(subc, args[0], callargs, callme, naNil());
+ vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
+ result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
+ callme, callns);
c->callChild = 0;
- if(argc > 2 && !IS_NIL(subc->dieArg))
- if(naIsVector(args[argc-1]))
- naVec_append(args[argc-1], subc->dieArg);
+ if(argc > 2 && IS_VEC(args[argc-1])) {
+ if(!IS_NIL(subc->dieArg)) naVec_append(args[argc-1], subc->dieArg);
+ else if(naGetError(subc))
+ naVec_append(args[argc-1], NEWCSTR(subc, naGetError(subc)));
+ }
naFreeContext(subc);
return result;
}
return f->namespace;
}
-static int match(char* a, char* b, int l)
+static int match(unsigned char* a, unsigned char* b, int l)
{
int i;
for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
return 1;
}
-static int find(char* a, int al, char* s, int sl, int start)
+static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
{
int i;
if(al == 0) return 0;
{
int start = 0;
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
- naRuntimeError(ctx, "bad/missing argument to split");
+ naRuntimeError(ctx, "bad/missing argument to find");
if(argc > 2) start = (int)(naNumValue(args[2]).num);
return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
args[1].ref.ptr.str->data, args[1].ref.ptr.str->len,
}
s0 = s;
for(i=0; i <= sl-dl; i++) {
- if(match(s+i, d, dl)) {
+ if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
s0 = s + i + dl;
i += dl - 1;
{ "int", intf },
{ "num", num },
{ "streq", streq },
+ { "cmp", f_cmp },
{ "substr", substr },
- { "strc", f_strc },
{ "chr", f_chr },
{ "contains", contains },
{ "typeof", typeOf },
naHash_set(namespace, name, naNewFunc(c, code));
}
- // Set up constants for math.pi and math.e
+ // Set up constants for math.pi and math.e. Can't use M_PI or
+ // M_E, becuase those aren't technically part of the C standard. Sigh.
name = naStr_fromdata(naNewString(c), "pi", 2);
- naHash_set(namespace, name, naNum(M_PI));
+ naHash_set(namespace, name, naNum(3.14159265358979323846));
name = naStr_fromdata(naNewString(c), "e", 1);
name = naInternSymbol(name);
- naHash_set(namespace, name, naNum(M_E));
+ naHash_set(namespace, name, naNum(2.7182818284590452354));
return namespace;
}
void naFree(void* m) { free(m); }
void* naAlloc(int n) { return malloc(n); }
+void* naRealloc(void* b, int n) { return realloc(b, n); }
void naBZero(void* m, int n) { memset(m, 0, n); }
+void naTempSave(naContext c, naRef r)
+{
+ int i;
+ if(!IS_OBJ(r)) return;
+ if(c->ntemps >= c->tempsz) {
+ c->tempsz *= 2;
+ struct naObj** newtemps = naAlloc(c->tempsz * sizeof(struct naObj*));
+ for(i=0; i<c->ntemps; i++)
+ newtemps[i] = c->temps[i];
+ naFree(c->temps);
+ c->temps = newtemps;
+ }
+ c->temps[c->ntemps++] = r.ref.ptr.obj;
+}
+
naRef naObj(int type, struct naObj* o)
{
naRef r;
c->free[type] = naGC_get(&globals->pools[type],
OBJ_CACHE_SZ, &c->nfree[type]);
result = naObj(type, c->free[type][--c->nfree[type]]);
- naVec_append(c->temps, result);
+ naTempSave(c, result);
return result;
}
return 0x7fffffff; // Make sure the answer is nonsense :)
}
-int naIsNil(naRef r)
-{
- return IS_NIL(r);
-}
-
-int naIsNum(naRef r)
-{
- return IS_NUM(r);
-}
-
-int naIsString(naRef r)
-{
- return (!IS_NIL(r))&&IS_STR(r);
-}
-
-int naIsScalar(naRef r)
-{
- return IS_SCALAR(r);
-}
-
-int naIsVector(naRef r)
-{
- return (!IS_NIL(r))&&IS_VEC(r);
-}
-
-int naIsHash(naRef r)
-{
- return (!IS_NIL(r))&&IS_HASH(r);
-}
-
-int naIsFunc(naRef r)
-{
- return (!IS_NIL(r))&&IS_FUNC(r);
-}
-
-int naIsCode(naRef r)
-{
- return IS_CODE(r);
-}
-
-int naIsCCode(naRef r)
-{
- return IS_CCODE(r);
-}
-
-int naIsGhost(naRef r)
-{
- return IS_GHOST(r);
-}
+int naIsNil(naRef r) { return IS_NIL(r); }
+int naIsNum(naRef r) { return IS_NUM(r); }
+int naIsString(naRef r) { return IS_STR(r); }
+int naIsScalar(naRef r) { return IS_SCALAR(r); }
+int naIsVector(naRef r) { return IS_VEC(r); }
+int naIsHash(naRef r) { return IS_HASH(r); }
+int naIsFunc(naRef r) { return IS_FUNC(r); }
+int naIsCode(naRef r) { return IS_CODE(r); }
+int naIsCCode(naRef r) { return IS_CCODE(r); }
+int naIsGhost(naRef r) { return IS_GHOST(r); }
// referenced by it) from being garbage collected.
void naSave(naContext ctx, naRef obj);
+// Similar, but the object is automatically released when the
+// context next runs native bytecode. Useful for saving off C-space
+// temporaries to protect them before passing back into a naCall.
+void naTempSave(naContext c, naRef r);
+
// Parse a buffer in memory into a code object.
naRef naParseCode(naContext c, naRef srcFile, int firstLine,
char* buf, int len, int* errLine);
// Call a code or function object with the specifed arguments "on" the
// specified object and using the specified hash for the local
// variables. Any of args, obj or locals may be nil.
-naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals);
+naRef naCall(naContext ctx, naRef func, int argc, naRef* args, naRef obj, naRef locals);
// Throw an error from the current call stack. This function makes a
// longjmp call to a handler in naCall() and DOES NOT RETURN. It is
// Useful for passing as a namespace to an initial function call
naRef naStdLib(naContext c);
-// Ditto, with math functions
+// Ditto, for other core libraries
naRef naMathLib(naContext c);
+naRef naBitsLib(naContext c);
+naRef naIOLib(naContext c);
+naRef naRegexLib(naContext c);
+naRef naUnixLib(naContext c);
// Current line number & error message
int naStackDepth(naContext ctx);
struct Parser p;
// Protect from garbage collection
- naVec_append(c->temps, srcFile);
+ naTempSave(c, srcFile);
// Catch parser errors here.
*errLine = 0;
// Clean up our mess
naParseDestroy(&p);
- naVec_append(c->temps, codeObj);
+ naTempSave(c, codeObj);
return codeObj;
}
char* naStr_data(naRef s)
{
if(!IS_STR(s)) return 0;
- return s.ref.ptr.str->data;
+ return (char*)s.ref.ptr.str->data;
}
static void setlen(struct naStr* s, int sz)
s->data[sz] = 0; // nul terminate
}
+naRef naStr_buf(naRef dst, int len)
+{
+ setlen(dst.ref.ptr.str, len);
+ naBZero(dst.ref.ptr.str->data, len);
+ return dst;
+}
+
naRef naStr_fromdata(naRef dst, char* data, int len)
{
if(!IS_STR(dst)) return naNil();
int naStr_parsenum(char* str, int len, double* result)
{
- return tonum(str, len, result);
+ return tonum((unsigned char*)str, len, result);
}
int naStr_tonum(naRef str, double* out)
}
#endif
+
+extern int GccWarningWorkaround_IsoCForbidsAnEmptySourceFile;
void naSemUpAll(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
#endif
+
+extern int GccWarningWorkaround_IsoCForbidsAnEmptySourceFile;
#include "nasal.h"
#include "data.h"
-static void realloc(struct naVec* v)
+static struct VecRec* newvecrec(struct VecRec* old)
{
- struct VecRec* old = v->rec;
int i, oldsz = old ? old->size : 0, newsz = 1 + ((oldsz*3)>>1);
struct VecRec* vr = naAlloc(sizeof(struct VecRec) + sizeof(naRef) * newsz);
if(oldsz > newsz) oldsz = newsz; // race protection
vr->size = oldsz;
for(i=0; i<oldsz; i++)
vr->array[i] = old->array[i];
+ return vr;
+}
+
+static void realloc(struct naVec* v)
+{
+ struct VecRec* vr = newvecrec(v->rec);
naGC_swapfree((void**)&(v->rec), vr);
}
{
if(IS_VEC(v)) {
struct VecRec* r = v.ref.ptr.vec->rec;
- if(r && i < r->size) return r->array[i];
+ if(r) {
+ if(i < 0) i += r->size;
+ if(i >= 0 && i < r->size) return r->array[i];
+ }
}
return naNil();
}
{
if(IS_VEC(vec)) {
struct VecRec* r = vec.ref.ptr.vec->rec;
- if(!r || r->size >= r->alloced) {
+ while(!r || r->size >= r->alloced) {
realloc(vec.ref.ptr.vec);
r = vec.ref.ptr.vec->rec;
}