Sync with Nasal CVS (soon to become Nasal 1.1). Notable new features:

Nasal now supports calls to "subcontexts" and errors can be thrown
across them, leading to complete stack traces when call() is used,
instead of the truncated ones we now see.

Vectors can now be concatenated using the ~ operator that used to work
only for strings.

Better runtime error messages in general due to a fancier
naRuntimeError() implementation

A big data size shrink on 64 bit systems; the size of a naRef dropped
by a factor of two.

"Braceless code blocks" have been added to the parser, so you can
write expressions like "if(a) b();" just like in C.  Note that there's
still a parser bug in there that fails when you nest a braced block
within a braceless one.

Character constants that appear in Nasal source code can now be
literal multibyte UTF8 characters (this was always supported for
string literals, but character constants were forced to be a single
byte).

New modules: "bits", "thread", "utf8" and (gulp...) "io".  The bits
library might be useful to FlightGear, the utf8 one probably not as
Plib does not support wide character text rendering.  The thread
library will work fine for spawning threads to do Nasal stuff, but
obviously contact with the rest of FlightGear must be
hand-synchronized as FlightGear isn't threadsafe.  The io library is
no doubt the most useful, as it exposes all the basic stdio.h
facilities; it's also frighteningly dangerous when combined with
networked code...
This commit is contained in:
andy 2007-03-29 18:50:12 +00:00
parent 53d8cff835
commit b05e32fa8c
23 changed files with 1194 additions and 655 deletions

View File

@ -2,26 +2,12 @@ includedir = @includedir@/nasal
lib_LIBRARIES = libsgnasal.a
include_HEADERS = nasal.h
include_HEADERS = nasal.h naref.h
libsgnasal_a_SOURCES = \
code.c code.h \
codegen.c \
data.h \
gc.c \
hash.c \
lex.c \
lib.c \
mathlib.c \
iolib.c \
iolib.h \
bitslib.c \
misc.c \
nasal.h \
parse.c parse.h \
string.c \
vector.c \
thread-posix.c \
thread-win32.c
libsgnasal_a_SOURCES = bitslib.c code.c code.h codegen.c data.h gc.c \
hash.c iolib.c iolib.h lex.c lib.c mathlib.c \
misc.c naref.h nasal.h parse.c parse.h string.c \
thread-posix.c thread-win32.c threadlib.c \
utf8lib.c vector.c
INCLUDES = -I$(top_srcdir)

View File

