generic aref/aset for all arrays
(string v) now works on any value, by printing to a string some bug fixes in ios
This commit is contained in:
parent
7e04bb948c
commit
b99d8715ce
|
@ -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)
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
12
llt/ios.c
12
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)
|
||||
|
|
Loading…
Reference in New Issue