From b99d8715ce8ea2f97f25d65b628421c49087e23c Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Sat, 27 Dec 2008 06:02:53 +0000 Subject: [PATCH] generic aref/aset for all arrays (string v) now works on any value, by printing to a string some bug fixes in ios --- femtolisp/Makefile | 2 +- femtolisp/cvalues.c | 83 +++++++++++++++++++++++++-------------------- femtolisp/flisp.c | 10 ++++-- femtolisp/flisp.h | 2 ++ femtolisp/read.c | 4 +-- femtolisp/string.c | 27 ++++++++++++++- femtolisp/todo | 4 ++- llt/ios.c | 12 ++++--- 8 files changed, 95 insertions(+), 49 deletions(-) diff --git a/femtolisp/Makefile b/femtolisp/Makefile index 08c0468..37cdd95 100644 --- a/femtolisp/Makefile +++ b/femtolisp/Makefile @@ -8,7 +8,7 @@ EXENAME = $(NAME) LLTDIR = ../llt LLT = $(LLTDIR)/libllt.a -FLAGS = -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAGS) +FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAGS) LIBS = $(LLT) -lm DEBUGFLAGS = -g -DDEBUG $(FLAGS) diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 106cccc..d1e9722 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -1,4 +1,3 @@ -#define MAX_INL_SIZE 96 #ifdef BITS64 #define NWORDS(sz) (((sz)+7)>>3) #else @@ -113,6 +112,11 @@ static void autorelease(cvalue_t *cv) add_finalizer(cv); } +void cv_autorelease(cvalue_t *cv) +{ + autorelease(cv); +} + value_t cvalue(fltype_t *type, size_t sz) { cvalue_t *pcv; @@ -369,8 +373,7 @@ static void array_init_fromargs(char *dest, value_t *vals, size_t cnt, static int isarray(value_t v) { - if (!iscvalue(v)) return 0; - return cv_class((cvalue_t*)ptr(v))->eltype != NULL; + return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != NULL; } static size_t predict_arraylen(value_t arg) @@ -756,46 +759,53 @@ value_t cvalue_compare(value_t a, value_t b) return fixnum(diff); } -static void check_addr_args(char *fname, size_t typesize, value_t *args, - void **data, ulong_t *index) +static void check_addr_args(char *fname, value_t arr, value_t ind, + char **data, ulong_t *index) { - size_t sz; - if (!iscvalue(args[0])) - type_error(fname, "cvalue", args[0]); - *data = cv_data((cvalue_t*)ptr(args[0])); - sz = cv_len((cvalue_t*)ptr(args[0])); - cvalue_t *cv = (cvalue_t*)ptr(args[1]); - if (isfixnum(args[1])) - *index = numval(args[1]); - else if (!iscvalue(args[1]) || !valid_numtype(cv_numtype(cv))) - type_error(fname, "number", args[1]); - else - *index = conv_to_ulong(cv_data(cv), cv_numtype(cv)); - if (*index > sz - typesize) - bounds_error(fname, args[0], args[1]); + size_t numel; + cvalue_t *cv = (cvalue_t*)ptr(arr); + *data = cv_data(cv); + numel = cv_len(cv)/(cv_class(cv)->elsz); + *index = toulong(ind, fname); + if (*index >= numel) + bounds_error(fname, arr, ind); } -value_t cvalue_get_int8(value_t *args, u_int32_t nargs) +static value_t make_uninitialized_instance(fltype_t *t) { - void *data; ulong_t index; - argcount("get-int8", nargs, 2); - check_addr_args("get-int8", sizeof(int8_t), args, &data, &index); - return fixnum(((int8_t*)data)[index]); + if (t->eltype != NULL) + return alloc_array(t, t->size); + return cvalue(t, t->size); } -value_t cvalue_set_int8(value_t *args, u_int32_t nargs) +static value_t cvalue_array_aref(value_t *args) { - void *data; ulong_t index; int32_t val=0; - argcount("set-int8", nargs, 3); - check_addr_args("set-int8", sizeof(int8_t), args, &data, &index); - cvalue_t *cv = (cvalue_t*)ptr(args[2]); - if (isfixnum(args[2])) - val = numval(args[2]); - else if (!iscvalue(args[2]) || !valid_numtype(cv_numtype(cv))) - type_error("set-int8", "number", args[2]); + char *data; ulong_t index; + fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype; + value_t el = make_uninitialized_instance(eltype); + check_addr_args("aref", args[0], args[1], &data, &index); + char *dest = cv_data((cvalue_t*)ptr(el)); + size_t sz = eltype->size; + if (sz == 1) + *dest = data[index]; + else if (sz == 2) + *(int16_t*)dest = ((int16_t*)data)[index]; + else if (sz == 4) + *(int32_t*)dest = ((int32_t*)data)[index]; + else if (sz == 8) + *(int64_t*)dest = ((int64_t*)data)[index]; else - val = conv_to_int32(cv_data(cv), cv_numtype(cv)); - ((int8_t*)data)[index] = val; + memcpy(dest, data + index*sz, sz); + return el; +} + +static value_t cvalue_array_aset(value_t *args) +{ + char *data; ulong_t index; + fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype; + check_addr_args("aset", args[0], args[1], &data, &index); + char *dest = data + index*eltype->size; + cvalue_init(eltype, args[2], dest); return args[2]; } @@ -812,6 +822,7 @@ value_t fl_builtin(value_t *args, u_int32_t nargs) value_t cbuiltin(char *name, builtin_t f) { + assert(((uptrint_t)f & 0x7) == 0); value_t sym = symbol(name); ((symbol_t*)ptr(sym))->dlcache = f; ptrhash_put(&reverse_dlsym_lookup_table, f, (void*)sym); @@ -874,8 +885,6 @@ void cvalues_init() cv_intern(void); set(symbol("c-value"), cbuiltin("c-value", cvalue_new)); - set(symbol("get-int8"), cbuiltin("get-int8", cvalue_get_int8)); - set(symbol("set-int8"), cbuiltin("set-int8", cvalue_set_int8)); set(symbol("typeof"), cbuiltin("typeof", cvalue_typeof)); set(symbol("sizeof"), cbuiltin("sizeof", cvalue_sizeof)); set(symbol("builtin"), cbuiltin("builtin", fl_builtin)); diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index b90c7d5..e3e2b67 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -924,12 +924,15 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail) case F_AREF: argcount("aref", nargs, 2); v = Stack[SP-2]; - i = tofixnum(Stack[SP-1], "aref"); if (isvector(v)) { + i = tofixnum(Stack[SP-1], "aref"); if ((unsigned)i >= vector_size(v)) bounds_error("aref", v, Stack[SP-1]); v = vector_elt(v, i); } + else if (isarray(v)) { + v = cvalue_array_aref(&Stack[SP-2]); + } else { // TODO other sequence types? type_error("aref", "sequence", v); @@ -938,12 +941,15 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail) case F_ASET: argcount("aset", nargs, 3); e = Stack[SP-3]; - i = tofixnum(Stack[SP-2], "aset"); if (isvector(e)) { + i = tofixnum(Stack[SP-2], "aset"); if ((unsigned)i >= vector_size(e)) bounds_error("aref", v, Stack[SP-1]); vector_elt(e, i) = (v=Stack[SP-1]); } + else if (isarray(e)) { + v = cvalue_array_aset(&Stack[SP-3]); + } else { type_error("aset", "sequence", e); } diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index ae10e94..c2efbd0 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -201,6 +201,7 @@ typedef struct { } cprim_t; #define CPRIM_NWORDS 2 +#define MAX_INL_SIZE 96 #define CV_OWNED_BIT 0x1 #define CV_PARENT_BIT 0x2 @@ -242,6 +243,7 @@ extern fltype_t *builtintype; value_t cvalue(fltype_t *type, size_t sz); void add_finalizer(cvalue_t *cv); +void cv_autorelease(cvalue_t *cv); size_t ctype_sizeof(value_t type, int *palign); value_t cvalue_copy(value_t v); value_t cvalue_from_data(fltype_t *type, void *data, size_t sz); diff --git a/femtolisp/read.c b/femtolisp/read.c index 847de18..8be80b8 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -538,8 +538,8 @@ value_t read_sexpr(ios_t *f) value_t v; readstate_t state; state.prev = readstate; - htable_new(&state.backrefs, 16); - htable_new(&state.gensyms, 16); + htable_new(&state.backrefs, 8); + htable_new(&state.gensyms, 8); readstate = &state; v = do_read_sexpr(f, UNBOUND); diff --git a/femtolisp/string.c b/femtolisp/string.c index afde175..1c8af63 100644 --- a/femtolisp/string.c +++ b/femtolisp/string.c @@ -14,6 +14,27 @@ #include "llt.h" #include "flisp.h" +static value_t print_to_string(value_t v, int princ) +{ + ios_t str; + ios_mem(&str, 0); + print(&str, v, princ); + value_t outp; + if (str.size < MAX_INL_SIZE) { + outp = cvalue_string(str.size); + memcpy(cv_data((cvalue_t*)ptr(outp)), str.buf, str.size); + } + else { + size_t sz; + char *buf = ios_takebuf(&str, &sz); + buf[sz] = '\0'; + outp = cvalue_from_ref(stringtype, buf, sz-1, NIL); + cv_autorelease((cvalue_t*)ptr(outp)); + } + ios_close(&str); + return outp; +} + value_t fl_intern(value_t *args, u_int32_t nargs) { argcount("intern", nargs, 1); @@ -123,7 +144,11 @@ value_t fl_string(value_t *args, u_int32_t nargs) continue; } } - lerror(ArgError, "string: expected string, symbol or character"); + args[i] = print_to_string(args[i], 0); + if (nargs == 1) // convert single value to string + return args[i]; + sz += cv_len((cvalue_t*)ptr(args[i])); + //lerror(ArgError, "string: expected string, symbol or character"); } cv = cvalue_string(sz); char *ptr = cvalue_data(cv); diff --git a/femtolisp/todo b/femtolisp/todo index ed2d7cc..d483645 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -130,7 +130,7 @@ for internal use: . disadvantage is looking through the lambda list on every lookup. maybe improve by making lambda lists vectors somehow? * fast builtin bounded iteration construct (for lo hi (lambda (x) ...)) -- represent guest function as a tagged function pointer; allocate nothing +* represent guest function as a tagged function pointer; allocate nothing bugs: * with the fully recursive (simpler) relocate(), the size of cons chains @@ -927,7 +927,9 @@ consolidated todo list as of 8/30: - use the unused tag for TAG_PRIM, add smaller prim representation * finalizers in gc * hashtable +* generic aref/aset - expose io stream object +- new toplevel - enable print-shared for cvalues' types - remaining c types diff --git a/llt/ios.c b/llt/ios.c index ea04dc8..af7d01d 100644 --- a/llt/ios.c +++ b/llt/ios.c @@ -154,9 +154,6 @@ static char *_buf_realloc(ios_t *s, size_t sz) { char *temp; - if (sz <= s->maxsize) - return s->buf; - if ((s->buf==NULL || s->buf==&s->local[0]) && (sz <= IOS_INLSIZE)) { /* TODO: if we want to allow shrinking, see if the buffer shrank down to this size, in which case we need to copy. */ @@ -165,7 +162,10 @@ static char *_buf_realloc(ios_t *s, size_t sz) s->ownbuf = 1; return s->buf; } - else if (s->ownbuf && s->buf != &s->local[0]) { + + if (sz <= s->maxsize) return s->buf; + + if (s->ownbuf && s->buf != &s->local[0]) { // if we own the buffer we're free to resize it // always allocate 1 bigger in case user wants to add a NUL // terminator after taking over the buffer @@ -201,7 +201,7 @@ static size_t _write_grow(ios_t *s, char *data, size_t n) if (s->bpos + n > s->maxsize) { /* TODO: here you might want to add a mechanism for limiting the growth of the stream. */ - newsize = s->maxsize * 2; + newsize = s->maxsize ? s->maxsize * 2 : 8; while (s->bpos + n > newsize) newsize *= 2; if (_buf_realloc(s, newsize) == NULL) { @@ -514,6 +514,8 @@ void ios_close(ios_t *s) if (s->fd != -1 && s->ownfd) close(s->fd); s->fd = -1; + if (s->buf!=NULL && s->ownbuf && s->buf!=&s->local[0]) + free(s->buf); } static void _buf_init(ios_t *s, bufmode_t bm)