@ -5,10 +5,10 @@
// bits (i.e. an unsigned int). Using a 64 bit integer would stretch
// that beyond what is representable in the double result, but
// requires portability work.
#define BIT(s,l,n) s[l-1-((n)>>3)] & (1<<((n)&7))
#define CLRB(s,l,n) s[l-1-((n)>>3)] &= ~(1<<((n)&7))
#define SETB(s,l,n) s[l-1-((n)>>3)] |= 1<<((n)&7)
#define MSK(n) (1 << (7 - ((n) & 7)))
#define BIT(s,l,n) s[(n)>>3] & MSK(n)
#define CLRB(s,l,n) s[(n)>>3] &= ~MSK(n)
#define SETB(s,l,n) s[(n)>>3] |= MSK(n)
static unsigned int fld(naContext c, unsigned char* s,
int slen, int bit, int flen)
@ -32,7 +32,7 @@ static void setfld(naContext c, unsigned char* s, int slen,
static naRef dofld(naContext c, int argc, naRef* args, int sign)
{
struct naStr* s = argc > 0 ? args[0].ref.ptr.str : 0;
struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
int bit = argc > 1 ? (int)naNumValue(args[1]).num : -1;
int len = argc > 2 ? (int)naNumValue(args[2]).num : -1;
unsigned int f;
@ -56,7 +56,7 @@ static naRef f_fld(naContext c, naRef me, int argc, naRef* args)
static naRef f_setfld(naContext c, naRef me, int argc, naRef* args)
{
struct naStr* s = argc > 0 ? args[0].ref.ptr.str : 0;
struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
int bit = argc > 1 ? (int)naNumValue(args[1]).num : -1;
int len = argc > 2 ? (int)naNumValue(args[2]).num : -1;
naRef val = argc > 3 ? naNumValue(args[3]) : naNil();
@ -73,22 +73,15 @@ static naRef f_buf(naContext c, naRef me, int argc, naRef* args)
return naStr_buf(naNewString(c), (int)len.num);
}
static struct func { char* name; naCFunction func; } funcs[] = {
static naCFuncItem funcs[] = {
{ "sfld", f_sfld },
{ "fld", f_fld },
{ "setfld", f_setfld },
{ "buf", f_buf },
{ 0 }
};
naRef naBitsLib(naContext c)
naRef naInit_bits(naContext c)
{
naRef namespace = naNewHash(c);
int i, n = sizeof(funcs)/sizeof(struct func);
for(i=0; i<n; i++) {
naRef code = naNewCCode(c, funcs[i].func);
naRef name = naStr_fromdata(naNewString(c),
funcs[i].name, strlen(funcs[i].name));
naHash_set(namespace, name, naNewFunc(c, code));
}
return namespace;
return naGenLib(c, funcs);
}

View File

@ -1,11 +1,14 @@
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include "nasal.h"
#include "code.h"
////////////////////////////////////////////////////////////////////////
// Debugging stuff. ////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
//#define DEBUG_NASAL
#if !defined(DEBUG_NASAL)
//#define INTERPRETER_DUMP
#if !defined(INTERPRETER_DUMP)
# define DBG(expr) /* noop */
#else
# define DBG(expr) expr
@ -17,21 +20,44 @@ void printOpDEBUG(int ip, int op);
void printStackDEBUG(struct Context* ctx);
////////////////////////////////////////////////////////////////////////
#ifdef _MSC_VER
#define vsnprintf _vsnprintf
#endif
struct Globals* globals = 0;
static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code);
#define ERR(c, msg) naRuntimeError((c),(msg))
void naRuntimeError(struct Context* c, char* msg)
void naRuntimeError(struct Context* c, const char* fmt, ...)
{
c->error = msg;
va_list ap;
va_start(ap, fmt);
vsnprintf(c->error, sizeof(c->error), fmt, ap);
va_end(ap);
longjmp(c->jumpHandle, 1);
}
void naRethrowError(naContext subc)
{
strncpy(subc->callParent->error, subc->error, sizeof(subc->error));
subc->callParent->dieArg = subc->dieArg;
longjmp(subc->callParent->jumpHandle, 1);
}
#define END_PTR ((void*)1)
#define IS_END(r) (IS_REF((r)) && PTR((r)).obj == END_PTR)
static naRef endToken()
{
naRef r;
SETPTR(r, END_PTR);
return r;
}
static int boolify(struct Context* ctx, naRef r)
{
if(IS_NUM(r)) return r.num != 0;
if(IS_NIL(r)) return 0;
if(IS_NIL(r) || IS_END(r)) return 0;
if(IS_STR(r)) {
double d;
if(naStr_len(r) == 0) return 0;
@ -65,7 +91,9 @@ static int checkVec(struct Context* ctx, naRef vec, naRef idx)
{
int i = (int)numify(ctx, idx);
if(i < 0) i += naVec_size(vec);
if(i < 0 || i >= naVec_size(vec)) ERR(ctx, "vector index out of bounds");
if(i < 0 || i >= naVec_size(vec))
naRuntimeError(ctx, "vector index %d out of bounds (size: %d)",
i, naVec_size(vec));
return i;
}
@ -73,7 +101,9 @@ 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");
if(i < 0 || i >= naStr_len(str))
naRuntimeError(ctx, "string index %d out of bounds (size: %d)",
i, naStr_len(str));
return i;
}
@ -82,8 +112,7 @@ static naRef containerGet(struct Context* ctx, naRef box, naRef key)
naRef result = naNil();
if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
if(IS_HASH(box)) {
if(!naHash_get(box, key, &result))
ERR(ctx, "undefined value in container");
naHash_get(box, key, &result);
} else if(IS_VEC(box)) {
result = naVec_get(box, checkVec(ctx, box, key));
} else if(IS_STR(box)) {
@ -100,7 +129,7 @@ static void containerSet(struct Context* ctx, naRef box, naRef key, naRef val)
else if(IS_HASH(box)) naHash_set(box, key, val);
else if(IS_VEC(box)) naVec_set(box, checkVec(ctx, box, key), val);
else if(IS_STR(box)) {
if(box.ref.ptr.str->hashcode)
if(PTR(box).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");
@ -128,7 +157,8 @@ static void initContext(struct Context* c)
c->callParent = 0;
c->callChild = 0;
c->dieArg = naNil();
c->error = 0;
c->error[0] = 0;
c->userData = 0;
}
static void initGlobals()
@ -191,9 +221,20 @@ struct Context* naNewContext()
return c;
}
struct Context* naSubContext(struct Context* super)
{
struct Context* ctx = naNewContext();
if(super->callChild) naFreeContext(super->callChild);
ctx->callParent = super;
super->callChild = ctx;
return ctx;
}
void naFreeContext(struct Context* c)
{
c->ntemps = 0;
if(c->callChild) naFreeContext(c->callChild);
if(c->callParent) c->callParent->callChild = 0;
LOCK();
c->nextFree = globals->freeContexts;
globals->freeContexts = c;
@ -212,12 +253,14 @@ void naFreeContext(struct Context* c)
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;
struct naCode* c = PTR(PTR(f->func).func->code).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");
if(nargs < c->nArgs)
naRuntimeError(ctx, "too few function args (have %d need %d)",
nargs, c->nArgs);
for(i=0; i<c->nArgs; i++)
naHash_newsym(f->locals.ref.ptr.hash,
naHash_newsym(PTR(f->locals).hash,
&c->constants[c->argSyms[i]], &args[i]);
args += c->nArgs;
nargs -= c->nArgs;
@ -225,7 +268,7 @@ static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int 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]],
naHash_newsym(PTR(f->locals).hash, &c->constants[c->optArgSyms[i]],
&val);
}
args += c->nOptArgs;
@ -233,12 +276,12 @@ static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
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);
PTR(argsv).vec->rec->array[i] = *args++;
naHash_newsym(PTR(f->locals).hash, &c->restArgSym, &argsv);
}
}
struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
static struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall)
{
naRef *frame;
struct Frame* f;
@ -249,19 +292,19 @@ struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
if(!IS_FUNC(frame[0]))
ERR(ctx, "function/method call invoked on uncallable object");
// Just do native calls right here, and don't touch the stack
// frames; return the current one (unless it's a tail call!).
if(frame[0].ref.ptr.func->code.ref.ptr.obj->type == T_CCODE) {
ctx->opFrame = ctx->opTop - (nargs + 1 + mcall);
// Just do native calls right here
if(PTR(PTR(frame[0]).func->code).obj->type == T_CCODE) {
naRef obj = mcall ? frame[-1] : naNil();
naCFunction fp = frame[0].ref.ptr.func->code.ref.ptr.ccode->fptr;
naCFunction fp = PTR(PTR(frame[0]).func->code).ccode->fptr;
naRef result = (*fp)(ctx, obj, nargs, frame + 1);
ctx->opTop -= nargs + 1 + mcall;
ctx->opTop = ctx->opFrame;
PUSH(result);
return &(ctx->fStack[ctx->fTop-1]);
}
if(tail) ctx->fTop--;
else if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
// Note: assign nil first, otherwise the naNew() can cause a GC,
// which will now (after fTop++) see the *old* reference as a
@ -271,7 +314,7 @@ struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
f->locals = naNewHash(ctx);
f->func = frame[0];
f->ip = 0;
f->bp = ctx->opTop - (nargs + 1 + mcall);
f->bp = ctx->opFrame;
if(mcall)
naHash_set(f->locals, globals->meRef, frame[-1]);
@ -283,29 +326,35 @@ struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
return f;
}
static naRef evalAndOr(struct Context* ctx, int op, naRef ra, naRef rb)
{
int a = boolify(ctx, ra);
int b = boolify(ctx, rb);
int result;
if(op == OP_AND) result = a && b ? 1 : 0;
else result = a || b ? 1 : 0;
return naNum(result);
}
static naRef evalEquality(int op, naRef ra, naRef rb)
{
int result = naEqual(ra, rb);
return naNum((op==OP_EQ) ? result : !result);
}
static naRef evalCat(naContext ctx, naRef l, naRef r)
{
if(IS_VEC(l) && IS_VEC(r)) {
int i, ls = naVec_size(l), rs = naVec_size(r);
naRef v = naNewVector(ctx);
naVec_setsize(v, ls + rs);
for(i=0; i<ls; i+=1) naVec_set(v, i, naVec_get(l, i));
for(i=0; i<rs; i+=1) naVec_set(v, i+ls, naVec_get(r, i));
return v;
} else {
naRef a = stringify(ctx, l);
naRef b = stringify(ctx, r);
return naStr_concat(naNewString(ctx), a, b);
}
}
// When a code object comes out of the constant pool and shows up on
// the stack, it needs to be bound with the lexical context.
static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code)
{
naRef result = naNewFunc(ctx, code);
result.ref.ptr.func->namespace = f->locals;
result.ref.ptr.func->next = f->func;
PTR(result).func->namespace = f->locals;
PTR(result).func->next = f->func;
return result;
}
@ -313,7 +362,7 @@ static int getClosure(struct naFunc* c, naRef sym, naRef* result)
{
while(c) {
if(naHash_get(c->namespace, sym, result)) return 1;
c = c->next.ref.ptr.func;
c = PTR(c->next).func;
}
return 0;
}
@ -322,8 +371,8 @@ static naRef getLocal2(struct Context* ctx, struct Frame* f, naRef sym)
{
naRef result;
if(!naHash_get(f->locals, sym, &result))
if(!getClosure(f->func.ref.ptr.func, sym, &result))
ERR(ctx, "undefined symbol");
if(!getClosure(PTR(f->func).func, sym, &result))
naRuntimeError(ctx, "undefined symbol: %s", naStr_data(sym));
return result;
}
@ -331,14 +380,14 @@ static void getLocal(struct Context* ctx, struct Frame* f,
naRef* sym, naRef* out)
{
struct naFunc* func;
struct naStr* str = sym->ref.ptr.str;
if(naHash_sym(f->locals.ref.ptr.hash, str, out))
struct naStr* str = PTR(*sym).str;
if(naHash_sym(PTR(f->locals).hash, str, out))
return;
func = f->func.ref.ptr.func;
while(func && func->namespace.ref.ptr.hash) {
if(naHash_sym(func->namespace.ref.ptr.hash, str, out))
func = PTR(f->func).func;
while(func && PTR(func->namespace).hash) {
if(naHash_sym(PTR(func->namespace).hash, str, out))
return;
func = func->next.ref.ptr.func;
func = PTR(func->next).func;
}
// Now do it again using the more general naHash_get(). This will
// only be necessary if something has created the value in the
@ -349,7 +398,7 @@ static void getLocal(struct Context* ctx, struct Frame* f,
static int setClosure(naRef func, naRef sym, naRef val)
{
struct naFunc* c = func.ref.ptr.func;
struct naFunc* c = PTR(func).func;
if(c == 0) { return 0; }
else if(naHash_tryset(c->namespace, sym, val)) { return 1; }
else { return setClosure(c->next, sym, val); }
@ -365,28 +414,42 @@ static naRef setSymbol(struct Frame* f, naRef sym, naRef val)
return val;
}
// Recursively descend into the parents lists
static int getMember(struct Context* ctx, naRef obj, naRef fld,
naRef* result, int count)
// Funky API: returns null to indicate no member, an empty string to
// indicate success, or a non-empty error message. Works this way so
// we can generate smart error messages without throwing them with a
// longjmp -- this gets called under naMember_get() from C code.
static const char* getMember_r(naRef obj, naRef field, naRef* out, int count)
{
naRef p;
if(--count < 0) ERR(ctx, "too many parents");
if(!IS_HASH(obj)) ERR(ctx, "non-objects have no members");
if(naHash_get(obj, fld, result)) {
return 1;
} else if(naHash_get(obj, globals->parentsRef, &p)) {
if(IS_VEC(p)) {
int i;
struct VecRec* v = p.ref.ptr.vec->rec;
for(i=0; i<v->size; i++)
if(getMember(ctx, v->array[i], fld, result, count))
return 1;
} else
ERR(ctx, "parents field not vector");
naRef p;
struct VecRec* pv;
if(--count < 0) return "too many parents";
if(!IS_HASH(obj)) return 0;
if(naHash_get(obj, field, out)) return "";
if(!naHash_get(obj, globals->parentsRef, &p)) return 0;
if(!IS_VEC(p)) return "object \"parents\" field not vector";
pv = PTR(p).vec->rec;
for(i=0; i<pv->size; i++) {
const char* err = getMember_r(pv->array[i], field, out, count);
if(err) return err; /* either an error or success */
}
return 0;
}
static void getMember(struct Context* ctx, naRef obj, naRef fld,
naRef* result, int count)
{
const char* err = getMember_r(obj, fld, result, count);
if(!err) naRuntimeError(ctx, "No such member: %s", naStr_data(fld));
if(err[0]) naRuntimeError(ctx, err);
}
int naMember_get(naRef obj, naRef field, naRef* out)
{
const char* err = getMember_r(obj, field, out, 64);
return err && !err[0];
}
// OP_EACH works like a vector get, except that it leaves the vector
// and index on the stack, increments the index after use, and
// pushes a nil if the index is beyond the end.
@ -394,9 +457,9 @@ static void evalEach(struct Context* ctx, int useIndex)
{
int idx = (int)(ctx->opStack[ctx->opTop-1].num);
naRef vec = ctx->opStack[ctx->opTop-2];
if(!IS_VEC(vec)) naRuntimeError(ctx, "foreach enumeration of non-vector");
if(!vec.ref.ptr.vec->rec || idx >= vec.ref.ptr.vec->rec->size) {
PUSH(naNil());
if(!IS_VEC(vec)) ERR(ctx, "foreach enumeration of non-vector");
if(!PTR(vec).vec->rec || idx >= PTR(vec).vec->rec->size) {
PUSH(endToken());
return;
}
ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
@ -408,13 +471,16 @@ static void evalEach(struct Context* ctx, int useIndex)
#define POP() ctx->opStack[--ctx->opTop]
#define STK(n) (ctx->opStack[ctx->opTop-(n)])
#define FIXFRAME() f = &(ctx->fStack[ctx->fTop-1]); \
cd = f->func.ref.ptr.func->code.ref.ptr.code;
cd = PTR(PTR(f->func).func->code).code;
static naRef run(struct Context* ctx)
{
struct Frame* f;
struct naCode* cd;
int op, arg;
naRef a, b, c;
naRef a, b;
ctx->dieArg = naNil();
ctx->error[0] = 0;
FIXFRAME();
@ -440,8 +506,7 @@ static naRef run(struct Context* ctx)
#define BINOP(expr) do { \
double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
STK(2).ref.reftag = ~NASAL_REFTAG; \
STK(2).num = expr; \
SETNUM(STK(2), expr); \
ctx->opTop--; } while(0)
case OP_PLUS: BINOP(l + r); break;
@ -452,24 +517,15 @@ static naRef run(struct Context* ctx)
case OP_LTE: BINOP(l <= r ? 1 : 0); break;
case OP_GT: BINOP(l > r ? 1 : 0); break;
case OP_GTE: BINOP(l >= r ? 1 : 0); break;
#undef BINOP
case OP_EQ: case OP_NEQ:
STK(2) = evalEquality(op, STK(2), STK(1));
ctx->opTop--;
break;
case OP_AND: case OP_OR:
STK(2) = evalAndOr(ctx, op, STK(2), STK(1));
ctx->opTop--;
break;
case OP_CAT:
// stringify can call the GC, so don't take stuff of the stack!
a = stringify(ctx, ctx->opStack[ctx->opTop-1]);
b = stringify(ctx, ctx->opStack[ctx->opTop-2]);
c = naStr_concat(naNewString(ctx), b, a);
ctx->opTop -= 2;
PUSH(c);
STK(2) = evalCat(ctx, STK(2), STK(1));
ctx->opTop -= 1;
break;
case OP_NEG:
STK(1) = naNum(-numify(ctx, STK(1)));
@ -491,6 +547,9 @@ static naRef run(struct Context* ctx)
case OP_PUSHNIL:
PUSH(naNil());
break;
case OP_PUSHEND:
PUSH(endToken());
break;
case OP_NEWVEC:
PUSH(naNewVector(ctx));
break;
@ -520,8 +579,7 @@ static naRef run(struct Context* ctx)
ctx->opTop--;
break;
case OP_MEMBER:
if(!getMember(ctx, STK(1), CONSTARG(), &STK(1), 64))
ERR(ctx, "no such member");
getMember(ctx, STK(1), CONSTARG(), &STK(1), 64);
break;
case OP_SETMEMBER:
if(!IS_HASH(STK(3))) ERR(ctx, "non-objects have no members");
@ -548,15 +606,29 @@ static naRef run(struct Context* ctx)
f->ip = cd->byteCode[f->ip];
DBG(printf(" [Jump to: %d]\n", f->ip);)
break;
case OP_JIFNIL:
case OP_JIFEND:
arg = ARG();
if(IS_NIL(STK(1))) {
if(IS_END(STK(1))) {
ctx->opTop--; // Pops **ONLY** if it's nil!
f->ip = arg;
DBG(printf(" [Jump to: %d]\n", f->ip);)
}
break;
case OP_JIFTRUE:
arg = ARG();
if(boolify(ctx, STK(1))) {
f->ip = arg;
DBG(printf(" [Jump to: %d]\n", f->ip);)
}
break;
case OP_JIFNOT:
arg = ARG();
if(!boolify(ctx, STK(1))) {
f->ip = arg;
DBG(printf(" [Jump to: %d]\n", f->ip);)
}
break;
case OP_JIFNOTPOP:
arg = ARG();
if(!boolify(ctx, POP())) {
f->ip = arg;
@ -564,23 +636,17 @@ static naRef run(struct Context* ctx)
}
break;
case OP_FCALL:
f = setupFuncall(ctx, ARG(), 0, 0);
cd = f->func.ref.ptr.func->code.ref.ptr.code;
break;
case OP_FTAIL:
f = setupFuncall(ctx, ARG(), 0, 1);
cd = f->func.ref.ptr.func->code.ref.ptr.code;
f = setupFuncall(ctx, ARG(), 0);
cd = PTR(PTR(f->func).func->code).code;
break;
case OP_MCALL:
f = setupFuncall(ctx, ARG(), 1, 0);
cd = f->func.ref.ptr.func->code.ref.ptr.code;
break;
case OP_MTAIL:
f = setupFuncall(ctx, ARG(), 1, 1);
cd = f->func.ref.ptr.func->code.ref.ptr.code;
f = setupFuncall(ctx, ARG(), 1);
cd = PTR(PTR(f->func).func->code).code;
break;
case OP_RETURN:
a = STK(1);
ctx->dieArg = naNil();
if(ctx->callChild) naFreeContext(ctx->callChild);
if(--ctx->fTop <= 0) return a;
ctx->opTop = f->bp + 1; // restore the correct opstack frame!
STK(1) = a;
@ -594,7 +660,7 @@ static naRef run(struct Context* ctx)
break;
case OP_MARK: // save stack state (e.g. "setjmp")
if(ctx->markTop >= MAX_MARK_DEPTH)
naRuntimeError(ctx, "mark stack overflow");
ERR(ctx, "mark stack overflow");
ctx->markStack[ctx->markTop++] = ctx->opTop;
break;
case OP_UNMARK: // pop stack state set by mark
@ -624,48 +690,55 @@ void naSave(struct Context* ctx, naRef obj)
naVec_append(globals->save, obj);
}
// FIXME: handle ctx->callParent
int naStackDepth(struct Context* ctx)
{
return ctx->fTop;
return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
}
static int findFrame(naContext ctx, naContext* out, int fn)
{
int sd = naStackDepth(ctx->callChild);
if(fn < sd) return findFrame(ctx->callChild, out, fn);
*out = ctx;
return ctx->fTop - 1 - (fn - sd);
}
// FIXME: handle ctx->callParent
int naGetLine(struct Context* ctx, int frame)
{
struct Frame* f = &ctx->fStack[ctx->fTop-1-frame];
naRef func = f->func;
int ip = f->ip;
if(IS_FUNC(func) && IS_CODE(func.ref.ptr.func->code)) {
struct naCode* c = func.ref.ptr.func->code.ref.ptr.code;
struct Frame* f;
frame = findFrame(ctx, &ctx, frame);
f = &ctx->fStack[frame];
if(IS_FUNC(f->func) && IS_CODE(PTR(f->func).func->code)) {
struct naCode* c = PTR(PTR(f->func).func->code).code;
unsigned short* p = c->lineIps + c->nLines - 2;
while(p >= c->lineIps && p[0] > ip)
while(p >= c->lineIps && p[0] > f->ip)
p -= 2;
return p[1];
}
return -1;
}
// FIXME: handle ctx->callParent
naRef naGetSourceFile(struct Context* ctx, int frame)
{
naRef f = ctx->fStack[ctx->fTop-1-frame].func;
f = f.ref.ptr.func->code;
return f.ref.ptr.code->srcFile;
naRef f;
frame = findFrame(ctx, &ctx, frame);
f = ctx->fStack[frame].func;
f = PTR(f).func->code;
return PTR(f).code->srcFile;
}
char* naGetError(struct Context* ctx)
{
if(IS_STR(ctx->dieArg))
return (char*)ctx->dieArg.ref.ptr.str->data;
return ctx->error;
return (char*)PTR(ctx->dieArg).str->data;
return ctx->error[0] ? ctx->error : 0;
}
naRef naBindFunction(naContext ctx, naRef code, naRef closure)
{
naRef func = naNewFunc(ctx, code);
func.ref.ptr.func->namespace = closure;
func.ref.ptr.func->next = naNil();
PTR(func).func->namespace = closure;
PTR(func).func->next = naNil();
return func;
}
@ -673,8 +746,8 @@ naRef naBindToContext(naContext ctx, naRef code)
{
naRef func = naNewFunc(ctx, code);
struct Frame* f = &ctx->fStack[ctx->fTop-1];
func.ref.ptr.func->namespace = f->locals;
func.ref.ptr.func->next = f->func;
PTR(func).func->namespace = f->locals;
PTR(func).func->next = f->func;
return func;
}
@ -683,7 +756,7 @@ naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
{
int i;
naRef result;
if(!ctx->callParent) naModLock(ctx);
if(!ctx->callParent) naModLock();
// 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
@ -694,22 +767,28 @@ naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
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);
// naRuntimeError() calls end up here:
if(setjmp(ctx->jumpHandle)) {
if(!ctx->callParent) naModUnlock(ctx);
return naNil();
}
if(IS_CCODE(PTR(func).func->code)) {
naCFunction fp = PTR(PTR(func).func->code).ccode->fptr;
result = (*fp)(ctx, obj, argc, args);
if(!ctx->callParent) naModUnlock();
return result;
}
if(IS_NIL(locals))
locals = naNewHash(ctx);
if(!IS_FUNC(func))
func = naNewFunc(ctx, func); // bind bare code objects
if(!IS_FUNC(func)) {
func = naNewFunc(ctx, func);
PTR(func).func->namespace = locals;
}
if(!IS_NIL(obj))
naHash_set(locals, globals->meRef, obj);
ctx->dieArg = naNil();
ctx->opTop = ctx->markTop = 0;
ctx->fTop = 1;
ctx->fStack[0].func = func;
@ -717,18 +796,24 @@ naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
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;
if(setjmp(ctx->jumpHandle)) {
if(!ctx->callParent) naModUnlock(ctx);
return naNil();
}
if(args) setupArgs(ctx, ctx->fStack, args, argc);
result = run(ctx);
if(!ctx->callParent) naModUnlock(ctx);
return result;
}
naRef naContinue(naContext ctx)
{
naRef result;
if(!ctx->callParent) naModLock();
if(setjmp(ctx->jumpHandle)) {
if(!ctx->callParent) naModUnlock(ctx);
return naNil();
}
ctx->opTop = ctx->opFrame;
PUSH(naNil());
result = run(ctx);
if(!ctx->callParent) naModUnlock();
return result;
}

View File

@ -15,14 +15,14 @@
#define OBJ_CACHE_SZ 128
enum {
OP_AND, OP_OR, OP_NOT, OP_MUL, OP_PLUS, OP_MINUS, OP_DIV, OP_NEG,
OP_NOT, OP_MUL, OP_PLUS, OP_MINUS, OP_DIV, OP_NEG,
OP_CAT, OP_LT, OP_LTE, OP_GT, OP_GTE, OP_EQ, OP_NEQ, OP_EACH,
OP_JMP, OP_JMPLOOP, OP_JIFNOT, OP_JIFNIL, OP_FCALL, OP_MCALL, OP_RETURN,
OP_PUSHCONST, OP_PUSHONE, OP_PUSHZERO, OP_PUSHNIL, OP_POP,
OP_JMP, OP_JMPLOOP, OP_JIFNOTPOP, OP_JIFEND, OP_FCALL, OP_MCALL,
OP_RETURN, OP_PUSHCONST, OP_PUSHONE, OP_PUSHZERO, OP_PUSHNIL, OP_POP,
OP_DUP, OP_XCHG, OP_INSERT, OP_EXTRACT, OP_MEMBER, OP_SETMEMBER,
OP_LOCAL, OP_SETLOCAL, OP_NEWVEC, OP_VAPPEND, OP_NEWHASH, OP_HAPPEND,
OP_MARK, OP_UNMARK, OP_BREAK, OP_FTAIL, OP_MTAIL, OP_SETSYM, OP_DUP2,
OP_INDEX, OP_BREAK2
OP_MARK, OP_UNMARK, OP_BREAK, OP_SETSYM, OP_DUP2, OP_INDEX, OP_BREAK2,
OP_PUSHEND, OP_JIFTRUE, OP_JIFNOT
};
struct Frame {
@ -69,6 +69,7 @@ struct Context {
struct Frame fStack[MAX_RECURSION];
int fTop;
naRef opStack[MAX_STACK_DEPTH];
int opFrame; // like Frame::bp, but for C functions
int opTop;
int markStack[MAX_MARK_DEPTH];
int markTop;
@ -86,7 +87,7 @@ struct Context {
// Error handling
jmp_buf jumpHandle;
char* error;
char error[128];
naRef dieArg;
// Sub-call lists
@ -96,6 +97,8 @@ struct Context {
// Linked list pointers in globals
struct Context* nextFree;
struct Context* nextAll;
void* userData;
};
#define globals nasal_globals
@ -103,11 +106,13 @@ extern struct Globals* globals;
// Threading low-level functions
void* naNewLock();
void naFreeLock(void* lock);
void naLock(void* lock);
void naUnlock(void* lock);
void* naNewSem();
void naFreeSem(void* sem);
void naSemDown(void* sem);
void naSemUpAll(void* sem, int count);
void naSemUp(void* sem, int count);
void naCheckBottleneck();

View File

@ -91,41 +91,6 @@ static int findConstantIndex(struct Parser* p, struct Token* t)
return internConstant(p, c);
}
static int lastExprInBlock(struct Token* t)
{
if(!t->parent) return 1;
if(t->parent->type == TOK_TOP || t->parent->type == TOK_LCURL) return 1;
if(t->parent->type == TOK_SEMI)
if(!t->next || t->next->type == TOK_EMPTY)
return 1;
return 0;
}
// Returns true if the node is in "tail context" -- either a child of
// a return, the last child of a func block, or else the
// last child of an if/elsif/if that is itself in tail context.
static int tailContext(struct Token* t)
{
if(t->parent && t->parent->type == TOK_RETURN)
return 1;
else if(!lastExprInBlock(t))
return 0;
// Walk up the tree. It is ok to see semicolons, else's, elsifs
// and curlies. If we reach the top or a func, then we are in
// tail context. If we hit an if, then we are in tail context
// only if the "if" node is.
while((t = t->parent) != 0)
switch(t->type) {
case TOK_SEMI: case TOK_LCURL: break;
case TOK_ELSE: case TOK_ELSIF: break;
case TOK_TOP: case TOK_FUNC: return 1;
case TOK_IF: return tailContext(t);
default: return 0;
}
return 0;
}
static int genScalarConstant(struct Parser* p, struct Token* t)
{
// These opcodes are for special-case use in other constructs, but
@ -145,7 +110,7 @@ static int genScalarConstant(struct Parser* p, struct Token* t)
static int genLValue(struct Parser* p, struct Token* t, int* cidx)
{
if(t->type == TOK_LPAR) {
if(t->type == TOK_LPAR && t->rule != PREC_SUFFIX) {
return genLValue(p, LEFT(t), cidx); // Handle stuff like "(a) = 1"
} else if(t->type == TOK_SYMBOL) {
*cidx = genScalarConstant(p, t);
@ -293,8 +258,6 @@ static void genFuncall(struct Parser* p, struct Token* t)
genExpr(p, LEFT(t));
}
if(RIGHT(t)) nargs = genList(p, RIGHT(t), 0);
if(tailContext(t))
op = op == OP_FCALL ? OP_FTAIL : OP_MTAIL;
emitImmediate(p, op, nargs);
}
@ -334,15 +297,12 @@ static void fixJumpTarget(struct Parser* p, int spot)
static void genShortCircuit(struct Parser* p, struct Token* t)
{
int jumpNext, jumpEnd, isAnd = (t->type == TOK_AND);
int end;
genExpr(p, LEFT(t));
if(isAnd) emit(p, OP_NOT);
jumpNext = emitJump(p, OP_JIFNOT);
emit(p, isAnd ? OP_PUSHNIL : OP_PUSHONE);
jumpEnd = emitJump(p, OP_JMP);
fixJumpTarget(p, jumpNext);
end = emitJump(p, t->type == TOK_AND ? OP_JIFNOT : OP_JIFTRUE);
emit(p, OP_POP);
genExpr(p, RIGHT(t));
fixJumpTarget(p, jumpEnd);
fixJumpTarget(p, end);
}
@ -350,7 +310,7 @@ static void genIf(struct Parser* p, struct Token* tif, struct Token* telse)
{
int jumpNext, jumpEnd;
genExpr(p, tif->children); // the test
jumpNext = emitJump(p, OP_JIFNOT);
jumpNext = emitJump(p, OP_JIFNOTPOP);
genExprList(p, tif->children->next->children); // the body
jumpEnd = emitJump(p, OP_JMP);
fixJumpTarget(p, jumpNext);
@ -374,7 +334,7 @@ static void genQuestion(struct Parser* p, struct Token* t)
if(!RIGHT(t) || RIGHT(t)->type != TOK_COLON)
naParseError(p, "invalid ?: expression", t->line);
genExpr(p, LEFT(t)); // the test
jumpNext = emitJump(p, OP_JIFNOT);
jumpNext = emitJump(p, OP_JIFNOTPOP);
genExpr(p, LEFT(RIGHT(t))); // the "if true" expr
jumpEnd = emitJump(p, OP_JMP);
fixJumpTarget(p, jumpNext);
@ -420,7 +380,7 @@ static void genForWhile(struct Parser* p, struct Token* init,
pushLoop(p, label);
loopTop = p->cg->codesz;
genExpr(p, test);
jumpEnd = emitJump(p, OP_JIFNOT);
jumpEnd = emitJump(p, OP_JIFNOTPOP);
genLoop(p, body, update, label, loopTop, jumpEnd);
}
@ -485,7 +445,7 @@ static void genForEach(struct Parser* p, struct Token* t)
pushLoop(p, label);
loopTop = p->cg->codesz;
emit(p, t->type == TOK_FOREACH ? OP_EACH : OP_INDEX);
jumpEnd = emitJump(p, OP_JIFNIL);
jumpEnd = emitJump(p, OP_JIFEND);
assignOp = genLValue(p, elem, &dummy);
emit(p, OP_XCHG);
emit(p, assignOp);
@ -522,7 +482,7 @@ static void genBreakContinue(struct Parser* p, struct Token* t)
for(i=0; i<levels; i++)
emit(p, (i<levels-1) ? OP_BREAK2 : OP_BREAK);
if(t->type == TOK_BREAK)
emit(p, OP_PUSHNIL); // breakIP is always a JIFNOT/JIFNIL!
emit(p, OP_PUSHEND); // breakIP is always a JIFNOTPOP/JIFEND!
emitImmediate(p, OP_JMP, t->type == TOK_BREAK ? bp : cp);
}
@ -544,6 +504,8 @@ static void newLineEntry(struct Parser* p, int line)
static void genExpr(struct Parser* p, struct Token* t)
{
int i, dummy;
if(!t) naParseError(p, "parse error", -1); // throw line -1...
p->errLine = t->line; // ...to use this one instead
if(t->line != p->cg->lastLine)
newLineEntry(p, t->line);
p->cg->lastLine = t->line;
@ -613,7 +575,7 @@ static void genExpr(struct Parser* p, struct Token* t)
case TOK_MINUS:
if(BINARY(t)) {
genBinOp(OP_MINUS, p, t); // binary subtraction
} else if(RIGHT(t)->type == TOK_LITERAL && !RIGHT(t)->str) {
} else if(RIGHT(t) && RIGHT(t)->type == TOK_LITERAL && !RIGHT(t)->str) {
RIGHT(t)->num *= -1; // Pre-negate constants
genScalarConstant(p, RIGHT(t));
} else {
@ -627,7 +589,7 @@ static void genExpr(struct Parser* p, struct Token* t)
break;
case TOK_DOT:
genExpr(p, LEFT(t));
if(RIGHT(t)->type != TOK_SYMBOL)
if(!RIGHT(t) || RIGHT(t)->type != TOK_SYMBOL)
naParseError(p, "object field not symbol", RIGHT(t)->line);
emitImmediate(p, OP_MEMBER, findConstantIndex(p, RIGHT(t)));
break;
@ -658,7 +620,7 @@ static void genExpr(struct Parser* p, struct Token* t)
static void genExprList(struct Parser* p, struct Token* t)
{
if(t->type == TOK_SEMI) {
if(t && t->type == TOK_SEMI) {
genExpr(p, LEFT(t));
if(RIGHT(t) && RIGHT(t)->type != TOK_EMPTY) {
emit(p, OP_POP);
@ -692,7 +654,7 @@ naRef naCodeGen(struct Parser* p, struct Token* block, struct Token* arglist)
// Now make a code object
codeObj = naNewCode(p->context);
code = codeObj.ref.ptr.code;
code = PTR(codeObj).code;
// Parse the argument list, if any
code->restArgSym = globals->argRef;

View File

@ -3,27 +3,83 @@
#include "nasal.h"
#if defined(NASAL_NAN64)
// On 64 bit systems, Nasal non-numeric references are stored with a
// bitmask that sets the top 16 bits. As a double, this is a
// signalling NaN that cannot itself be produced by normal numerics
// code. The pointer value can be reconstructed if (and only if) we
// are guaranteed that all memory that can be poitned to by a naRef
// (i.e. all memory returned by naAlloc) lives in the bottom 48 bits
// of memory. Linux on x86_64, Win64, Solaris and Irix all have such
// policies with address spaces:
//
// http://msdn.microsoft.com/library/en-us/win64/win64/virtual_address_space.asp
// http://docs.sun.com/app/docs/doc/816-5138/6mba6ua5p?a=view
// http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi/
// ... 0650/bks/SGI_Developer/books/T_IRIX_Prog/sgi_html/ch01.html
//
// In the above, MS guarantees 44 bits of process address space, SGI
// 40, and Sun 43 (Solaris *does* place the stack in the "negative"
// address space at 0xffff..., but we don't care as naRefs will never
// point there). Linux doesn't document this rigorously, but testing
// shows that it allows 47 bits of address space (and current x86_64
// implementations are limited to 48 bits of virtual space anyway). So
// we choose 48 as the conservative compromise.
#define REFMAGIC ((1UL<<48) - 1)
#define _ULP(r) ((unsigned long long)((r).ptr))
#define REFPTR(r) (_ULP(r) & REFMAGIC)
#define IS_REF(r) ((_ULP(r) & ~REFMAGIC) == ~REFMAGIC)
// Portability note: this cast from a pointer type to naPtr (a union)
// is not defined in ISO C, it's a GCC extention that doesn't work on
// (at least) either the SUNWspro or MSVC compilers. Unfortunately,
// fixing this would require abandoning the naPtr union for a set of
// PTR_<type>() macros, which is a ton of work and a lot of extra
// code. And as all enabled 64 bit platforms are gcc anyway, and the
// 32 bit fallback code works in any case, this is acceptable for now.
#define PTR(r) ((naPtr)((struct naObj*)(_ULP(r) & REFMAGIC)))
#define SETPTR(r, p) ((r).ptr = (void*)((unsigned long long)p | ~REFMAGIC))
#define SETNUM(r, n) ((r).num = n)
#else
// On 32 bit systems where the pointer is half the width of the
// double, we store a special magic number in the structure to make
// the double a NaN. This must appear in the top bits of the double,
// which is why the structure layout is endianness-dependent.
#define NASAL_REFTAG 0x7ff56789 // == 2,146,789,257 decimal
#define IS_REF(r) ((r).ref.reftag == NASAL_REFTAG)
#define PTR(r) ((r).ref.ptr)
#define SETPTR(r, p) ((r).ref.ptr.obj = (void*)p, (r).ref.reftag = NASAL_REFTAG)
#define SETNUM(r, n) ((r).ref.reftag = ~NASAL_REFTAG, (r).num = n)
#endif /* platform stuff */
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 IS_REF(r) ((r).ref.reftag == NASAL_REFTAG)
#define IS_NUM(r) ((r).ref.reftag != NASAL_REFTAG)
#define IS_OBJ(r) (IS_REF((r)) && (r).ref.ptr.obj != 0)
//#define IS_OBJ(r) (IS_REF((r)) && (r).ref.ptr.obj != 0 && (((r).ref.ptr.obj->type == 123) ? *(int*)0 : 1))
#define IS_NIL(r) (IS_REF((r)) && (r).ref.ptr.obj == 0)
#define IS_STR(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_STR)
#define IS_VEC(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_VEC)
#define IS_HASH(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_HASH)
#define IS_CODE(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_CODE)
#define IS_FUNC(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_FUNC)
#define IS_CCODE(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_CCODE)
#define IS_GHOST(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_GHOST)
#define IS_NUM(r) (!IS_REF(r))
#define IS_OBJ(r) (IS_REF(r) && PTR(r).obj != 0)
#define IS_NIL(r) (IS_REF(r) && PTR(r).obj == 0)
#define IS_STR(r) (IS_OBJ(r) && PTR(r).obj->type == T_STR)
#define IS_VEC(r) (IS_OBJ(r) && PTR(r).obj->type == T_VEC)
#define IS_HASH(r) (IS_OBJ(r) && PTR(r).obj->type == T_HASH)
#define IS_CODE(r) (IS_OBJ(r) && PTR(r).obj->type == T_CODE)
#define IS_FUNC(r) (IS_OBJ(r) && PTR(r).obj->type == T_FUNC)
#define IS_CCODE(r) (IS_OBJ(r) && PTR(r).obj->type == T_CCODE)
#define IS_GHOST(r) (IS_OBJ(r) && PTR(r).obj->type == T_GHOST)
#define IS_CONTAINER(r) (IS_VEC(r)||IS_HASH(r))
#define IS_SCALAR(r) (IS_NUM((r)) || IS_STR((r)))
#define IS_SCALAR(r) (IS_NUM(r) || IS_STR(r))
#define IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) \
&& a.ref.ptr.obj == b.ref.ptr.obj)
&& PTR(a).obj == PTR(b).obj)
#define MUTABLE(r) (IS_STR(r) && (r).ref.ptr.str->hashcode == 0)
#define MUTABLE(r) (IS_STR(r) && PTR(r).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

View File

@ -2,7 +2,7 @@
#include "data.h"
#include "code.h"
#define MIN_BLOCK_SIZE 256
#define MIN_BLOCK_SIZE 32
static void reap(struct naPool* p);
static void mark(naRef r);
@ -27,7 +27,7 @@ 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];
SETPTR(r, c->temps[i]);
mark(r);
}
}
@ -108,7 +108,7 @@ static void bottleneck()
if(g->waitCount >= g->nThreads - 1) {
freeDead();
if(g->needGC) garbageCollect();
if(g->waitCount) naSemUpAll(g->sem, g->waitCount);
if(g->waitCount) naSemUp(g->sem, g->waitCount);
g->bottleneck = 0;
}
}
@ -130,7 +130,7 @@ static void naCode_gcclean(struct naCode* o)
static void naGhost_gcclean(struct naGhost* g)
{
if(g->ptr) g->gtype->destroy(g->ptr);
if(g->ptr && g->gtype->destroy) g->gtype->destroy(g->ptr);
g->ptr = 0;
}
@ -214,7 +214,7 @@ struct naObj** naGC_get(struct naPool* p, int n, int* nout)
static void markvec(naRef r)
{
int i;
struct VecRec* vr = r.ref.ptr.vec->rec;
struct VecRec* vr = PTR(r).vec->rec;
if(!vr) return;
for(i=0; i<vr->size; i++)
mark(vr->array[i]);
@ -223,7 +223,7 @@ static void markvec(naRef r)
static void markhash(naRef r)
{
int i;
struct HashRec* hr = r.ref.ptr.hash->rec;
struct HashRec* hr = PTR(r).hash->rec;
if(!hr) return;
for(i=0; i < (1<<hr->lgalloced); i++) {
struct HashNode* hn = hr->table[i];
@ -244,22 +244,22 @@ static void mark(naRef r)
if(IS_NUM(r) || IS_NIL(r))
return;
if(r.ref.ptr.obj->mark == 1)
if(PTR(r).obj->mark == 1)
return;
r.ref.ptr.obj->mark = 1;
switch(r.ref.ptr.obj->type) {
PTR(r).obj->mark = 1;
switch(PTR(r).obj->type) {
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++)
mark(r.ref.ptr.code->constants[i]);
mark(PTR(r).code->srcFile);
for(i=0; i<PTR(r).code->nConstants; i++)
mark(PTR(r).code->constants[i]);
break;
case T_FUNC:
mark(r.ref.ptr.func->code);
mark(r.ref.ptr.func->namespace);
mark(r.ref.ptr.func->next);
mark(PTR(r).func->code);
mark(PTR(r).func->namespace);
mark(PTR(r).func->next);
break;
}
}
@ -270,7 +270,6 @@ static void reap(struct naPool* p)
{
struct Block* b;
int elem, freesz, total = poolsize(p);
p->nfree = 0;
freesz = total < MIN_BLOCK_SIZE ? MIN_BLOCK_SIZE : total;
freesz = (3 * freesz / 2) + (globals->nThreads * OBJ_CACHE_SZ);
if(p->freesz < freesz) {
@ -279,6 +278,9 @@ static void reap(struct naPool* p)
p->free = p->free0 = naAlloc(sizeof(void*) * p->freesz);
}
p->nfree = 0;
p->free = p->free0;
for(b = p->blocks; b; b = b->next)
for(elem=0; elem < b->size; elem++) {
struct naObj* o = (struct naObj*)(b->block + elem * p->elemsz);
@ -287,6 +289,8 @@ static void reap(struct naPool* p)
o->mark = 0;
}
p->freetop = p->nfree;
// allocs of this type until the next collection
globals->allocCount += total/2;
@ -299,7 +303,6 @@ static void reap(struct naPool* p)
if(need > 0)
newBlock(p, need);
}
p->freetop = p->nfree;
}
// Does the swap, returning the old value

View File

@ -3,9 +3,7 @@
#define MIN_HASH_SIZE 4
#define EQUAL(a, b) (((a).ref.reftag == (b).ref.reftag \
&& (a).ref.ptr.obj == (b).ref.ptr.obj) \
|| naEqual(a, b))
#define EQUAL(a, b) (IDENTICAL(a, b) || naEqual(a, b))
#define HASH_MAGIC 2654435769u
@ -28,15 +26,15 @@ static unsigned int hashcode(naRef r)
// 2*sizeof(int).
unsigned int* p = (unsigned int*)&(r.num);
return p[0] ^ p[1];
} else if(r.ref.ptr.str->hashcode) {
return r.ref.ptr.str->hashcode;
} else if(PTR(r).str->hashcode) {
return PTR(r).str->hashcode;
} else {
// This is Daniel Bernstein's djb2 hash function that I found
// on the web somewhere. It appears to work pretty well.
unsigned int i, hash = 5831;
for(i=0; i<r.ref.ptr.str->len; i++)
hash = (hash * 33) ^ r.ref.ptr.str->data[i];
r.ref.ptr.str->hashcode = hash;
for(i=0; i<PTR(r).str->len; i++)
hash = (hash * 33) ^ PTR(r).str->data[i];
PTR(r).str->hashcode = hash;
return hash;
}
}
@ -90,7 +88,7 @@ int naHash_sym(struct naHash* hash, struct naStr* sym, naRef* out)
int col = (HASH_MAGIC * sym->hashcode) >> (32 - h->lgalloced);
struct HashNode* hn = h->table[col];
while(hn) {
if(hn->key.ref.ptr.str == sym) {
if(PTR(hn->key).str == sym) {
*out = hn->val;
return 1;
}
@ -103,26 +101,32 @@ int naHash_sym(struct naHash* hash, struct naStr* sym, naRef* out)
static struct HashNode* find(struct naHash* hash, naRef key)
{
struct HashRec* h = hash->rec;
if(h) {
struct HashNode* hn = h->table[hashcolumn(h, key)];
while(hn) {
struct HashNode* hn;
if(!h) return 0;
for(hn = h->table[hashcolumn(h, key)]; hn; hn = hn->next)
if(EQUAL(key, hn->key))
return hn;
hn = hn->next;
}
}
return 0;
}
// Make a temporary string on the stack
static void tmpStr(naRef* out, struct naStr* str, char* key)
static void tmpStr(naRef* out, struct naStr* str, const char* key)
{
str->len = 0;
str->type = T_STR;
str->data = (unsigned char*)key;
str->hashcode = 0;
while(key[str->len]) str->len++;
*out = naNil();
out->ref.ptr.str = str;
SETPTR(*out, str);
}
int naMember_cget(naRef obj, const char* field, naRef* out)
{
naRef key;
struct naStr str;
tmpStr(&key, &str, field);
return naMember_get(obj, key, out);
}
naRef naHash_cget(naRef hash, char* key)
@ -146,7 +150,7 @@ void naHash_cset(naRef hash, char* key, naRef val)
int naHash_get(naRef hash, naRef key, naRef* out)
{
if(IS_HASH(hash)) {
struct HashNode* n = find(hash.ref.ptr.hash, key);
struct HashNode* n = find(PTR(hash).hash, key);
if(n) { *out = n->val; return 1; }
}
return 0;
@ -156,7 +160,7 @@ int naHash_get(naRef hash, naRef key, naRef* out)
int naHash_tryset(naRef hash, naRef key, naRef val)
{
if(IS_HASH(hash)) {
struct HashNode* n = find(hash.ref.ptr.hash, key);
struct HashNode* n = find(PTR(hash).hash, key);
if(n) n->val = val;
return n != 0;
}
@ -173,7 +177,7 @@ void naHash_newsym(struct naHash* hash, naRef* sym, naRef* val)
struct HashRec* h = hash->rec;
while(!h || h->size >= 1<<h->lgalloced)
h = resize(hash);
col = (HASH_MAGIC * sym->ref.ptr.str->hashcode) >> (32 - h->lgalloced);
col = (HASH_MAGIC * PTR(*sym).str->hashcode) >> (32 - h->lgalloced);
INSERT(h, *sym, *val, col);
}
@ -196,10 +200,10 @@ void naHash_set(naRef hash, naRef key, naRef val)
struct HashRec* h;
struct HashNode* n;
if(!IS_HASH(hash)) return;
if((n = find(hash.ref.ptr.hash, key))) { n->val = val; return; }
h = hash.ref.ptr.hash->rec;
if((n = find(PTR(hash).hash, key))) { n->val = val; return; }
h = PTR(hash).hash->rec;
while(!h || h->size >= 1<<h->lgalloced)
h = resize(hash.ref.ptr.hash);
h = resize(PTR(hash).hash);
col = hashcolumn(h, key);
INSERT(h, key, val, hashcolumn(h, key));
chkcycle(h->table[col], h->size - h->dels);
@ -207,7 +211,7 @@ void naHash_set(naRef hash, naRef key, naRef val)
void naHash_delete(naRef hash, naRef key)
{
struct HashRec* h = hash.ref.ptr.hash->rec;
struct HashRec* h = PTR(hash).hash->rec;
int col;
struct HashNode *last=0, *hn;
if(!IS_HASH(hash) || !h) return;
@ -228,7 +232,7 @@ void naHash_delete(naRef hash, naRef key)
void naHash_keys(naRef dst, naRef hash)
{
int i;
struct HashRec* h = hash.ref.ptr.hash->rec;
struct HashRec* h = PTR(hash).hash->rec;
if(!IS_HASH(hash) || !h) return;
for(i=0; i<(1<<h->lgalloced); i++) {
struct HashNode* hn = h->table[i];
@ -241,7 +245,7 @@ void naHash_keys(naRef dst, naRef hash)
int naHash_size(naRef hash)
{
struct HashRec* h = hash.ref.ptr.hash->rec;
struct HashRec* h = PTR(hash).hash->rec;
if(!IS_HASH(hash) || !h) return 0;
return h->size - h->dels;
}

View File

@ -11,7 +11,7 @@ naGhostType naIOGhostType = { ghostDestroy };
static struct naIOGhost* ioghost(naRef r)
{
if(naGhost_type(r) == &naIOGhostType)
if(naGhost_type(r) == &naIOGhostType && IOGHOST(r)->handle)
return naGhost_ptr(r);
return 0;
}
@ -32,9 +32,9 @@ static naRef f_read(naContext c, naRef me, int argc, naRef* args)
naRef len = argc > 2 ? naNumValue(args[2]) : naNil();
if(!g || !MUTABLE(str) || !IS_NUM(len))
naRuntimeError(c, "bad argument to read()");
if(str.ref.ptr.str->len < (int)len.num)
if(PTR(str).str->len < (int)len.num)
naRuntimeError(c, "string not big enough for read");
return naNum(g->type->read(c, g->handle, (char*)str.ref.ptr.str->data,
return naNum(g->type->read(c, g->handle, (char*)PTR(str).str->data,
(int)len.num));
}
@ -44,8 +44,8 @@ static naRef f_write(naContext c, naRef me, int argc, naRef* args)
naRef str = argc > 1 ? args[1] : naNil();
if(!g || !IS_STR(str))
naRuntimeError(c, "bad argument to write()");
return naNum(g->type->write(c, g->handle, (char*)str.ref.ptr.str->data,
str.ref.ptr.str->len));
return naNum(g->type->write(c, g->handle, (char*)PTR(str).str->data,
PTR(str).str->len));
}
static naRef f_seek(naContext c, naRef me, int argc, naRef* args)
@ -113,6 +113,7 @@ static int iotell(naContext c, void* f)
static void iodestroy(void* f)
{
if(f != stdin && f != stdout && f != stderr)
ioclose(0, f);
}
@ -133,8 +134,8 @@ static naRef f_open(naContext c, naRef me, int argc, naRef* args)
naRef file = argc > 0 ? naStringValue(c, args[0]) : naNil();
naRef mode = argc > 1 ? naStringValue(c, args[1]) : naNil();
if(!IS_STR(file)) naRuntimeError(c, "bad argument to open()");
f = fopen((char*)file.ref.ptr.str->data,
IS_STR(mode) ? (const char*)mode.ref.ptr.str->data : "r");
f = fopen((char*)PTR(file).str->data,
IS_STR(mode) ? (const char*)PTR(mode).str->data : "rb");
if(!f) naRuntimeError(c, strerror(errno));
return naIOGhost(c, f);
}
@ -169,7 +170,8 @@ static naRef f_readln(naContext ctx, naRef me, int argc, naRef* args)
if(c == '\r') {
char c2 = getcguard(ctx, g->handle, buf);
if(c2 != EOF && c2 != '\n')
ungetc(c2, g->handle);
if(EOF == ungetc(c2, g->handle))
break;
break;
}
buf[i++] = c;
@ -186,7 +188,7 @@ static naRef f_stat(naContext ctx, naRef me, int argc, naRef* args)
struct stat s;
naRef result, path = argc > 0 ? naStringValue(ctx, args[0]) : naNil();
if(!IS_STR(path)) naRuntimeError(ctx, "bad argument to stat()");
if(stat((char*)path.ref.ptr.str->data, &s) < 0) {
if(stat((char*)PTR(path).str->data, &s) < 0) {
if(errno == ENOENT) return naNil();
naRuntimeError(ctx, strerror(errno));
}
@ -199,7 +201,7 @@ static naRef f_stat(naContext ctx, naRef me, int argc, naRef* args)
return result;
}
static struct func { char* name; naCFunction func; } funcs[] = {
static naCFuncItem funcs[] = {
{ "close", f_close },
{ "read", f_read },
{ "write", f_write },
@ -208,26 +210,17 @@ static struct func { char* name; naCFunction func; } funcs[] = {
{ "open", f_open },
{ "readln", f_readln },
{ "stat", f_stat },
{ 0 }
};
static void setsym(naContext c, naRef hash, char* sym, naRef val)
naRef naInit_io(naContext c)
{
naRef name = naStr_fromdata(naNewString(c), sym, strlen(sym));
naHash_set(hash, naInternSymbol(name), val);
}
naRef naIOLib(naContext c)
{
naRef ns = naNewHash(c);
int i, n = sizeof(funcs)/sizeof(struct func);
for(i=0; i<n; i++)
setsym(c, ns, funcs[i].name,
naNewFunc(c, naNewCCode(c, funcs[i].func)));
setsym(c, ns, "SEEK_SET", naNum(SEEK_SET));
setsym(c, ns, "SEEK_CUR", naNum(SEEK_CUR));
setsym(c, ns, "SEEK_END", naNum(SEEK_END));
setsym(c, ns, "stdin", naIOGhost(c, stdin));
setsym(c, ns, "stdout", naIOGhost(c, stdout));
setsym(c, ns, "stderr", naIOGhost(c, stderr));
naRef ns = naGenLib(c, funcs);
naAddSym(c, ns, "SEEK_SET", naNum(SEEK_SET));
naAddSym(c, ns, "SEEK_CUR", naNum(SEEK_CUR));
naAddSym(c, ns, "SEEK_END", naNum(SEEK_END));
naAddSym(c, ns, "stdin", naIOGhost(c, stdin));
naAddSym(c, ns, "stdout", naIOGhost(c, stdout));
naAddSym(c, ns, "stderr", naIOGhost(c, stderr));
return ns;
}

View File

@ -109,7 +109,20 @@ static int lineEnd(struct Parser* p, int line)
static void newToken(struct Parser* p, int pos, int type,
char* str, int slen, double num)
{
struct Token* tok;
struct Token *tok, *last = p->tree.lastChild;
/* Adjacent string literals get concatenated */
if(type == TOK_LITERAL && str) {
if(last && last->type == TOK_LITERAL) {
int i, len1 = last->strlen;
char* str2 = naParseAlloc(p, len1 + slen);
for(i=0; i<len1; i++) str2[i] = last->str[i];
for(i=0; i<slen; i++) str2[i+len1] = str[i];
last->str = str2;
last->strlen += slen;
return;
}
}
tok = naParseAlloc(p, sizeof(struct Token));
tok->type = type;
@ -119,17 +132,18 @@ static void newToken(struct Parser* p, int pos, int type,
tok->num = num;
tok->parent = &p->tree;
tok->next = 0;
tok->prev = p->tree.lastChild;
tok->prev = last;
tok->children = 0;
tok->lastChild = 0;
// Context sensitivity hack: a "-" following a binary operator of
// higher precedence (MUL and DIV, basically) must be a unary
// negation. Needed to get precedence right in the parser for
// expressiong like "a * -2"
if(type == TOK_MINUS && tok->prev)
if(tok->prev->type == TOK_MUL || tok->prev->type == TOK_DIV)
// equal or higher precedence must be a unary negation. Needed to
// get precedence right in the parser for expressiong like "a * -2"
if(type == TOK_MINUS && tok->prev) {
int pt = tok->prev->type;
if(pt==TOK_PLUS||pt==TOK_MINUS||pt==TOK_CAT||pt==TOK_MUL||pt==TOK_DIV)
tok->type = type = TOK_NEG;
}
if(!p->tree.children) p->tree.children = tok;
if(p->tree.lastChild) p->tree.lastChild->next = tok;
@ -179,6 +193,7 @@ static void dqEscape(char* buf, int len, int index, struct Parser* p,
case 'n': *cOut = '\n'; break;
case 't': *cOut = '\t'; break;
case '\\': *cOut = '\\'; break;
case '`': *cOut = '`'; break;
case 'x':
if(len < 4) error(p, "unterminated string", index);
*cOut = (char)((hexc(buf[2], p, index)<<4) | hexc(buf[3], p, index));
@ -191,11 +206,12 @@ static void dqEscape(char* buf, int len, int index, struct Parser* p,
}
}
// 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);
int n, c;
c = naLexUtf8C(s, len, &n);
if(c < 0 || n != len) error(p, "invalid utf8 character constant", index);
newToken(p, index, TOK_LITERAL, 0, 0, c);
}
// Read in a string literal
@ -317,6 +333,7 @@ static int tryLexemes(struct Parser* p, int index, int* lexemeOut)
return best;
}
#define ISNUM(c) ((c) >= '0' && (c) <= '9')
void naLex(struct Parser* p)
{
int i = 0;
@ -338,7 +355,8 @@ void naLex(struct Parser* p)
i = lexStringLiteral(p, i, c);
break;
default:
if(c >= '0' && c <= '9') i = lexNumLiteral(p, i);
if(ISNUM(c) || (c == '.' && (i+1)<p->len && ISNUM(p->buf[i+1])))
i = lexNumLiteral(p, i);
else handled = 0;
}

View File

@ -5,6 +5,7 @@
#include <string.h>
#ifdef _MSC_VER // sigh...
#define snprintf _snprintf
#define vsnprintf _vsnprintf
#endif
@ -14,9 +15,14 @@
#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)
// Generic argument error, assumes that the symbol "c" is a naContext,
// and that the __func__ string is of the form "f_NASALSYMBOL".
#define ARGERR() \
naRuntimeError(c, "bad/missing argument to %s()", (__func__ + 2))
static naRef f_size(naContext c, naRef me, int argc, naRef* args)
{
if(argc == 0) return naNil();
if(argc == 0) ARGERR();
if(naIsString(args[0])) return naNum(naStr_len(args[0]));
if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
@ -24,41 +30,37 @@ static naRef size(naContext c, naRef me, int argc, naRef* args)
return naNil();
}
static naRef keys(naContext c, naRef me, int argc, naRef* args)
static naRef f_keys(naContext c, naRef me, int argc, naRef* args)
{
naRef v, h = args[0];
if(!naIsHash(h)) return naNil();
naRef v, h = argc > 0 ? args[0] : naNil();
if(!naIsHash(h)) ARGERR();
v = naNewVector(c);
naHash_keys(v, h);
return v;
}
static naRef append(naContext c, naRef me, int argc, naRef* args)
static naRef f_append(naContext c, naRef me, int argc, naRef* args)
{
int i;
if(argc < 2) return naNil();
if(!naIsVector(args[0])) return naNil();
if(argc < 2 || !naIsVector(args[0])) ARGERR();
for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
return args[0];
}
static naRef pop(naContext c, naRef me, int argc, naRef* args)
static naRef f_pop(naContext c, naRef me, int argc, naRef* args)
{
if(argc < 1 || !naIsVector(args[0])) return naNil();
if(argc < 1 || !naIsVector(args[0])) ARGERR();
return naVec_removelast(args[0]);
}
static naRef setsize(naContext c, naRef me, int argc, naRef* args)
static naRef f_setsize(naContext c, naRef me, int argc, naRef* args)
{
int sz;
if(argc < 2) return naNil();
sz = (int)naNumValue(args[1]).num;
if(!naIsVector(args[0])) return naNil();
naVec_setsize(args[0], sz);
if(argc < 2 || !naIsVector(args[0])) ARGERR();
naVec_setsize(args[0], (int)naNumValue(args[1]).num);
return args[0];
}
static naRef subvec(naContext c, naRef me, int argc, naRef* args)
static naRef f_subvec(naContext c, naRef me, int argc, naRef* args)
{
int i;
naRef nlen, result, v = args[0];
@ -68,7 +70,7 @@ static naRef subvec(naContext c, naRef me, int argc, naRef* args)
if(!naIsNil(nlen))
len = (int)nlen.num;
if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
return naNil();
ARGERR();
if(naIsNil(nlen) || len > naVec_size(v) - start)
len = naVec_size(v) - start;
result = naNewVector(c);
@ -78,13 +80,14 @@ static naRef subvec(naContext c, naRef me, int argc, naRef* args)
return result;
}
static naRef delete(naContext c, naRef me, int argc, naRef* args)
static naRef f_delete(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 1 && naIsHash(args[0])) naHash_delete(args[0], args[1]);
return naNil();
if(argc < 2 || !naIsHash(args[0])) ARGERR();
naHash_delete(args[0], args[1]);
return args[0];
}
static naRef intf(naContext c, naRef me, int argc, naRef* args)
static naRef f_int(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0) {
naRef n = naNumValue(args[0]);
@ -92,15 +95,16 @@ static naRef intf(naContext c, naRef me, int argc, naRef* args)
if(n.num < 0) n.num = -floor(-n.num);
else n.num = floor(n.num);
return n;
} else return naNil();
} else ARGERR();
return naNil();
}
static naRef num(naContext c, naRef me, int argc, naRef* args)
static naRef f_num(naContext c, naRef me, int argc, naRef* args)
{
return argc > 0 ? naNumValue(args[0]) : naNil();
}
static naRef streq(naContext c, naRef me, int argc, naRef* args)
static naRef f_streq(naContext c, naRef me, int argc, naRef* args)
{
return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
}
@ -110,7 +114,7 @@ static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
char *a, *b;
int i, alen, blen;
if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
naRuntimeError(c, "bad argument to cmp");
ARGERR();
a = naStr_data(args[0]);
alen = naStr_len(args[0]);
b = naStr_data(args[1]);
@ -122,45 +126,38 @@ static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
}
static naRef substr(naContext c, naRef me, int argc, naRef* args)
static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
{
naRef src = argc > 1 ? args[0] : 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();
if(naIsNil(startR)) return naNil();
if(!naIsString(src) || naIsNil(startR)) ARGERR();
start = (int)startR.num;
if(naIsNil(lenR)) {
len = naStr_len(src) - start;
if(len < 0) return naNil();
} else {
lenR = naNumValue(lenR);
if(naIsNil(lenR)) return naNil();
len = (int)lenR.num;
}
len = naIsNil(lenR) ? (naStr_len(src) - start) : (int)lenR.num;
if(len < 0) ARGERR();
return naStr_substr(naNewString(c), src, start, len);
}
static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
{
char chr[1];
naRef cr = argc ? naNumValue(args[0]) : naNil();
if(IS_NIL(cr)) naRuntimeError(c, "chr argument not string");
naRef cr = argc > 0 ? naNumValue(args[0]) : naNil();
if(IS_NIL(cr)) ARGERR();
chr[0] = (char)cr.num;
return NEWSTR(c, chr, 1);
}
static naRef contains(naContext c, naRef me, int argc, naRef* args)
static naRef f_contains(naContext c, naRef me, int argc, naRef* args)
{
naRef hash = argc > 0 ? args[0] : naNil();
naRef key = argc > 1 ? args[1] : naNil();
if(naIsNil(hash) || naIsNil(key)) return naNil();
if(naIsNil(hash) || naIsNil(key)) ARGERR();
if(!naIsHash(hash)) return naNil();
return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
}
static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
static naRef f_typeof(naContext c, naRef me, int argc, naRef* args)
{
naRef r = argc > 0 ? args[0] : naNil();
char* t = "unknown";
@ -171,8 +168,20 @@ static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
else if(naIsHash(r)) t = "hash";
else if(naIsFunc(r)) t = "func";
else if(naIsGhost(r)) t = "ghost";
r = NEWCSTR(c, t);
return r;
return NEWCSTR(c, t);
}
static naRef f_ghosttype(naContext c, naRef me, int argc, naRef* args)
{
naRef g = argc > 0 ? args[0] : naNil();
if(!naIsGhost(g)) return naNil();
if(naGhost_type(g)->name) {
return NEWCSTR(c, (char*)naGhost_type(g)->name);
} else {
char buf[32];
sprintf(buf, "%p", naGhost_type(g));
return NEWCSTR(c, buf);
}
}
static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
@ -184,10 +193,20 @@ static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
if(!naIsString(script) || !naIsString(fname)) return naNil();
code = naParseCode(c, fname, 1,
naStr_data(script), naStr_len(script), &errLine);
if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
if(naIsNil(code)) {
char buf[256];
snprintf(buf, sizeof(buf), "Parse error: %s at line %d",
naGetError(c), errLine);
c->dieArg = NEWCSTR(c, buf);
naRuntimeError(c, "__die__");
}
return naBindToContext(c, code);
}
// FIXME: need a place to save the current IP when we get an error so
// that it can be reset if we get a die()/naRethrowError() situation
// later. Right now, the IP on the stack trace is the line of the
// die() call, when it should be this one...
static naRef f_call(naContext c, naRef me, int argc, naRef* args)
{
naContext subc;
@ -199,41 +218,46 @@ static naRef f_call(naContext c, naRef me, int argc, naRef* args)
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;
vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
ARGERR();
// Note that we don't free the subcontext, in case the user
// re-throws the same error. That happens at the next OP_RETURN
// or naSubContext().
subc = naSubContext(c);
vr = IS_NIL(callargs) ? 0 : PTR(callargs).vec->rec;
result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
callme, callns);
c->callChild = 0;
if(argc > 2 && IS_VEC(args[argc-1])) {
naRef v = args[argc-1];
if(!IS_NIL(subc->dieArg)) naVec_append(v, subc->dieArg);
else if(naGetError(subc))
naVec_append(v, NEWCSTR(subc, naGetError(subc)));
if(naVec_size(v)) {
int i, sd = naStackDepth(subc);
if(naGetError(subc)) {
if(argc <= 2 || !IS_VEC(args[argc-1])) {
naRethrowError(subc);
} else {
int i, sd;
naRef errv = args[argc-1];
if(!IS_NIL(subc->dieArg)) naVec_append(errv, subc->dieArg);
else naVec_append(errv, NEWCSTR(subc, naGetError(subc)));
sd = naStackDepth(subc);
for(i=0; i<sd; i++) {
naVec_append(v, naGetSourceFile(subc, i));
naVec_append(v, naNum(naGetLine(subc, i)));
naVec_append(errv, naGetSourceFile(subc, i));
naVec_append(errv, naNum(naGetLine(subc, i)));
}
}
}
naFreeContext(subc);
return result;
}
static naRef f_die(naContext c, naRef me, int argc, naRef* args)
{
c->dieArg = argc > 0 ? args[0] : naNil();
naRef darg = argc > 0 ? args[0] : naNil();
if(!naIsNil(darg) && c->callChild && IDENTICAL(c->callChild->dieArg, darg))
naRethrowError(c->callChild);
c->dieArg = darg;
naRuntimeError(c, "__die__");
return naNil(); // never executes
}
// Wrapper around vsnprintf, iteratively increasing the buffer size
// until it fits. Returned buffer should be freed by the caller.
char* dosprintf(char* f, ...)
static char* dosprintf(char* f, ...)
{
char* buf;
va_list va;
@ -259,7 +283,7 @@ char* dosprintf(char* f, ...)
// all of ANSI C's syntax except for the "length modifier" feature.
// Note: this does not validate the format character returned in
// "type". That is the caller's job.
static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type)
static char* nextFormat(naContext c, char* f, char** out, int* len, char* type)
{
// Skip to the start of the format string
while(*f && *f != '%') f++;
@ -274,44 +298,44 @@ static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type
for(p1 = *out + 1; p1 < f; p1++)
for(p2 = p1+1; p2 < f; p2++)
if(*p1 == *p2)
naRuntimeError(ctx, "duplicate flag in format string"); }
naRuntimeError(c, "duplicate flag in format string"); }
while(*f && *f >= '0' && *f <= '9') f++;
if(*f && *f == '.') f++;
while(*f && *f >= '0' && *f <= '9') f++;
if(!*f) naRuntimeError(ctx, "invalid format string");
if(!*f) naRuntimeError(c, "invalid format string");
*type = *f++;
*len = f - *out;
return f;
}
#define ERR(m) naRuntimeError(ctx, m)
#define APPEND(r) result = naStr_concat(naNewString(ctx), result, r)
static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
#define ERR(m) naRuntimeError(c, m)
#define APPEND(r) result = naStr_concat(naNewString(c), result, r)
static naRef f_sprintf(naContext c, naRef me, int argc, naRef* args)
{
char t, nultmp, *fstr, *next, *fout=0, *s;
int flen, argn=1;
naRef format, arg, result = naNewString(ctx);
naRef format, arg, result = naNewString(c);
if(argc < 1) ERR("not enough arguments to sprintf");
format = naStringValue(ctx, argc > 0 ? args[0] : naNil());
if(naIsNil(format)) ERR("bad format string in sprintf");
if(argc < 1) ERR("not enough arguments to sprintf()");
format = naStringValue(c, argc > 0 ? args[0] : naNil());
if(naIsNil(format)) ERR("bad format string in sprintf()");
s = naStr_data(format);
while((next = nextFormat(ctx, s, &fstr, &flen, &t))) {
APPEND(NEWSTR(ctx, s, fstr-s)); // stuff before the format string
while((next = nextFormat(c, s, &fstr, &flen, &t))) {
APPEND(NEWSTR(c, s, fstr-s)); // stuff before the format string
if(flen == 2 && fstr[1] == '%') {
APPEND(NEWSTR(ctx, "%", 1));
APPEND(NEWSTR(c, "%", 1));
s = next;
continue;
}
if(argn >= argc) ERR("not enough arguments to sprintf");
if(argn >= argc) ERR("not enough arguments to sprintf()");
arg = args[argn++];
nultmp = fstr[flen]; // sneaky nul termination...
fstr[flen] = 0;
if(t == 's') {
arg = naStringValue(ctx, arg);
arg = naStringValue(c, arg);
if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
else fout = dosprintf(fstr, naStr_data(arg));
} else {
@ -328,43 +352,42 @@ static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
ERR("invalid sprintf format type");
}
fstr[flen] = nultmp;
APPEND(NEWSTR(ctx, fout, strlen(fout)));
APPEND(NEWSTR(c, fout, strlen(fout)));
naFree(fout);
s = next;
}
APPEND(NEWSTR(ctx, s, strlen(s)));
APPEND(NEWSTR(c, s, strlen(s)));
return result;
}
// FIXME: handle ctx->callParent frames too!
static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
// FIXME: needs to honor subcontext list
static naRef f_caller(naContext c, naRef me, int argc, naRef* args)
{
int fidx;
struct Frame* frame;
naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
if(IS_NIL(fr)) ARGERR();
fidx = (int)fr.num;
if(fidx > ctx->fTop - 1) return naNil();
frame = &ctx->fStack[ctx->fTop - 1 - fidx];
result = naNewVector(ctx);
if(fidx > c->fTop - 1) return naNil();
frame = &c->fStack[c->fTop - 1 - fidx];
result = naNewVector(c);
naVec_append(result, frame->locals);
naVec_append(result, frame->func);
naVec_append(result, frame->func.ref.ptr.func->code.ref.ptr.code->srcFile);
naVec_append(result, naNum(naGetLine(ctx, fidx)));
naVec_append(result, PTR(PTR(frame->func).func->code).code->srcFile);
naVec_append(result, naNum(naGetLine(c, fidx)));
return result;
}
static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
static naRef f_closure(naContext c, naRef me, int argc, naRef* args)
{
int i;
struct naFunc* f;
naRef func = argc > 0 ? args[0] : naNil();
naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
if(!IS_FUNC(func) || IS_NIL(idx))
naRuntimeError(ctx, "bad arguments to closure()");
if(!IS_FUNC(func) || IS_NIL(idx)) ARGERR();
i = (int)idx.num;
f = func.ref.ptr.func;
while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
f = PTR(func).func;
while(i > 0 && f) { i--; f = PTR(f->next).func; }
if(!f) return naNil();
return f->namespace;
}
@ -384,40 +407,38 @@ static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
return -1;
}
static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
static naRef f_find(naContext c, naRef me, int argc, naRef* args)
{
int start = 0;
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
naRuntimeError(ctx, "bad/missing argument to find");
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
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,
return naNum(find(PTR(args[0]).str->data, PTR(args[0]).str->len,
PTR(args[1]).str->data, PTR(args[1]).str->len,
start));
}
static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
static naRef f_split(naContext c, naRef me, int argc, naRef* args)
{
int sl, dl, i;
char *s, *d, *s0;
naRef result;
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
naRuntimeError(ctx, "bad/missing argument to split");
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
d = naStr_data(args[0]); dl = naStr_len(args[0]);
s = naStr_data(args[1]); sl = naStr_len(args[1]);
result = naNewVector(ctx);
result = naNewVector(c);
if(dl == 0) { // special case zero-length delimiter
for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
for(i=0; i<sl; i++) naVec_append(result, NEWSTR(c, s+i, 1));
return result;
}
s0 = s;
for(i=0; i <= sl-dl; i++) {
if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
naVec_append(result, NEWSTR(c, s0, s+i-s0));
s0 = s + i + dl;
i += dl - 1;
}
}
if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
if(s0 - s <= sl) naVec_append(result, NEWSTR(c, s0, s+sl-s0));
return result;
}
@ -425,12 +446,12 @@ static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
// function, which is usually not threadsafe and often of limited
// precision. The 5x loop guarantees that we get a full double worth
// of precision even for 15 bit (Win32...) rand() implementations.
static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
static naRef f_rand(naContext c, naRef me, int argc, naRef* args)
{
int i;
double r = 0;
if(argc) {
if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
if(!IS_NUM(args[0])) naRuntimeError(c, "rand() seed not number");
srand((unsigned int)args[0].num);
return naNil();
}
@ -438,36 +459,36 @@ static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
return naNum(r);
}
static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
static naRef f_bind(naContext c, naRef me, int argc, naRef* args)
{
naRef func = argc > 0 ? args[0] : naNil();
naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
naRef hash = argc > 1 ? args[1] : naNewHash(c);
naRef next = argc > 2 ? args[2] : naNil();
if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
naRuntimeError(ctx, "bad argument to bind");
func = naNewFunc(ctx, func.ref.ptr.func->code);
func.ref.ptr.func->namespace = hash;
func.ref.ptr.func->next = next;
ARGERR();
func = naNewFunc(c, PTR(func).func->code);
PTR(func).func->namespace = hash;
PTR(func).func->next = next;
return func;
}
struct func { char* name; naCFunction func; };
static struct func funcs[] = {
{ "size", size },
{ "keys", keys },
{ "append", append },
{ "pop", pop },
{ "setsize", setsize },
{ "subvec", subvec },
{ "delete", delete },
{ "int", intf },
{ "num", num },
{ "streq", streq },
static naCFuncItem funcs[] = {
{ "size", f_size },
{ "keys", f_keys },
{ "append", f_append },
{ "pop", f_pop },
{ "setsize", f_setsize },
{ "subvec", f_subvec },
{ "delete", f_delete },
{ "int", f_int },
{ "num", f_num },
{ "streq", f_streq },
{ "cmp", f_cmp },
{ "substr", substr },
{ "substr", f_substr },
{ "chr", f_chr },
{ "contains", contains },
{ "typeof", typeOf },
{ "contains", f_contains },
{ "typeof", f_typeof },
{ "ghosttype", f_ghosttype },
{ "compile", f_compile },
{ "call", f_call },
{ "die", f_die },
@ -478,17 +499,10 @@ static struct func funcs[] = {
{ "split", f_split },
{ "rand", f_rand },
{ "bind", f_bind },
{ 0 }
};
naRef naStdLib(naContext c)
naRef naInit_std(naContext c)
{
naRef namespace = naNewHash(c);
int i, n = sizeof(funcs)/sizeof(struct func);
for(i=0; i<n; i++) {
naRef code = naNewCCode(c, funcs[i].func);
naRef name = NEWSTR(c, funcs[i].name, strlen(funcs[i].name));
name = naInternSymbol(name);
naHash_set(namespace, name, naNewFunc(c, code));
}
return namespace;
return naGenLib(c, funcs);
}

View File

@ -59,34 +59,20 @@ static naRef f_atan2(naContext c, naRef me, int argc, naRef* args)
return a;
}
static struct func { char* name; naCFunction func; } funcs[] = {
static naCFuncItem funcs[] = {
{ "sin", f_sin },
{ "cos", f_cos },
{ "exp", f_exp },
{ "ln", f_ln },
{ "sqrt", f_sqrt },
{ "atan2", f_atan2 },
{ 0 }
};
naRef naMathLib(naContext c)
naRef naInit_math(naContext c)
{
naRef name, namespace = naNewHash(c);
int i, n = sizeof(funcs)/sizeof(struct func);
for(i=0; i<n; i++) {
naRef code = naNewCCode(c, funcs[i].func);
naRef name = naStr_fromdata(naNewString(c),
funcs[i].name, strlen(funcs[i].name));
naHash_set(namespace, name, naNewFunc(c, code));
}
// 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(3.14159265358979323846));
name = naStr_fromdata(naNewString(c), "e", 1);
name = naInternSymbol(name);
naHash_set(namespace, name, naNum(2.7182818284590452354));
return namespace;
naRef ns = naGenLib(c, funcs);
naAddSym(c, ns, "pi", naNum(3.14159265358979323846));
naAddSym(c, ns, "e", naNum(2.7182818284590452354));
return ns;
}

View File

@ -5,9 +5,17 @@
#include "nasal.h"
#include "code.h"
static void* chkptr(void* p)
{
naRef foo;
SETPTR(foo, p);
if(PTR(foo).obj != p) *(int*)0=0;
return p;
}
void naFree(void* m) { free(m); }
void* naAlloc(int n) { return malloc(n); }
void* naRealloc(void* b, int n) { return realloc(b, n); }
void* naAlloc(int n) { return chkptr(malloc(n)); }
void* naRealloc(void* b, int n) { return chkptr(realloc(b, n)); }
void naBZero(void* m, int n) { memset(m, 0, n); }
void naTempSave(naContext c, naRef r)
@ -23,14 +31,13 @@ void naTempSave(naContext c, naRef r)
naFree(c->temps);
c->temps = newtemps;
}
c->temps[c->ntemps++] = r.ref.ptr.obj;
c->temps[c->ntemps++] = PTR(r).obj;
}
naRef naObj(int type, struct naObj* o)
{
naRef r;
r.ref.reftag = NASAL_REFTAG;
r.ref.ptr.obj = o;
SETPTR(r, o);
o->type = type;
return r;
}
@ -78,23 +85,23 @@ naRef naNew(struct Context* c, int type)
naRef naNewString(struct Context* c)
{
naRef s = naNew(c, T_STR);
s.ref.ptr.str->len = 0;
s.ref.ptr.str->data = 0;
s.ref.ptr.str->hashcode = 0;
PTR(s).str->len = 0;
PTR(s).str->data = 0;
PTR(s).str->hashcode = 0;
return s;
}
naRef naNewVector(struct Context* c)
{
naRef r = naNew(c, T_VEC);
r.ref.ptr.vec->rec = 0;
PTR(r).vec->rec = 0;
return r;
}
naRef naNewHash(struct Context* c)
{
naRef r = naNew(c, T_HASH);
r.ref.ptr.hash->rec = 0;
PTR(r).hash->rec = 0;
return r;
}
@ -106,59 +113,57 @@ naRef naNewCode(struct Context* c)
naRef naNewCCode(struct Context* c, naCFunction fptr)
{
naRef r = naNew(c, T_CCODE);
r.ref.ptr.ccode->fptr = fptr;
PTR(r).ccode->fptr = fptr;
return r;
}
naRef naNewFunc(struct Context* c, naRef code)
{
naRef func = naNew(c, T_FUNC);
func.ref.ptr.func->code = code;
func.ref.ptr.func->namespace = naNil();
func.ref.ptr.func->next = naNil();
PTR(func).func->code = code;
PTR(func).func->namespace = naNil();
PTR(func).func->next = naNil();
return func;
}
naRef naNewGhost(naContext c, naGhostType* type, void* ptr)
{
naRef ghost = naNew(c, T_GHOST);
ghost.ref.ptr.ghost->gtype = type;
ghost.ref.ptr.ghost->ptr = ptr;
PTR(ghost).ghost->gtype = type;
PTR(ghost).ghost->ptr = ptr;
return ghost;
}
naGhostType* naGhost_type(naRef ghost)
{
if(!IS_GHOST(ghost)) return 0;
return ghost.ref.ptr.ghost->gtype;
return PTR(ghost).ghost->gtype;
}
void* naGhost_ptr(naRef ghost)
{
if(!IS_GHOST(ghost)) return 0;
return ghost.ref.ptr.ghost->ptr;
return PTR(ghost).ghost->ptr;
}
naRef naNil()
{
naRef r;
r.ref.reftag = NASAL_REFTAG;
r.ref.ptr.obj = 0;
SETPTR(r, 0);
return r;
}
naRef naNum(double num)
{
naRef r;
r.ref.reftag = ~NASAL_REFTAG;
r.num = num;
SETNUM(r, num);
return r;
}
int naEqual(naRef a, naRef b)
{
double na=0, nb=0;
if(IS_REF(a) && IS_REF(b) && a.ref.ptr.obj == b.ref.ptr.obj)
if(IS_REF(a) && IS_REF(b) && PTR(a).obj == PTR(b).obj)
return 1; // Object identity (and nil == nil)
if(IS_NIL(a) || IS_NIL(b))
return 0;
@ -182,10 +187,10 @@ int naStrEqual(naRef a, naRef b)
int i;
if(!(IS_STR(a) && IS_STR(b)))
return 0;
if(a.ref.ptr.str->len != b.ref.ptr.str->len)
if(PTR(a).str->len != PTR(b).str->len)
return 0;
for(i=0; i<a.ref.ptr.str->len; i++)
if(a.ref.ptr.str->data[i] != b.ref.ptr.str->data[i])
for(i=0; i<PTR(a).str->len; i++)
if(PTR(a).str->data[i] != PTR(b).str->data[i])
return 0;
return 1;
}
@ -214,3 +219,24 @@ 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); }
void naSetUserData(naContext c, void* p) { c->userData = p; }
void* naGetUserData(naContext c)
{
if(c->userData) return c->userData;
return c->callParent ? naGetUserData(c->callParent) : 0;
}
void naAddSym(naContext c, naRef ns, char *sym, naRef val)
{
naRef name = naStr_fromdata(naNewString(c), sym, strlen(sym));
naHash_set(ns, naInternSymbol(name), val);
}
naRef naGenLib(naContext c, naCFuncItem *fns)
{
naRef ns = naNewHash(c);
for(/**/; fns->name; fns++)
naAddSym(c, ns, fns->name, naNewFunc(c, naNewCCode(c, fns->func)));
return ns;
}

59
simgear/nasal/naref.h Normal file
View File

@ -0,0 +1,59 @@
#ifndef _NAREF_H
#define _NAREF_H
/* Rather than play elaborate and complicated games with
* platform-dependent endianness headers, just detect the platforms we
* support. This list is simpler and smaller, yet still quite
* complete. */
#if (defined(__x86_64) && defined(__linux__)) || defined(__sparcv9)
/* Win64 and Irix should work with this too, but have not been
* tested */
# define NASAL_NAN64
#elif defined(_M_X86) || defined(i386) || defined(__x86_64) || \
defined(__ia64__) || defined(_M_IA64) || defined(__ARMEL__)
# define NASAL_LE
#elif defined(__sparc) || defined(__ppc__) || defined(__mips) || \
defined(__ARMEB__)
# define NASAL_BE
#else
# error Unrecognized CPU architecture
#endif
typedef union {
struct naObj* obj;
struct naStr* str;
struct naVec* vec;
struct naHash* hash;
struct naCode* code;
struct naFunc* func;
struct naCCode* ccode;
struct naGhost* ghost;
} naPtr;
#if defined(NASAL_NAN64)
/* On suppoted 64 bit platforms (those where all memory returned from
* naAlloc() is guaranteed to lie between 0 and 2^48-1) we union the
* double with the pointer, and use fancy tricks (see data.h) to make
* sure all pointers are stored as NaNs. */
typedef union { double num; void* ptr; } naRef;
#elif defined(NASAL_LE) || defined(NASAL_BE)
/* 32 bit layouts (and 64 bit platforms where we haven't tested the
trick above) need endianness-dependent ordering to make sure that
the reftag lies in the top bits of the double */
#ifdef NASAL_LE
typedef struct { naPtr ptr; int reftag; } naRefPart;
#else /* NASAL_BE */
typedef struct { int reftag; naPtr ptr; } naRefPart;
#endif
typedef union {
double num;
naRefPart ref;
} naRef;
#endif
#endif // _NAREF_H

View File

@ -4,72 +4,7 @@
extern "C" {
#endif
#ifndef BYTE_ORDER
# if (BSD >= 199103)
# include <machine/endian.h>
# elif defined(__CYGWIN__) || defined(__MINGW32__)
# include <sys/param.h>
# elif defined(linux)
# include <endian.h>
# else
# ifndef LITTLE_ENDIAN
# define LITTLE_ENDIAN 1234 /* LSB first: i386, vax */
# endif
# ifndef BIG_ENDIAN
# define BIG_ENDIAN 4321 /* MSB first: 68000, ibm, net */
# endif
# if defined(ultrix) || defined(__alpha__) || defined(__alpha) || \
defined(__i386__) || defined(__i486__) || defined(_X86_) || \
defined(sun386)
# define BYTE_ORDER LITTLE_ENDIAN
# else
# define BYTE_ORDER BIG_ENDIAN
# endif
# endif /* BSD */
#endif /* BYTE_ORDER */
#if BYTE_ORDER == BIG_ENDIAN
# include <limits.h>
# if (LONG_MAX == 2147483647)
# define NASAL_BIG_ENDIAN_32_BIT 1
# endif
#endif
// This is a nasal "reference". They are always copied by value, and
// contain either a pointer to a garbage-collectable nasal object
// (string, vector, hash) or a floating point number. Keeping the
// number here is an optimization to prevent the generation of
// zillions of tiny "number" object that have to be collected. Note
// sneaky hack: on little endian systems, placing reftag after ptr and
// putting 1's in the top 13 (except the sign bit) bits makes the
// double value a NaN, and thus unmistakable (no actual number can
// appear as a reference, and vice versa). Swap the structure order
// on 32 bit big-endian systems. On 64 bit sytems of either
// endianness, reftag and the double won't be coincident anyway.
#define NASAL_REFTAG 0x7ff56789 // == 2,146,789,257 decimal
typedef union {
double num;
struct {
#ifdef NASAL_BIG_ENDIAN_32_BIT
int reftag; // Big-endian systems need this here!
#endif
union {
struct naObj* obj;
struct naStr* str;
struct naVec* vec;
struct naHash* hash;
struct naCode* code;
struct naFunc* func;
struct naCCode* ccode;
struct naGhost* ghost;
} ptr;
#ifndef NASAL_BIG_ENDIAN_32_BIT
int reftag; // Little-endian and 64 bit systems need this here!
#endif
} ref;
} naRef;
#include "naref.h"
typedef struct Context* naContext;
@ -80,7 +15,21 @@ typedef naRef (*naCFunction)(naContext ctx, naRef me, int argc, naRef* args);
naContext naNewContext();
void naFreeContext(naContext c);
// Save this object in the context, preventing it (and objects
// Use this when making a call to a new context "underneath" a
// preexisting context on the same stack. It allows stack walking to
// see through the boundary, and eliminates the need to release the
// mod lock (i.e. must be called with the mod lock held!)
naContext naSubContext(naContext super);
// The naContext supports a user data pointer that can be used to
// store data specific to an naCall invocation without exposing it to
// Nasal as a ghost. FIXME: this API is semi-dangerous, there is no
// provision for sharing it, nor for validating the source or type of
// the pointer returned.
void naSetUserData(naContext c, void* p);
void* naGetUserData(naContext c);
// "Save" this object in the context, preventing it (and objects
// referenced by it) from being garbage collected.
void naSave(naContext ctx, naRef obj);
@ -89,49 +38,79 @@ void naSave(naContext ctx, naRef obj);
// 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.
// Parse a buffer in memory into a code object. The srcFile parameter
// is a Nasal string representing the "file" from which the code is
// read. The "first line" is typically 1, but is settable for
// situations where the Nasal code is embedded in another context with
// its own numbering convetions. If an error occurs, returns nil and
// sets the errLine pointer to point to the line at fault. The string
// representation of the error can be retrieved with naGetError() on
// the context.
naRef naParseCode(naContext c, naRef srcFile, int firstLine,
char* buf, int len, int* errLine);
// Binds a bare code object (as returned from naParseCode) with a
// closure object (a hash) to act as the outer scope / namespace.
// FIXME: this API is weak. It should expose the recursive nature of
// closures, and allow for extracting the closure and namespace
// information from function objects.
naRef naBindFunction(naContext ctx, naRef code, naRef closure);
// Similar, but it binds to the current context's closure (i.e. the
// namespace at the top of the current call stack).
naRef naBindToContext(naContext ctx, naRef code);
// 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, int argc, naRef* args, naRef obj, naRef locals);
// Call a code or function object with the specified arguments "on"
// the specified object and using the specified hash for the local
// variables. Passing a null args array skips the parameter variables
// (e.g. "arg") assignments; to get a zero-length arg instead, pass in
// argc==0 and a non-null args vector. The obj or locals parameters
// may be nil. Will attempt to acquire the mod lock, so call
// naModUnlock() first if the lock is already held.
naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
naRef obj, naRef locals);
// As naCall(), but continues execution at the operation after a
// previous die() call or runtime error. Useful to do "yield"
// semantics, leaving the context in a condition where it can be
// restarted from C code. Cannot be used currently to restart a
// failed operation. Will attempt to acquire the mod lock, so call
// naModUnlock() first if the lock is already held.
naRef naContinue(naContext ctx);
// 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
// intended for use in library code that cannot otherwise report an
// error via the return value, and MUST be used carefully. If in
// doubt, return naNil() as your error condition.
void naRuntimeError(naContext ctx, char* msg);
// doubt, return naNil() as your error condition. Works like
// printf().
void naRuntimeError(naContext c, const char* fmt, ...);
// Call a method on an object (NOTE: func is a function binding, *not*
// a code object as returned from naParseCode).
naRef naMethod(naContext ctx, naRef func, naRef object);
// "Re-throws" a runtime error caught from the subcontext. Acts as a
// naRuntimeError() called on the parent context. Does not return.
void naRethrowError(naContext subc);
// Retrieve the specified member from the object, respecting the
// "parents" array as for "object.field". Returns zero for missing
// fields.
int naMember_get(naRef obj, naRef field, naRef* out);
int naMember_cget(naRef obj, const char* field, naRef* out);
// Returns a hash containing functions from the Nasal standard library
// Useful for passing as a namespace to an initial function call
naRef naStdLib(naContext c);
naRef naInit_std(naContext c);
// 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);
naRef naInit_math(naContext c);
naRef naInit_bits(naContext c);
naRef naInit_io(naContext c);
naRef naInit_regex(naContext c);
naRef naInit_unix(naContext c);
naRef naInit_thread(naContext c);
naRef naInit_utf8(naContext c);
naRef naInit_sqlite(naContext c);
naRef naInit_readline(naContext c);
naRef naInit_gtk(naContext ctx);
naRef naInit_cairo(naContext ctx);
// Current line number & error message
// Context stack inspection, frame zero is the "top"
int naStackDepth(naContext ctx);
int naGetLine(naContext ctx, int frame);
naRef naGetSourceFile(naContext ctx, int frame);
@ -192,6 +171,7 @@ void naHash_keys(naRef dst, naRef hash);
// Ghost utilities:
typedef struct naGhostType {
void (*destroy)(void* ghost);
const char* name;
} naGhostType;
naRef naNewGhost(naContext c, naGhostType* t, void* ghost);
naGhostType* naGhost_type(naRef ghost);
@ -200,18 +180,31 @@ int naIsGhost(naRef r);
// Acquires a "modification lock" on a context, allowing the C code to
// modify Nasal data without fear that such data may be "lost" by the
// garbage collector (the C stack is not examined in GC!). This
// disallows garbage collection until the current thread can be
// blocked. The lock should be acquired whenever modifications to
// Nasal objects are made. It need not be acquired when only read
// access is needed. It MUST NOT be acquired by naCFunction's, as
// those are called with the lock already held; acquiring two locks
// for the same thread will cause a deadlock when the GC is invoked.
// It should be UNLOCKED by naCFunction's when they are about to do
// any long term non-nasal processing and/or blocking I/O.
// garbage collector (nasal data the C stack is not examined in GC!).
// This disallows garbage collection until the current thread can be
// blocked. The lock should be acquired whenever nasal objects are
// being modified. It need not be acquired when only read access is
// needed, PRESUMING that the Nasal data being read is findable by the
// collector (via naSave, for example) and that another Nasal thread
// cannot or will not delete the reference to the data. It MUST NOT
// be acquired by naCFunction's, as those are called with the lock
// already held; acquiring two locks for the same thread will cause a
// deadlock when the GC is invoked. It should be UNLOCKED by
// naCFunction's when they are about to do any long term non-nasal
// processing and/or blocking I/O. Note that naModLock() may need to
// block to allow garbage collection to occur, and that garbage
// collection by other threads may be blocked until naModUnlock() is
// called. It must also be UNLOCKED by threads that hold a lock
// already before making a naCall() or naContinue() call -- these
// functions will attempt to acquire the lock again.
void naModLock();
void naModUnlock();
// Library utilities. Generate namespaces and add symbols.
typedef struct { char* name; naCFunction func; } naCFuncItem;
naRef naGenLib(naContext c, naCFuncItem *funcs);
void naAddSym(naContext c, naRef ns, char *sym, naRef val);
#ifdef __cplusplus
} // extern "C"
#endif

View File

@ -1,11 +1,10 @@
#include <setjmp.h>
#include <string.h>
#include "parse.h"
// Static precedence table, from low (loose binding, do first) to high
// (tight binding, do last).
enum { PREC_BINARY, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
#define MAX_PREC_TOKS 6
struct precedence {
int toks[MAX_PREC_TOKS];
@ -32,8 +31,10 @@ struct precedence {
void naParseError(struct Parser* p, char* msg, int line)
{
// Some errors (e.g. code generation of a null pointer) lack a
// line number, so we throw -1 and set the line earlier.
if(line > 0) p->errLine = line;
p->err = msg;
p->errLine = line;
longjmp(p->jumpHandle, 1);
}
@ -205,11 +206,83 @@ static struct Token* emptyToken(struct Parser* p)
return t;
}
// Synthesize a curly brace token to wrap token t foward to the end of
// "statement". FIXME: unify this with the addNewChild(), which does
// very similar stuff.
static void embrace(struct Parser* p, struct Token* t)
{
struct Token *b, *end = t;
if(!t) return;
while(end->next) {
if(end->next->type == TOK_SEMI) {
// Slurp up the semi, iff it is followed by an else/elsif,
// otherwise leave it in place.
if(end->next->next) {
if(end->next->next->type == TOK_ELSE) end = end->next;
if(end->next->next->type == TOK_ELSIF) end = end->next;
}
break;
}
if(end->next->type == TOK_COMMA) break;
if(end->next->type == TOK_ELSE) break;
if(end->next->type == TOK_ELSIF) break;
end = end->next;
}
b = emptyToken(p);
b->type = TOK_LCURL;
b->line = t->line;
b->parent = t->parent;
b->prev = t->prev;
b->next = end->next;
b->children = t;
b->lastChild = end;
if(t->prev) t->prev->next = b;
else b->parent->children = b;
if(end->next) end->next->prev = b;
else b->parent->lastChild = b;
t->prev = 0;
end->next = 0;
for(; t; t = t->next)
t->parent = b;
}
#define NEXT(t) (t ? t->next : 0)
#define TYPE(t) (t ? t->type : -1)
static void fixBracelessBlocks(struct Parser* p, struct Token* t)
{
// Find the end, and march *backward*
while(t && t->next) t = t->next;
for(/**/; t; t=t->prev) {
switch(t->type) {
case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
case TOK_IF: case TOK_ELSIF:
if(TYPE(NEXT(t)) == TOK_LPAR && TYPE(NEXT(NEXT(t))) != TOK_LCURL)
embrace(p, t->next->next);
break;
case TOK_ELSE:
if(TYPE(NEXT(t)) != TOK_LCURL)
embrace(p, t->next);
break;
case TOK_FUNC:
if(TYPE(NEXT(t)) == TOK_LPAR) {
if(TYPE(NEXT(NEXT(t))) != TOK_LCURL)
embrace(p, NEXT(NEXT(t)));
} else if(TYPE(NEXT(t)) != TOK_LCURL)
embrace(p, t->next);
break;
default:
break;
}
}
}
// Fixes up parenting for obvious parsing situations, like code blocks
// being the child of a func keyword, etc...
static void fixBlockStructure(struct Parser* p, struct Token* start)
{
struct Token *t, *c;
fixBracelessBlocks(p, start);
t = start;
while(t) {
switch(t->type) {
@ -287,8 +360,8 @@ static void fixBlockStructure(struct Parser* p, struct Token* start)
addSemi = 1;
break;
}
if(t->next && t->next->type == TOK_SEMI)
addSemi = 0; // don't bother if it's already there!
if(!t->next || t->next->type == TOK_SEMI || t->next->type == TOK_COMMA)
addSemi = 0; // don't bother, no need
if(addSemi) {
struct Token* semi = emptyToken(p);
semi->type = TOK_SEMI;
@ -297,6 +370,7 @@ static void fixBlockStructure(struct Parser* p, struct Token* start)
semi->prev = t;
semi->parent = t->parent;
if(semi->next) semi->next->prev = semi;
else semi->parent->lastChild = semi;
t->next = semi;
t = semi; // don't bother checking the new one
}
@ -455,6 +529,8 @@ static struct Token* parsePrecedence(struct Parser* p,
if(!top)
return parsePrecedence(p, start, end, level+1);
top->rule = rule;
if(left) {
left->next = right;
left->prev = 0;
@ -508,7 +584,7 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
// Catch parser errors here.
*errLine = 0;
if(setjmp(p.jumpHandle)) {
c->error = p.err;
strncpy(c->error, p.err, sizeof(c->error));
*errLine = p.errLine;
return naNil();
}
@ -540,5 +616,3 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
return codeObj;
}

View File

@ -19,11 +19,15 @@ enum {
TOK_FORINDEX
};
// Precedence rules
enum { PREC_BINARY=1, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
struct Token {
int type;
int line;
char* str;
int strlen;
int rule;
double num;
struct Token* parent;
struct Token* next;
@ -94,6 +98,7 @@ void naParseInit(struct Parser* p);
void* naParseAlloc(struct Parser* p, int bytes);
void naParseDestroy(struct Parser* p);
void naLex(struct Parser* p);
int naLexUtf8C(char* s, int len, int* used); /* in utf8lib.c */
naRef naCodeGen(struct Parser* p, struct Token* block, struct Token* arglist);
void naParse(struct Parser* p);

View File

@ -14,13 +14,13 @@ static int fromnum(double val, unsigned char* s);
int naStr_len(naRef s)
{
if(!IS_STR(s)) return 0;
return s.ref.ptr.str->len;
return PTR(s).str->len;
}
char* naStr_data(naRef s)
{
if(!IS_STR(s)) return 0;
return (char*)s.ref.ptr.str->data;
return (char*)PTR(s).str->data;
}
static void setlen(struct naStr* s, int sz)
@ -33,24 +33,24 @@ static void setlen(struct naStr* s, int sz)
naRef naStr_buf(naRef dst, int len)
{
setlen(dst.ref.ptr.str, len);
naBZero(dst.ref.ptr.str->data, len);
setlen(PTR(dst).str, len);
naBZero(PTR(dst).str->data, len);
return dst;
}
naRef naStr_fromdata(naRef dst, char* data, int len)
{
if(!IS_STR(dst)) return naNil();
setlen(dst.ref.ptr.str, len);
memcpy(dst.ref.ptr.str->data, data, len);
setlen(PTR(dst).str, len);
memcpy(PTR(dst).str->data, data, len);
return dst;
}
naRef naStr_concat(naRef dest, naRef s1, naRef s2)
{
struct naStr* dst = dest.ref.ptr.str;
struct naStr* a = s1.ref.ptr.str;
struct naStr* b = s2.ref.ptr.str;
struct naStr* dst = PTR(dest).str;
struct naStr* a = PTR(s1).str;
struct naStr* b = PTR(s2).str;
if(!(IS_STR(s1)&&IS_STR(s2)&&IS_STR(dest))) return naNil();
setlen(dst, a->len + b->len);
memcpy(dst->data, a->data, a->len);
@ -60,8 +60,8 @@ naRef naStr_concat(naRef dest, naRef s1, naRef s2)
naRef naStr_substr(naRef dest, naRef str, int start, int len)
{
struct naStr* dst = dest.ref.ptr.str;
struct naStr* s = str.ref.ptr.str;
struct naStr* dst = PTR(dest).str;
struct naStr* s = PTR(str).str;
if(!(IS_STR(dest)&&IS_STR(str))) return naNil();
if(start + len > s->len) { dst->len = 0; dst->data = 0; return naNil(); }
setlen(dst, len);
@ -71,8 +71,8 @@ naRef naStr_substr(naRef dest, naRef str, int start, int len)
int naStr_equal(naRef s1, naRef s2)
{
struct naStr* a = s1.ref.ptr.str;
struct naStr* b = s2.ref.ptr.str;
struct naStr* a = PTR(s1).str;
struct naStr* b = PTR(s2).str;
if(a->data == b->data) return 1;
if(a->len != b->len) return 0;
if(memcmp(a->data, b->data, a->len) == 0) return 1;
@ -81,7 +81,7 @@ int naStr_equal(naRef s1, naRef s2)
naRef naStr_fromnum(naRef dest, double num)
{
struct naStr* dst = dest.ref.ptr.str;
struct naStr* dst = PTR(dest).str;
unsigned char buf[DIGITS+8];
setlen(dst, fromnum(num, buf));
memcpy(dst->data, buf, dst->len);
@ -95,13 +95,13 @@ int naStr_parsenum(char* str, int len, double* result)
int naStr_tonum(naRef str, double* out)
{
return tonum(str.ref.ptr.str->data, str.ref.ptr.str->len, out);
return tonum(PTR(str).str->data, PTR(str).str->len, out);
}
int naStr_numeric(naRef str)
{
double dummy;
return tonum(str.ref.ptr.str->data, str.ref.ptr.str->len, &dummy);
return tonum(PTR(str).str->data, PTR(str).str->len, &dummy);
}
void naStr_gcclean(struct naStr* str)

View File

@ -10,6 +10,12 @@ void* naNewLock()
return lock;
}
void naFreeLock(void* lock)
{
pthread_mutex_destroy(lock);
naFree(lock);
}
void naLock(void* lock)
{
pthread_mutex_lock((pthread_mutex_t*)lock);
@ -35,6 +41,14 @@ void* naNewSem()
return sem;
}
void naFreeSem(void* p)
{
struct naSem* sem = p;
pthread_mutex_destroy(&sem->lock);
pthread_cond_destroy(&sem->cvar);
naFree(sem);
}
void naSemDown(void* sh)
{
struct naSem* sem = (struct naSem*)sh;
@ -45,11 +59,11 @@ void naSemDown(void* sh)
pthread_mutex_unlock(&sem->lock);
}
void naSemUpAll(void* sh, int count)
void naSemUp(void* sh, int count)
{
struct naSem* sem = (struct naSem*)sh;
pthread_mutex_lock(&sem->lock);
sem->count = count;
sem->count += count;
pthread_cond_broadcast(&sem->cvar);
pthread_mutex_unlock(&sem->lock);
}

View File

@ -15,7 +15,7 @@ void naLock(void* lock) { EnterCriticalSection((LPCRITICAL_SECTION)lock); }
void naUnlock(void* lock) { LeaveCriticalSection((LPCRITICAL_SECTION)lock); }
void* naNewSem() { return CreateSemaphore(0, 0, MAX_SEM_COUNT, 0); }
void naSemDown(void* sem) { WaitForSingleObject((HANDLE)sem, INFINITE); }
void naSemUpAll(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
void naSemUp(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
#endif

103
simgear/nasal/threadlib.c Normal file
View File

@ -0,0 +1,103 @@
#ifdef _WIN32
#include <windows.h>
#else
#include <pthread.h>
#endif
#include "data.h"
#include "code.h"
static void lockDestroy(void* lock) { naFreeLock(lock); }
static naGhostType LockType = { lockDestroy };
static void semDestroy(void* sem) { naFreeSem(sem); }
static naGhostType SemType = { semDestroy };
typedef struct {
naContext ctx;
naRef func;
} ThreadData;
#ifdef _WIN32
static DWORD WINAPI threadtop(LPVOID param)
#else
static void* threadtop(void* param)
#endif
{
ThreadData* td = param;
naCall(td->ctx, td->func, 0, 0, naNil(), naNil());
naFreeContext(td->ctx);
naFree(td);
return 0;
}
static naRef f_newthread(naContext c, naRef me, int argc, naRef* args)
{
ThreadData *td;
if(argc < 1 || !naIsFunc(args[0]))
naRuntimeError(c, "bad/missing argument to newthread");
td = naAlloc(sizeof(*td));
td->ctx = naNewContext();
td->func = args[0];
naTempSave(td->ctx, td->func);
#ifdef _WIN32
CreateThread(0, 0, threadtop, td, 0, 0);
#else
{ pthread_t t; pthread_create(&t, 0, threadtop, td); }
#endif
return naNil();
}
static naRef f_newlock(naContext c, naRef me, int argc, naRef* args)
{
return naNewGhost(c, &LockType, naNewLock());
}
static naRef f_lock(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0 && naGhost_type(args[0]) == &LockType)
naLock(naGhost_ptr(args[0]));
return naNil();
}
static naRef f_unlock(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0 && naGhost_type(args[0]) == &LockType)
naUnlock(naGhost_ptr(args[0]));
return naNil();
}
static naRef f_newsem(naContext c, naRef me, int argc, naRef* args)
{
return naNewGhost(c, &SemType, naNewSem());
}
static naRef f_semdown(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0 && naGhost_type(args[0]) == &SemType)
naSemDown(naGhost_ptr(args[0]));
return naNil();
}
static naRef f_semup(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0 && naGhost_type(args[0]) == &SemType)
naSemUp(naGhost_ptr(args[0]), 1);
return naNil();
}
static naCFuncItem funcs[] = {
{ "newthread", f_newthread },
{ "newlock", f_newlock },
{ "lock", f_lock },
{ "unlock", f_unlock },
{ "newsem", f_newsem },
{ "semdown", f_semdown },
{ "semup", f_semup },
{ 0 }
};
naRef naInit_thread(naContext c)
{
return naGenLib(c, funcs);
}

161
simgear/nasal/utf8lib.c Normal file
View File

@ -0,0 +1,161 @@
#include <string.h>
#include "nasal.h"
#include "parse.h"
// bytes required to store a given character
static int cbytes(unsigned int c)
{
static const int NB[] = { 0x7f, 0x07ff, 0xffff, 0x001fffff, 0x03ffffff };
int i;
for(i=0; i<(sizeof(NB)/sizeof(NB[0])) && c>NB[i]; i++) {}
return i+1;
}
// Returns a byte with the N high order bits set
#define TOPBITS(n) ((unsigned char)(((signed char)0x80)>>((n)-1)))
// write a utf8 character, return bytes written or zero on error
static int writec(unsigned int c, unsigned char* s, int len)
{
int i, n = cbytes(c);
if(len < n) return 0;
for(i=n-1; i>0; i--) {
s[i] = 0x80 | (c & 0x3f);
c >>= 6;
}
s[0] = (n > 1 ? TOPBITS(n) : 0) | c;
return n;
}
// read a utf8 character, or -1 on error.
static int readc(unsigned char* s, int len, int* used)
{
int n, i, c;
if(len > 0 && s[0] < 0x80) { *used = 1; return s[0]; }
for(n=2; n<7; n++)
if((s[0] & TOPBITS(n+1)) == TOPBITS(n))
break;
if(len < n || n > 6) return -1;
c = s[0] & (~TOPBITS(n+1));
for(i=1; i<n; i++) {
if((s[i] >> 6) != 2) return -1;
c = (c << 6) | (s[i] & 0x3f);
}
if(n != cbytes(c)) return -1;
*used = n;
return c;
}
/* Public symbol used by the parser */
int naLexUtf8C(char* s, int len, int* used)
{ return readc((void*)s, len, used); }
static unsigned char* nthchar(unsigned char* s, int n, int* len)
{
int i, bytes;
for(i=0; *len && i<n; i++) {
if(readc(s, *len, &bytes) < 0) return 0;
s += bytes; *len -= bytes;
}
return s;
}
static naRef f_chstr(naContext ctx, naRef me, int argc, naRef* args)
{
int n;
naRef ch;
unsigned char buf[6];
if(argc < 1 || naIsNil(ch=naNumValue(args[0])))
naRuntimeError(ctx, "bad/missing argument to utf8.chstr");
n = writec((int)ch.num, buf, sizeof(buf));
return naStr_fromdata(naNewString(ctx), (void*)buf, n);
}
static naRef f_size(naContext c, naRef me, int argc, naRef* args)
{
unsigned char* s;
int sz=0, n, len;
if(argc < 1 || !naIsString(args[0]))
naRuntimeError(c, "bad/missing argument to utf8.strc");
s = (void*)naStr_data(args[0]);
len = naStr_len(args[0]);
while(len > 0) {
if(readc(s, len, &n) < 0)
naRuntimeError(c, "utf8 encoding error in utf8.size");
sz++; len -= n; s += n;
}
return naNum(sz);
}
static naRef f_strc(naContext ctx, naRef me, int argc, naRef* args)
{
naRef idx;
unsigned char* s;
int len, c=0, bytes;
if(argc < 2 || !naIsString(args[0]) || naIsNil(idx=naNumValue(args[1])))
naRuntimeError(ctx, "bad/missing argument to utf8.strc");
len = naStr_len(args[0]);
s = nthchar((void*)naStr_data(args[0]), (int)idx.num, &len);
if(!s || (c = readc(s, len, &bytes)) < 0)
naRuntimeError(ctx, "utf8 encoding error in utf8.strc");
return naNum(c);
}
static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
{
naRef start, end;
int len;
unsigned char *s, *s2;
end = argc > 2 ? naNumValue(args[2]) : naNil();
if((argc < 2 || !naIsString(args[0]) || naIsNil(start=naNumValue(args[1])))
|| (argc > 2 && naIsNil(end)))
naRuntimeError(c, "bad/missing argument to utf8.substr");
len = naStr_len(args[0]);
if(!(s = nthchar((void*)naStr_data(args[0]), (int)start.num, &len)))
naRuntimeError(c, "start index overrun in utf8.substr");
if(!naIsNil(end)) {
if(!(s2 = nthchar(s, (int)end.num, &len)))
naRuntimeError(c, "end index overrun in utf8.substr");
len = (int)(s2-s);
}
return naStr_fromdata(naNewString(c), (void*)s, len);
}
static naRef f_validate(naContext c, naRef me, int argc, naRef* args)
{
naRef result, unkc=naNil();
int len, len2, lenout=0, n;
unsigned char *s, *s2, *buf;
if(argc < 1 || !naIsString(args[0]) ||
(argc > 1 && naIsNil(unkc=naNumValue(args[1]))))
naRuntimeError(c, "bad/missing argument to utf8.strc");
if(naIsNil(unkc)) unkc = naNum('?');
len = naStr_len(args[0]);
s = (void*)naStr_data(args[0]);
len2 = 6*len; // max for ridiculous unkc values
s2 = buf = naAlloc(len2);
while(len > 0) {
int c = readc(s, len, &n);
if(c < 0) { c = (int)unkc.num; n = 1; }
s += n; len -= n;
n = writec(c, s2, len2);
s2 += n; len2 -= n; lenout += n;
}
result = naStr_fromdata(naNewString(c), (char*)buf, lenout);
naFree(buf);
return result;
}
static naCFuncItem funcs[] = {
{ "chstr", f_chstr },
{ "strc", f_strc },
{ "substr", f_substr },
{ "size", f_size },
{ "validate", f_validate },
{ 0 }
};
naRef naInit_utf8(naContext c)
{
return naGenLib(c, funcs);
}

View File

@ -28,7 +28,7 @@ void naVec_gcclean(struct naVec* v)
naRef naVec_get(naRef v, int i)
{
if(IS_VEC(v)) {
struct VecRec* r = v.ref.ptr.vec->rec;
struct VecRec* r = PTR(v).vec->rec;
if(r) {
if(i < 0) i += r->size;
if(i >= 0 && i < r->size) return r->array[i];
@ -40,7 +40,7 @@ naRef naVec_get(naRef v, int i)
void naVec_set(naRef vec, int i, naRef o)
{
if(IS_VEC(vec)) {
struct VecRec* r = vec.ref.ptr.vec->rec;
struct VecRec* r = PTR(vec).vec->rec;
if(r && i >= r->size) return;
r->array[i] = o;
}
@ -49,7 +49,7 @@ void naVec_set(naRef vec, int i, naRef o)
int naVec_size(naRef v)
{
if(IS_VEC(v)) {
struct VecRec* r = v.ref.ptr.vec->rec;
struct VecRec* r = PTR(v).vec->rec;
return r ? r->size : 0;
}
return 0;
@ -58,10 +58,10 @@ int naVec_size(naRef v)
int naVec_append(naRef vec, naRef o)
{
if(IS_VEC(vec)) {
struct VecRec* r = vec.ref.ptr.vec->rec;
struct VecRec* r = PTR(vec).vec->rec;
while(!r || r->size >= r->alloced) {
resize(vec.ref.ptr.vec);
r = vec.ref.ptr.vec->rec;
resize(PTR(vec).vec);
r = PTR(vec).vec->rec;
}
r->array[r->size] = o;
return r->size++;
@ -72,26 +72,25 @@ int naVec_append(naRef vec, naRef o)
void naVec_setsize(naRef vec, int sz)
{
int i;
struct VecRec* v = vec.ref.ptr.vec->rec;
struct VecRec* v = PTR(vec).vec->rec;
struct VecRec* nv = naAlloc(sizeof(struct VecRec) + sizeof(naRef) * sz);
nv->size = sz;
nv->alloced = sz;
for(i=0; i<sz; i++)
nv->array[i] = (v && i < v->size) ? v->array[i] : naNil();
naFree(v);
vec.ref.ptr.vec->rec = nv;
naGC_swapfree((void**)&(PTR(vec).vec->rec), nv);
}
naRef naVec_removelast(naRef vec)
{
naRef o;
if(IS_VEC(vec)) {
struct VecRec* v = vec.ref.ptr.vec->rec;
struct VecRec* v = PTR(vec).vec->rec;
if(!v || v->size == 0) return naNil();
o = v->array[v->size - 1];
v->size--;
if(v->size < (v->alloced >> 1))
resize(vec.ref.ptr.vec);
resize(PTR(vec).vec);
return o;
}
return naNil();