lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Replace cvalue_t with struct

This commit is contained in:
Lassi Kortela 2019-08-09 19:36:20 +03:00
parent b48261f21c
commit fe4550dad7
9 changed files with 98 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
c/builtins.c
View File

@ -101,18 +101,18 @@ static value_t fl_length(value_t *args, u_int32_t nargs)
{ {
argcount("length", nargs, 1); argcount("length", nargs, 1);
value_t a = args[0]; value_t a = args[0];
cvalue_t *cv; struct cvalue *cv;
if (isvector(a)) { if (isvector(a)) {
return fixnum(vector_size(a)); return fixnum(vector_size(a));
} else if (iscprim(a)) { } else if (iscprim(a)) {
cv = (cvalue_t *)ptr(a); cv = (struct cvalue *)ptr(a);
if (cp_class(cv) == bytetype) if (cp_class(cv) == bytetype)
return fixnum(1); return fixnum(1);
else if (cp_class(cv) == wchartype) else if (cp_class(cv) == wchartype)
return fixnum( return fixnum(
u8_charlen(*(uint32_t *)cp_data((struct cprim *)cv))); u8_charlen(*(uint32_t *)cp_data((struct cprim *)cv)));
} else if (iscvalue(a)) { } else if (iscvalue(a)) {
cv = (cvalue_t *)ptr(a); cv = (struct cvalue *)ptr(a);
if (cv_class(cv)->eltype != NULL) if (cv_class(cv)->eltype != NULL)
return size_wrap(cvalue_arraylen(a)); return size_wrap(cvalue_arraylen(a));
} else if (a == FL_NIL) { } else if (a == FL_NIL) {

79
c/cvalues.h
View File

@ -40,16 +40,16 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs);
static size_t malloc_pressure = 0; static size_t malloc_pressure = 0;
static cvalue_t **Finalizers = NULL; static struct cvalue **Finalizers = NULL;
static size_t nfinalizers = 0; static size_t nfinalizers = 0;
static size_t maxfinalizers = 0; static size_t maxfinalizers = 0;
void add_finalizer(cvalue_t *cv) void add_finalizer(struct cvalue *cv)
{ {
if (nfinalizers == maxfinalizers) { if (nfinalizers == maxfinalizers) {
size_t nn = (maxfinalizers == 0 ? 256 : maxfinalizers * 2); size_t nn = (maxfinalizers == 0 ? 256 : maxfinalizers * 2);
cvalue_t **temp = struct cvalue **temp =
(cvalue_t **)realloc(Finalizers, nn * sizeof(value_t)); (struct cvalue **)realloc(Finalizers, nn * sizeof(value_t));
if (temp == NULL) if (temp == NULL)
lerror(MemoryError, "out of memory"); lerror(MemoryError, "out of memory");
Finalizers = temp; Finalizers = temp;
@ -61,9 +61,9 @@ void add_finalizer(cvalue_t *cv)
// remove dead objects from finalization list in-place // remove dead objects from finalization list in-place
static void sweep_finalizers(void) static void sweep_finalizers(void)
{ {
cvalue_t **lst = Finalizers; struct cvalue **lst = Finalizers;
size_t n = 0, ndel = 0, l = nfinalizers; size_t n = 0, ndel = 0, l = nfinalizers;
cvalue_t *tmp; struct cvalue *tmp;
#define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1) #define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1)
if (l == 0) if (l == 0)
return; return;
@ -71,7 +71,7 @@ static void sweep_finalizers(void)
tmp = lst[n]; tmp = lst[n];
if (isforwarded((value_t)tmp)) { if (isforwarded((value_t)tmp)) {
// object is alive // object is alive
lst[n] = (cvalue_t *)ptr(forwardloc((value_t)tmp)); lst[n] = (struct cvalue *)ptr(forwardloc((value_t)tmp));
n++; n++;
} else { } else {
struct fltype *t = cv_class(tmp); struct fltype *t = cv_class(tmp);
@ -98,7 +98,7 @@ static void sweep_finalizers(void)
} }
// compute the size of the metadata object for a cvalue // compute the size of the metadata object for a cvalue
static size_t cv_nwords(cvalue_t *cv) static size_t cv_nwords(struct cvalue *cv)
{ {
if (isinlined(cv)) { if (isinlined(cv)) {
size_t n = cv_len(cv); size_t n = cv_len(cv);
@ -109,13 +109,13 @@ static size_t cv_nwords(cvalue_t *cv)
return CVALUE_NWORDS; return CVALUE_NWORDS;
} }
static void autorelease(cvalue_t *cv) static void autorelease(struct cvalue *cv)
{ {
cv->type = (struct fltype *)(((uptrint_t)cv->type) | CV_OWNED_BIT); cv->type = (struct fltype *)(((uptrint_t)cv->type) | CV_OWNED_BIT);
add_finalizer(cv); add_finalizer(cv);
} }
void cv_autorelease(cvalue_t *cv) { autorelease(cv); } void cv_autorelease(struct cvalue *cv) { autorelease(cv); }
static value_t cprim(struct fltype *type, size_t sz) static value_t cprim(struct fltype *type, size_t sz)
{ {
@ -129,7 +129,7 @@ static value_t cprim(struct fltype *type, size_t sz)
value_t cvalue(struct fltype *type, size_t sz) value_t cvalue(struct fltype *type, size_t sz)
{ {
cvalue_t *pcv; struct cvalue *pcv;
int str = 0; int str = 0;
if (valid_numtype(type->numtype)) { if (valid_numtype(type->numtype)) {
@ -143,7 +143,7 @@ value_t cvalue(struct fltype *type, size_t sz)
} }
if (sz <= MAX_INL_SIZE) { if (sz <= MAX_INL_SIZE) {
size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0); size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0);
pcv = (cvalue_t *)alloc_words(nw); pcv = (struct cvalue *)alloc_words(nw);
pcv->type = type; pcv->type = type;
pcv->data = &pcv->_space[0]; pcv->data = &pcv->_space[0];
if (type->vtable != NULL && type->vtable->finalize != NULL) if (type->vtable != NULL && type->vtable->finalize != NULL)
@ -151,7 +151,7 @@ value_t cvalue(struct fltype *type, size_t sz)
} else { } else {
if (malloc_pressure > ALLOC_LIMIT_TRIGGER) if (malloc_pressure > ALLOC_LIMIT_TRIGGER)
gc(0); gc(0);
pcv = (cvalue_t *)alloc_words(CVALUE_NWORDS); pcv = (struct cvalue *)alloc_words(CVALUE_NWORDS);
pcv->type = type; pcv->type = type;
pcv->data = malloc(sz); pcv->data = malloc(sz);
autorelease(pcv); autorelease(pcv);
@ -184,10 +184,10 @@ value_t cvalue_from_data(struct fltype *type, void *data, size_t sz)
value_t cvalue_from_ref(struct fltype *type, void *ptr, size_t sz, value_t cvalue_from_ref(struct fltype *type, void *ptr, size_t sz,
value_t parent) value_t parent)
{ {
cvalue_t *pcv; struct cvalue *pcv;
value_t cv; value_t cv;
pcv = (cvalue_t *)alloc_words(CVALUE_NWORDS); pcv = (struct cvalue *)alloc_words(CVALUE_NWORDS);
pcv->data = ptr; pcv->data = ptr;
pcv->len = sz; pcv->len = sz;
pcv->type = type; pcv->type = type;
@ -220,11 +220,11 @@ value_t string_from_cstr(char *str)
int fl_isstring(value_t v) int fl_isstring(value_t v)
{ {
return (iscvalue(v) && cv_isstr((cvalue_t *)ptr(v))); return (iscvalue(v) && cv_isstr((struct cvalue *)ptr(v)));
} }
// convert to malloc representation (fixed address) // convert to malloc representation (fixed address)
void cv_pin(cvalue_t *cv) void cv_pin(struct cvalue *cv)
{ {
if (!isinlined(cv)) if (!isinlined(cv))
return; return;
@ -362,7 +362,7 @@ value_t cvalue_enum(value_t *args, u_int32_t nargs)
static int isarray(value_t v) static int isarray(value_t v)
{ {
return iscvalue(v) && cv_class((cvalue_t *)ptr(v))->eltype != NULL; return iscvalue(v) && cv_class((struct cvalue *)ptr(v))->eltype != NULL;
} }
static size_t predict_arraylen(value_t arg) static size_t predict_arraylen(value_t arg)
@ -418,7 +418,7 @@ static int cvalue_array_init(struct fltype *ft, value_t arg, void *dest)
lerror(ArgError, "array: size mismatch"); lerror(ArgError, "array: size mismatch");
return 0; return 0;
} else if (iscvalue(arg)) { } else if (iscvalue(arg)) {
cvalue_t *cv = (cvalue_t *)ptr(arg); struct cvalue *cv = (struct cvalue *)ptr(arg);
if (isarray(arg)) { if (isarray(arg)) {
struct fltype *aet = cv_class(cv)->eltype; struct fltype *aet = cv_class(cv)->eltype;
if (aet == eltype) { if (aet == eltype) {
@ -454,7 +454,7 @@ value_t cvalue_array(value_t *args, u_int32_t nargs)
sz = elsize * cnt; sz = elsize * cnt;
value_t cv = cvalue(type, sz); value_t cv = cvalue(type, sz);
char *dest = cv_data((cvalue_t *)ptr(cv)); char *dest = cv_data((struct cvalue *)ptr(cv));
FOR_ARGS(i, 1, arg, args) FOR_ARGS(i, 1, arg, args)
{ {
cvalue_init(type->eltype, arg, dest); cvalue_init(type->eltype, arg, dest);
@ -466,7 +466,7 @@ value_t cvalue_array(value_t *args, u_int32_t nargs)
// NOTE: v must be an array // NOTE: v must be an array
size_t cvalue_arraylen(value_t v) size_t cvalue_arraylen(value_t v)
{ {
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
return cv_len(cv) / (cv_class(cv)->elsz); return cv_len(cv) / (cv_class(cv)->elsz);
} }
@ -575,7 +575,7 @@ extern struct fltype *iostreamtype;
void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz) void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
{ {
if (iscvalue(v)) { if (iscvalue(v)) {
cvalue_t *pcv = (cvalue_t *)ptr(v); struct cvalue *pcv = (struct cvalue *)ptr(v);
struct ios *x = value2c(struct ios *, v); struct ios *x = value2c(struct ios *, v);
if (cv_class(pcv) == iostreamtype && (x->bm == bm_mem)) { if (cv_class(pcv) == iostreamtype && (x->bm == bm_mem)) {
*pdata = x->buf; *pdata = x->buf;
@ -632,18 +632,18 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs)
return builtinsym; return builtinsym;
return FUNCTION; return FUNCTION;
} }
return cv_type((cvalue_t *)ptr(args[0])); return cv_type((struct cvalue *)ptr(args[0]));
} }
static value_t cvalue_relocate(value_t v) static value_t cvalue_relocate(value_t v)
{ {
size_t nw; size_t nw;
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
cvalue_t *nv; struct cvalue *nv;
value_t ncv; value_t ncv;
nw = cv_nwords(cv); nw = cv_nwords(cv);
nv = (cvalue_t *)alloc_words(nw); nv = (struct cvalue *)alloc_words(nw);
memcpy(nv, cv, nw * sizeof(value_t)); memcpy(nv, cv, nw * sizeof(value_t));
if (isinlined(cv)) if (isinlined(cv))
nv->data = &nv->_space[0]; nv->data = &nv->_space[0];
@ -659,11 +659,11 @@ value_t cvalue_copy(value_t v)
{ {
assert(iscvalue(v)); assert(iscvalue(v));
PUSH(v); PUSH(v);
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
size_t nw = cv_nwords(cv); size_t nw = cv_nwords(cv);
cvalue_t *ncv = (cvalue_t *)alloc_words(nw); struct cvalue *ncv = (struct cvalue *)alloc_words(nw);
v = POP(); v = POP();
cv = (cvalue_t *)ptr(v); cv = (struct cvalue *)ptr(v);
memcpy(ncv, cv, nw * sizeof(value_t)); memcpy(ncv, cv, nw * sizeof(value_t));
if (!isinlined(cv)) { if (!isinlined(cv)) {
size_t len = cv_len(cv); size_t len = cv_len(cv);
@ -691,7 +691,7 @@ value_t fl_copy(value_t *args, u_int32_t nargs)
lerror(ArgError, "copy: argument must be a leaf atom"); lerror(ArgError, "copy: argument must be a leaf atom");
if (!iscvalue(args[0])) if (!iscvalue(args[0]))
return args[0]; return args[0];
if (!cv_isPOD((cvalue_t *)ptr(args[0]))) if (!cv_isPOD((struct cvalue *)ptr(args[0])))
lerror(ArgError, "copy: argument must be a plain-old-data type"); lerror(ArgError, "copy: argument must be a plain-old-data type");
return cvalue_copy(args[0]); return cvalue_copy(args[0]);
} }
@ -700,7 +700,7 @@ value_t fl_podp(value_t *args, u_int32_t nargs)
{ {
argcount("plain-old-data?", nargs, 1); argcount("plain-old-data?", nargs, 1);
return (iscprim(args[0]) || return (iscprim(args[0]) ||
(iscvalue(args[0]) && cv_isPOD((cvalue_t *)ptr(args[0])))) (iscvalue(args[0]) && cv_isPOD((struct cvalue *)ptr(args[0]))))
? FL_T ? FL_T
: FL_F; : FL_F;
} }
@ -780,7 +780,7 @@ value_t cvalue_new(value_t *args, u_int32_t nargs)
cnt = 0; cnt = 0;
cv = cvalue(ft, elsz * cnt); cv = cvalue(ft, elsz * cnt);
if (nargs == 2) if (nargs == 2)
cvalue_array_init(ft, args[1], cv_data((cvalue_t *)ptr(cv))); cvalue_array_init(ft, args[1], cv_data((struct cvalue *)ptr(cv)));
} else { } else {
cv = cvalue(ft, ft->size); cv = cvalue(ft, ft->size);
if (nargs == 2) if (nargs == 2)
@ -792,8 +792,8 @@ value_t cvalue_new(value_t *args, u_int32_t nargs)
// NOTE: this only compares lexicographically; it ignores numeric formats // NOTE: this only compares lexicographically; it ignores numeric formats
value_t cvalue_compare(value_t a, value_t b) value_t cvalue_compare(value_t a, value_t b)
{ {
cvalue_t *ca = (cvalue_t *)ptr(a); struct cvalue *ca = (struct cvalue *)ptr(a);
cvalue_t *cb = (cvalue_t *)ptr(b); struct cvalue *cb = (struct cvalue *)ptr(b);
char *adata = cv_data(ca); char *adata = cv_data(ca);
char *bdata = cv_data(cb); char *bdata = cv_data(cb);
size_t asz = cv_len(ca); size_t asz = cv_len(ca);
@ -813,7 +813,7 @@ static void check_addr_args(char *fname, value_t arr, value_t ind,
char **data, ulong_t *index) char **data, ulong_t *index)
{ {
size_t numel; size_t numel;
cvalue_t *cv = (cvalue_t *)ptr(arr); struct cvalue *cv = (struct cvalue *)ptr(arr);
*data = cv_data(cv); *data = cv_data(cv);
numel = cv_len(cv) / (cv_class(cv)->elsz); numel = cv_len(cv) / (cv_class(cv)->elsz);
*index = toulong(ind, fname); *index = toulong(ind, fname);
@ -825,7 +825,7 @@ static value_t cvalue_array_aref(value_t *args)
{ {
char *data; char *data;
ulong_t index; ulong_t index;
struct fltype *eltype = cv_class((cvalue_t *)ptr(args[0]))->eltype; struct fltype *eltype = cv_class((struct cvalue *)ptr(args[0]))->eltype;
value_t el = 0; value_t el = 0;
numerictype_t nt = eltype->numtype; numerictype_t nt = eltype->numtype;
if (nt >= T_INT32) if (nt >= T_INT32)
@ -859,7 +859,7 @@ static value_t cvalue_array_aset(value_t *args)
{ {
char *data; char *data;
ulong_t index; ulong_t index;
struct fltype *eltype = cv_class((cvalue_t *)ptr(args[0]))->eltype; struct fltype *eltype = cv_class((struct cvalue *)ptr(args[0]))->eltype;
check_addr_args("aset!", args[0], args[1], &data, &index); check_addr_args("aset!", args[0], args[1], &data, &index);
char *dest = data + index * eltype->size; char *dest = data + index * eltype->size;
cvalue_init(eltype, args[2], dest); cvalue_init(eltype, args[2], dest);
@ -870,7 +870,7 @@ value_t fl_builtin(value_t *args, u_int32_t nargs)
{ {
argcount("builtin", nargs, 1); argcount("builtin", nargs, 1);
struct symbol *name = tosymbol(args[0], "builtin"); struct symbol *name = tosymbol(args[0], "builtin");
cvalue_t *cv; struct cvalue *cv;
if (ismanaged(args[0]) || (cv = name->dlcache) == NULL) { if (ismanaged(args[0]) || (cv = name->dlcache) == NULL) {
lerrorf(ArgError, "builtin: function %s not found", name->name); lerrorf(ArgError, "builtin: function %s not found", name->name);
} }
@ -879,7 +879,8 @@ value_t fl_builtin(value_t *args, u_int32_t nargs)
value_t cbuiltin(char *name, builtin_t f) value_t cbuiltin(char *name, builtin_t f)
{ {
cvalue_t *cv = (cvalue_t *)malloc(CVALUE_NWORDS * sizeof(value_t)); struct cvalue *cv =
(struct cvalue *)malloc(CVALUE_NWORDS * sizeof(value_t));
cv->type = builtintype; cv->type = builtintype;
cv->data = &cv->_space[0]; cv->data = &cv->_space[0];
cv->len = sizeof(value_t); cv->len = sizeof(value_t);

7
c/equal.h
View File

@ -101,7 +101,8 @@ compare_top:
break; break;
case TAG_CVALUE: case TAG_CVALUE:
if (iscvalue(b)) { if (iscvalue(b)) {
if (cv_isPOD((cvalue_t *)ptr(a)) && cv_isPOD((cvalue_t *)ptr(b))) if (cv_isPOD((struct cvalue *)ptr(a)) &&
cv_isPOD((struct cvalue *)ptr(b)))
return cvalue_compare(a, b); return cvalue_compare(a, b);
return fixnum(1); return fixnum(1);
} }
@ -311,7 +312,7 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
} u; } u;
numerictype_t nt; numerictype_t nt;
size_t i, len; size_t i, len;
cvalue_t *cv; struct cvalue *cv;
struct cprim *cp; struct cprim *cp;
void *data; void *data;
uptrint_t h = 0; uptrint_t h = 0;
@ -337,7 +338,7 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
u.d = conv_to_double(data, nt); u.d = conv_to_double(data, nt);
return doublehash(u.i64); return doublehash(u.i64);
case TAG_CVALUE: case TAG_CVALUE:
cv = (cvalue_t *)ptr(a); cv = (struct cvalue *)ptr(a);
data = cv_data(cv); data = cv_data(cv);
return memhash(data, cv_len(cv)); return memhash(data, cv_len(cv));

6
c/flisp.c
View File

@ -252,7 +252,7 @@ void bounds_error(char *fname, value_t arr, value_t ind)
SAFECAST_OP(cons, struct cons *, ptr) SAFECAST_OP(cons, struct cons *, ptr)
SAFECAST_OP(symbol, struct symbol *, ptr) SAFECAST_OP(symbol, struct symbol *, ptr)
SAFECAST_OP(fixnum, fixnum_t, numval) SAFECAST_OP(fixnum, fixnum_t, numval)
SAFECAST_OP(cvalue, cvalue_t *, ptr) SAFECAST_OP(cvalue, struct cvalue *, ptr)
SAFECAST_OP(string, char *, cvalue_data) SAFECAST_OP(string, char *, cvalue_data)
#undef isstring #undef isstring
@ -989,7 +989,7 @@ static value_t apply_cl(uint32_t nargs)
apply_cl_top: apply_cl_top:
captured = 0; captured = 0;
func = Stack[SP - nargs - 1]; func = Stack[SP - nargs - 1];
ip = cv_data((cvalue_t *)ptr(fn_bcode(func))); ip = cv_data((struct cvalue *)ptr(fn_bcode(func)));
assert(!ismanaged((uptrint_t)ip)); assert(!ismanaged((uptrint_t)ip));
while (SP + GET_INT32(ip) > N_STACK) { while (SP + GET_INT32(ip) > N_STACK) {
grow_stack(); grow_stack();
@ -2237,7 +2237,7 @@ static value_t fl_function(value_t *args, uint32_t nargs)
type_error("function", "string", args[0]); type_error("function", "string", args[0]);
if (!isvector(args[1])) if (!isvector(args[1]))
type_error("function", "vector", args[1]); type_error("function", "vector", args[1]);
cvalue_t *arr = (cvalue_t *)ptr(args[0]); struct cvalue *arr = (struct cvalue *)ptr(args[0]);
cv_pin(arr); cv_pin(arr);
char *data = cv_data(arr); char *data = cv_data(arr);
int swap = 0; int swap = 0;

20
c/flisp.h
View File

@ -114,7 +114,7 @@ struct gensym {
#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS << 3)) #define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS << 3))
#define isclosure(x) isfunction(x) #define isclosure(x) isfunction(x)
#define iscbuiltin(x) \ #define iscbuiltin(x) \
(iscvalue(x) && (cv_class((cvalue_t *)ptr(x)) == builtintype)) (iscvalue(x) && (cv_class((struct cvalue *)ptr(x)) == builtintype))
void fl_gc_handle(value_t *pv); void fl_gc_handle(value_t *pv);
void fl_free_gc_handles(uint32_t n); void fl_free_gc_handles(uint32_t n);
@ -262,7 +262,7 @@ struct fltype {
cvinitfunc_t init; cvinitfunc_t init;
}; };
typedef struct { struct cvalue {
struct fltype *type; struct fltype *type;
void *data; void *data;
size_t len; // length of *data in bytes size_t len; // length of *data in bytes
@ -270,7 +270,7 @@ typedef struct {
value_t parent; // optional value_t parent; // optional
char _space[1]; // variable size char _space[1]; // variable size
}; };
} cvalue_t; };
#define CVALUE_NWORDS 4 #define CVALUE_NWORDS 4
@ -301,9 +301,9 @@ struct function {
#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype) #define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
#define cv_isPOD(cv) (cv_class(cv)->init != NULL) #define cv_isPOD(cv) (cv_class(cv)->init != NULL)
#define cvalue_data(v) cv_data((cvalue_t *)ptr(v)) #define cvalue_data(v) cv_data((struct cvalue *)ptr(v))
#define cvalue_len(v) cv_len((cvalue_t *)ptr(v)) #define cvalue_len(v) cv_len((struct cvalue *)ptr(v))
#define value2c(type, v) ((type)cv_data((cvalue_t *)ptr(v))) #define value2c(type, v) ((type)cv_data((struct cvalue *)ptr(v)))
#define valid_numtype(v) ((v) < N_NUMTYPES) #define valid_numtype(v) ((v) < N_NUMTYPES)
#define cp_class(cp) ((cp)->type) #define cp_class(cp) ((cp)->type)
@ -314,7 +314,7 @@ struct function {
// WARNING: multiple evaluation! // WARNING: multiple evaluation!
#define cptr(v) \ #define cptr(v) \
(iscprim(v) ? cp_data((struct cprim *)ptr(v)) \ (iscprim(v) ? cp_data((struct cprim *)ptr(v)) \
: cv_data((cvalue_t *)ptr(v))) : cv_data((struct cvalue *)ptr(v)))
/* C type names corresponding to cvalues type names */ /* C type names corresponding to cvalues type names */
typedef int8_t fl_int8_t; typedef int8_t fl_int8_t;
@ -349,9 +349,9 @@ extern struct fltype *stringtype, *wcstringtype;
extern struct fltype *builtintype; extern struct fltype *builtintype;
value_t cvalue(struct fltype *type, size_t sz); value_t cvalue(struct fltype *type, size_t sz);
void add_finalizer(cvalue_t *cv); void add_finalizer(struct cvalue *cv);
void cv_autorelease(cvalue_t *cv); void cv_autorelease(struct cvalue *cv);
void cv_pin(cvalue_t *cv); void cv_pin(struct cvalue *cv);
size_t ctype_sizeof(value_t type, int *palign); size_t ctype_sizeof(value_t type, int *palign);
value_t cvalue_copy(value_t v); value_t cvalue_copy(value_t v);
value_t cvalue_from_data(struct fltype *type, void *data, size_t sz); value_t cvalue_from_data(struct fltype *type, void *data, size_t sz);

8
c/iostream.c
View File

@ -53,7 +53,7 @@ struct cvtable iostream_vtable = { print_iostream, relocate_iostream,
int fl_isiostream(value_t v) int fl_isiostream(value_t v)
{ {
return iscvalue(v) && cv_class((cvalue_t *)ptr(v)) == iostreamtype; return iscvalue(v) && cv_class((struct cvalue *)ptr(v)) == iostreamtype;
} }
value_t fl_iostreamp(value_t *args, uint32_t nargs) value_t fl_iostreamp(value_t *args, uint32_t nargs)
@ -281,7 +281,7 @@ value_t fl_ioread(value_t *args, u_int32_t nargs)
value_t cv = cvalue(ft, n); value_t cv = cvalue(ft, n);
char *data; char *data;
if (iscvalue(cv)) if (iscvalue(cv))
data = cv_data((cvalue_t *)ptr(cv)); data = cv_data((struct cvalue *)ptr(cv));
else else
data = cp_data((struct cprim *)ptr(cv)); data = cp_data((struct cprim *)ptr(cv));
size_t got = ios_read(value2c(struct ios *, args[0]), data, n); size_t got = ios_read(value2c(struct ios *, args[0]), data, n);
@ -364,7 +364,7 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
{ {
argcount("io.readuntil", nargs, 2); argcount("io.readuntil", nargs, 2);
value_t str = cvalue_string(80); value_t str = cvalue_string(80);
cvalue_t *cv = (cvalue_t *)ptr(str); struct cvalue *cv = (struct cvalue *)ptr(str);
char *data = cv_data(cv); char *data = cv_data(cv);
struct ios dest; struct ios dest;
ios_mem(&dest, 0); ios_mem(&dest, 0);
@ -424,7 +424,7 @@ value_t stream_to_string(value_t *ps)
b[n] = '\0'; b[n] = '\0';
str = cvalue_from_ref(stringtype, b, n, FL_NIL); str = cvalue_from_ref(stringtype, b, n, FL_NIL);
#ifndef BOEHM_GC #ifndef BOEHM_GC
cv_autorelease((cvalue_t *)ptr(str)); cv_autorelease((struct cvalue *)ptr(str));
#endif #endif
} }
return str; return str;

6
c/print.h
View File

@ -86,7 +86,7 @@ void print_traverse(value_t v)
print_traverse(f->env); print_traverse(f->env);
} else { } else {
assert(iscvalue(v)); assert(iscvalue(v));
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
// don't consider shared references to "" // don't consider shared references to ""
if (!cv_isstr(cv) || cv_len(cv) != 0) if (!cv_isstr(cv) || cv_len(cv) != 0)
mark_cons(v); mark_cons(v);
@ -150,7 +150,7 @@ static inline int tinyp(value_t v)
if (issymbol(v)) if (issymbol(v))
return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN); return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN);
if (fl_isstring(v)) if (fl_isstring(v))
return (cv_len((cvalue_t *)ptr(v)) < SMALL_STR_LEN); return (cv_len((struct cvalue *)ptr(v)) < SMALL_STR_LEN);
return (isfixnum(v) || isbuiltin(v) || v == FL_F || v == FL_T || return (isfixnum(v) || isbuiltin(v) || v == FL_F || v == FL_T ||
v == FL_NIL || v == FL_EOF || iscprim(v)); v == FL_NIL || v == FL_EOF || iscprim(v));
} }
@ -780,7 +780,7 @@ static void cvalue_printdata(struct ios *f, void *data, size_t len,
static void cvalue_print(struct ios *f, value_t v) static void cvalue_print(struct ios *f, value_t v)
{ {
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
void *data = cptr(v); void *data = cptr(v);
value_t label; value_t label;

39
c/string.c
View File

@ -45,7 +45,7 @@ value_t fl_string_count(value_t *args, u_int32_t nargs)
argcount("string.count", nargs, 1); argcount("string.count", nargs, 1);
if (!fl_isstring(args[0])) if (!fl_isstring(args[0]))
type_error("string.count", "string", args[0]); type_error("string.count", "string", args[0]);
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t stop = len; size_t stop = len;
if (nargs > 1) { if (nargs > 1) {
start = toulong(args[1], "string.count"); start = toulong(args[1], "string.count");
@ -84,7 +84,7 @@ value_t fl_string_reverse(value_t *args, u_int32_t nargs)
argcount("string.reverse", nargs, 1); argcount("string.reverse", nargs, 1);
if (!fl_isstring(args[0])) if (!fl_isstring(args[0]))
type_error("string.reverse", "string", args[0]); type_error("string.reverse", "string", args[0]);
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
value_t ns = cvalue_string(len); value_t ns = cvalue_string(len);
u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len); u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
return ns; return ns;
@ -94,14 +94,15 @@ value_t fl_string_encode(value_t *args, u_int32_t nargs)
{ {
argcount("string.encode", nargs, 1); argcount("string.encode", nargs, 1);
if (iscvalue(args[0])) { if (iscvalue(args[0])) {
cvalue_t *cv = (cvalue_t *)ptr(args[0]); struct cvalue *cv = (struct cvalue *)ptr(args[0]);
struct fltype *t = cv_class(cv); struct fltype *t = cv_class(cv);
if (t->eltype == wchartype) { if (t->eltype == wchartype) {
size_t nc = cv_len(cv) / sizeof(uint32_t); size_t nc = cv_len(cv) / sizeof(uint32_t);
uint32_t *ptr = (uint32_t *)cv_data(cv); uint32_t *ptr = (uint32_t *)cv_data(cv);
size_t nbytes = u8_codingsize(ptr, nc); size_t nbytes = u8_codingsize(ptr, nc);
value_t str = cvalue_string(nbytes); value_t str = cvalue_string(nbytes);
ptr = cv_data((cvalue_t *)ptr(args[0])); // relocatable pointer ptr =
cv_data((struct cvalue *)ptr(args[0])); // relocatable pointer
u8_toutf8(cvalue_data(str), nbytes, ptr, nc); u8_toutf8(cvalue_data(str), nbytes, ptr, nc);
return str; return str;
} }
@ -119,7 +120,7 @@ value_t fl_string_decode(value_t *args, u_int32_t nargs)
} }
if (!fl_isstring(args[0])) if (!fl_isstring(args[0]))
type_error("string.decode", "string", args[0]); type_error("string.decode", "string", args[0]);
cvalue_t *cv = (cvalue_t *)ptr(args[0]); struct cvalue *cv = (struct cvalue *)ptr(args[0]);
char *ptr = (char *)cv_data(cv); char *ptr = (char *)cv_data(cv);
size_t nb = cv_len(cv); size_t nb = cv_len(cv);
size_t nc = u8_charnum(ptr, nb); size_t nc = u8_charnum(ptr, nb);
@ -127,7 +128,7 @@ value_t fl_string_decode(value_t *args, u_int32_t nargs)
if (term) if (term)
newsz += sizeof(uint32_t); newsz += sizeof(uint32_t);
value_t wcstr = cvalue(wcstringtype, newsz); value_t wcstr = cvalue(wcstringtype, newsz);
ptr = cv_data((cvalue_t *)ptr(args[0])); // relocatable pointer ptr = cv_data((struct cvalue *)ptr(args[0])); // relocatable pointer
uint32_t *pwc = cvalue_data(wcstr); uint32_t *pwc = cvalue_data(wcstr);
u8_toucs(pwc, nc, ptr, nb); u8_toucs(pwc, nc, ptr, nb);
if (term) if (term)
@ -163,8 +164,8 @@ value_t fl_string_split(value_t *args, u_int32_t nargs)
argcount("string.split", nargs, 2); argcount("string.split", nargs, 2);
char *s = tostring(args[0], "string.split"); char *s = tostring(args[0], "string.split");
char *delim = tostring(args[1], "string.split"); char *delim = tostring(args[1], "string.split");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t dlen = cv_len((cvalue_t *)ptr(args[1])); size_t dlen = cv_len((struct cvalue *)ptr(args[1]));
size_t ssz, tokend = 0, tokstart = 0, i = 0; size_t ssz, tokend = 0, tokstart = 0, i = 0;
value_t first = FL_NIL, c = FL_NIL, last; value_t first = FL_NIL, c = FL_NIL, last;
size_t junk; size_t junk;
@ -182,11 +183,11 @@ value_t fl_string_split(value_t *args, u_int32_t nargs)
c = fl_cons(cvalue_string(ssz), FL_NIL); c = fl_cons(cvalue_string(ssz), FL_NIL);
// we've done allocation; reload movable pointers // we've done allocation; reload movable pointers
s = cv_data((cvalue_t *)ptr(args[0])); s = cv_data((struct cvalue *)ptr(args[0]));
delim = cv_data((cvalue_t *)ptr(args[1])); delim = cv_data((struct cvalue *)ptr(args[1]));
if (ssz) if (ssz)
memcpy(cv_data((cvalue_t *)ptr(car_(c))), &s[tokstart], ssz); memcpy(cv_data((struct cvalue *)ptr(car_(c))), &s[tokstart], ssz);
// link new cell // link new cell
if (last == FL_NIL) if (last == FL_NIL)
@ -207,7 +208,7 @@ value_t fl_string_sub(value_t *args, u_int32_t nargs)
if (nargs != 2) if (nargs != 2)
argcount("string.sub", nargs, 3); argcount("string.sub", nargs, 3);
char *s = tostring(args[0], "string.sub"); char *s = tostring(args[0], "string.sub");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t i1, i2; size_t i1, i2;
i1 = toulong(args[1], "string.sub"); i1 = toulong(args[1], "string.sub");
if (i1 > len) if (i1 > len)
@ -222,7 +223,7 @@ value_t fl_string_sub(value_t *args, u_int32_t nargs)
if (i2 <= i1) if (i2 <= i1)
return cvalue_string(0); return cvalue_string(0);
value_t ns = cvalue_string(i2 - i1); value_t ns = cvalue_string(i2 - i1);
memcpy(cv_data((cvalue_t *)ptr(ns)), &s[i1], i2 - i1); memcpy(cv_data((struct cvalue *)ptr(ns)), &s[i1], i2 - i1);
return ns; return ns;
} }
@ -230,7 +231,7 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
{ {
argcount("string.char", nargs, 2); argcount("string.char", nargs, 2);
char *s = tostring(args[0], "string.char"); char *s = tostring(args[0], "string.char");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t i = toulong(args[1], "string.char"); size_t i = toulong(args[1], "string.char");
if (i >= len) if (i >= len)
bounds_error("string.char", args[0], args[1]); bounds_error("string.char", args[0], args[1]);
@ -283,7 +284,7 @@ value_t fl_string_find(value_t *args, u_int32_t nargs)
else else
argcount("string.find", nargs, 2); argcount("string.find", nargs, 2);
char *s = tostring(args[0], "string.find"); char *s = tostring(args[0], "string.find");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
if (start > len) if (start > len)
bounds_error("string.find", args[0], args[2]); bounds_error("string.find", args[0], args[2]);
char *needle; char *needle;
@ -300,7 +301,7 @@ value_t fl_string_find(value_t *args, u_int32_t nargs)
} else if (iscprim(v) && cp_class(cp) == bytetype) { } else if (iscprim(v) && cp_class(cp) == bytetype) {
return mem_find_byte(s, *(char *)cp_data(cp), start, len); return mem_find_byte(s, *(char *)cp_data(cp), start, len);
} else if (fl_isstring(v)) { } else if (fl_isstring(v)) {
cvalue_t *cv = (cvalue_t *)ptr(v); struct cvalue *cv = (struct cvalue *)ptr(v);
needlesz = cv_len(cv); needlesz = cv_len(cv);
needle = (char *)cv_data(cv); needle = (char *)cv_data(cv);
} else { } else {
@ -327,7 +328,7 @@ value_t fl_string_inc(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 3) if (nargs < 2 || nargs > 3)
argcount("string.inc", nargs, 2); argcount("string.inc", nargs, 2);
char *s = tostring(args[0], "string.inc"); char *s = tostring(args[0], "string.inc");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t i = toulong(args[1], "string.inc"); size_t i = toulong(args[1], "string.inc");
size_t cnt = 1; size_t cnt = 1;
if (nargs == 3) if (nargs == 3)
@ -345,7 +346,7 @@ value_t fl_string_dec(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 3) if (nargs < 2 || nargs > 3)
argcount("string.dec", nargs, 2); argcount("string.dec", nargs, 2);
char *s = tostring(args[0], "string.dec"); char *s = tostring(args[0], "string.dec");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
size_t i = toulong(args[1], "string.dec"); size_t i = toulong(args[1], "string.dec");
size_t cnt = 1; size_t cnt = 1;
if (nargs == 3) if (nargs == 3)
@ -415,7 +416,7 @@ value_t fl_string_isutf8(value_t *args, u_int32_t nargs)
{ {
argcount("string.isutf8", nargs, 1); argcount("string.isutf8", nargs, 1);
char *s = tostring(args[0], "string.isutf8"); char *s = tostring(args[0], "string.isutf8");
size_t len = cv_len((cvalue_t *)ptr(args[0])); size_t len = cv_len((struct cvalue *)ptr(args[0]));
return u8_isvalid(s, len) ? FL_T : FL_F; return u8_isvalid(s, len) ? FL_T : FL_F;
} }

21
c/table.c
View File

@ -29,7 +29,7 @@ static struct fltype *tabletype;
void print_htable(value_t v, struct ios *f) void print_htable(value_t v, struct ios *f)
{ {
struct htable *h = (struct htable *)cv_data((cvalue_t *)ptr(v)); struct htable *h = (struct htable *)cv_data((struct cvalue *)ptr(v));
size_t i; size_t i;
int first = 1; int first = 1;
fl_print_str("#table(", f); fl_print_str("#table(", f);
@ -48,7 +48,7 @@ void print_htable(value_t v, struct ios *f)
void print_traverse_htable(value_t self) void print_traverse_htable(value_t self)
{ {
struct htable *h = (struct htable *)cv_data((cvalue_t *)ptr(self)); struct htable *h = (struct htable *)cv_data((struct cvalue *)ptr(self));
size_t i; size_t i;
for (i = 0; i < h->size; i += 2) { for (i = 0; i < h->size; i += 2) {
if (h->table[i + 1] != HT_NOTFOUND) { if (h->table[i + 1] != HT_NOTFOUND) {
@ -60,14 +60,15 @@ void print_traverse_htable(value_t self)
void free_htable(value_t self) void free_htable(value_t self)
{ {
struct htable *h = (struct htable *)cv_data((cvalue_t *)ptr(self)); struct htable *h = (struct htable *)cv_data((struct cvalue *)ptr(self));
htable_free(h); htable_free(h);
} }
void relocate_htable(value_t oldv, value_t newv) void relocate_htable(value_t oldv, value_t newv)
{ {
struct htable *oldh = (struct htable *)cv_data((cvalue_t *)ptr(oldv)); struct htable *oldh =
struct htable *h = (struct htable *)cv_data((cvalue_t *)ptr(newv)); (struct htable *)cv_data((struct cvalue *)ptr(oldv));
struct htable *h = (struct htable *)cv_data((struct cvalue *)ptr(newv));
if (oldh->table == &oldh->_space[0]) if (oldh->table == &oldh->_space[0])
h->table = &h->_space[0]; h->table = &h->_space[0];
size_t i; size_t i;
@ -82,7 +83,7 @@ struct cvtable table_vtable = { print_htable, relocate_htable, free_htable,
int ishashtable(value_t v) int ishashtable(value_t v)
{ {
return iscvalue(v) && cv_class((cvalue_t *)ptr(v)) == tabletype; return iscvalue(v) && cv_class((struct cvalue *)ptr(v)) == tabletype;
} }
value_t fl_tablep(value_t *args, uint32_t nargs) value_t fl_tablep(value_t *args, uint32_t nargs)
@ -95,7 +96,7 @@ static struct htable *totable(value_t v, char *fname)
{ {
if (!ishashtable(v)) if (!ishashtable(v))
type_error(fname, "table", v); type_error(fname, "table", v);
return (struct htable *)cv_data((cvalue_t *)ptr(v)); return (struct htable *)cv_data((struct cvalue *)ptr(v));
} }
value_t fl_table(value_t *args, uint32_t nargs) value_t fl_table(value_t *args, uint32_t nargs)
@ -112,7 +113,7 @@ value_t fl_table(value_t *args, uint32_t nargs)
} else { } else {
nt = cvalue(tabletype, 2 * sizeof(void *)); nt = cvalue(tabletype, 2 * sizeof(void *));
} }
struct htable *h = (struct htable *)cv_data((cvalue_t *)ptr(nt)); struct htable *h = (struct htable *)cv_data((struct cvalue *)ptr(nt));
htable_new(h, cnt / 2); htable_new(h, cnt / 2);
uint32_t i; uint32_t i;
value_t k = FL_NIL, arg = FL_NIL; value_t k = FL_NIL, arg = FL_NIL;
@ -135,7 +136,7 @@ value_t fl_table_put(value_t *args, uint32_t nargs)
equalhash_put(h, (void *)args[1], (void *)args[2]); equalhash_put(h, (void *)args[1], (void *)args[2]);
// register finalizer if we outgrew inline space // register finalizer if we outgrew inline space
if (table0 == &h->_space[0] && h->table != &h->_space[0]) { if (table0 == &h->_space[0] && h->table != &h->_space[0]) {
cvalue_t *cv = (cvalue_t *)ptr(args[0]); struct cvalue *cv = (struct cvalue *)ptr(args[0]);
add_finalizer(cv); add_finalizer(cv);
cv->len = 2 * sizeof(void *); cv->len = 2 * sizeof(void *);
} }
@ -195,7 +196,7 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs)
zero = zero =
fl_applyn(3, f, (value_t)table[i], (value_t)table[i + 1], zero); fl_applyn(3, f, (value_t)table[i], (value_t)table[i + 1], zero);
// reload pointer // reload pointer
h = (struct htable *)cv_data((cvalue_t *)ptr(t)); h = (struct htable *)cv_data((struct cvalue *)ptr(t));
if (h->size != n) if (h->size != n)
lerror(EnumerationError, "table.foldl: table modified"); lerror(EnumerationError, "table.foldl: table modified");
table = h->table; table = h->table;