ref: c1b99838564a31cba20b227c1f4a9ffa51d5c74e
parent: ec2a902acc1c05ed0a95c26249bbda4032c668e7
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Nov 17 23:08:54 EST 2024
for the sake of clang: Fl struct back to a tls pointer; rearrange and clean up
--- a/builtins.c
+++ b/builtins.c
@@ -38,9 +38,9 @@
break;
if(iscons(lst)){*pcdr = lst;
- c = (cons_t*)ptr(lst);
+ c = ptr(lst);
while(iscons(c->cdr))
- c = (cons_t*)ptr(c->cdr);
+ c = ptr(c->cdr);
pcdr = &c->cdr;
}else if(lst != FL(Nil))
type_error("cons", lst);@@ -106,7 +106,7 @@
return fixnum(n);
}
if(iscprim(a)){- cv = (cvalue_t*)ptr(a);
+ cv = ptr(a);
if(cp_class(cv) == FL(bytetype))
return fixnum(1);
if(cp_class(cv) == FL(runetype))
@@ -205,10 +205,10 @@
if(isfixnum(v))
return FL(t);
if(iscprim(v)){- numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
+ numerictype_t nt = cp_numtype(ptr(v));
if(nt < T_FLOAT)
return FL(t);
- void *data = cp_data((cprim_t*)ptr(v));
+ void *data = cp_data(ptr(v));
if(nt == T_FLOAT){float f = *(float*)data;
if(f < 0)
@@ -232,7 +232,7 @@
argcount(nargs, 1);
value_t v = args[0];
return (isfixnum(v) ||
- (iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ?
+ (iscprim(v) && cp_numtype(ptr(v)) < T_FLOAT)) ?
FL(t) : FL(f);
}
@@ -240,7 +240,7 @@
{argcount(nargs, 1);
value_t v = args[0];
- return (iscvalue(v) && cp_numtype((cprim_t*)ptr(v)) == T_MPINT) ?
+ return (iscvalue(v) && cp_numtype(ptr(v)) == T_MPINT) ?
FL(t) : FL(f);
}
@@ -264,7 +264,7 @@
if(isfixnum(args[0]))
return args[0];
if(iscprim(args[0])){- cprim_t *cp = (cprim_t*)ptr(args[0]);
+ cprim_t *cp = ptr(args[0]);
void *data = cp_data(cp);
numerictype_t nt = cp_numtype(cp);
double d;
@@ -318,7 +318,7 @@
if(isfixnum(a))
return (double)numval(a);
if(iscprim(a)){- cprim_t *cp = (cprim_t*)ptr(a);
+ cprim_t *cp = ptr(a);
numerictype_t nt = cp_numtype(cp);
return conv_to_double(cp_data(cp), nt);
}
--- a/cvalues.c
+++ b/cvalues.c
@@ -316,7 +316,7 @@
args = &FL(stack)[FL(sp)-1];
}
value_t cv = cvalue(FL(mpinttype), sizeof(mpint*));
- if(cvalue_mpint_init(FL(mpinttype), args[0], cv_data((cvalue_t*)ptr(cv))))
+ if(cvalue_mpint_init(FL(mpinttype), args[0], cvalue_data(cv)))
type_error("number", args[0]);return cv;
}
@@ -514,7 +514,7 @@
sz = elsize * cnt;
value_t cv = cvalue(type, sz);
- char *dest = cv_data(ptr(cv));
+ char *dest = cvalue_data(cv);
uint32_t i;
FOR_ARGS(i, 1, arg, args){cvalue_init(type->eltype, arg, dest);
@@ -539,7 +539,7 @@
sz = elsize * cnt;
value_t cv = cvalue(type, sz);
- char *dest = cv_data(ptr(cv));
+ char *dest = cvalue_data(cv);
a = 2;
for(i = 0; i < cnt; i++){cvalue_init(type->eltype, args[a], dest);
@@ -805,7 +805,7 @@
cnt = 0;
cv = cvalue(ft, elsz * cnt);
if(nargs == 2)
- cvalue_array_init(ft, args[1], cv_data(ptr(cv)));
+ cvalue_array_init(ft, args[1], cvalue_data(cv));
}else{cv = cvalue(ft, ft->size);
if(nargs == 2)
--- a/flisp.c
+++ b/flisp.c
@@ -24,7 +24,7 @@
builtin_t fptr;
}builtinspec_t;
-Fl fl;
+__thread Fl *fl;
int
isbuiltin(value_t x)
@@ -333,8 +333,11 @@
relocate(value_t v)
{value_t a, d, nc, first, *pcdr;
- uintptr_t t = tag(v);
+ if(isfixnum(v))
+ return v;
+
+ uintptr_t t = tag(v);
if(t == TAG_CONS){// iterative implementation allows arbitrarily long cons chains
pcdr = &first;
@@ -343,10 +346,10 @@
*pcdr = cdr_(v);
return first;
}
+ car_(v) = TAG_FWD;
+ d = cdr_(v);
*pcdr = nc = tagptr((cons_t*)FL(curheap), TAG_CONS);
FL(curheap) += sizeof(cons_t);
- d = cdr_(v);
- car_(v) = TAG_FWD;
cdr_(v) = nc;
car_(nc) = relocate(a);
pcdr = &cdr_(nc);
@@ -356,13 +359,23 @@
return first;
}
- if((t&3) == 0)
- return v;
if(!ismanaged(v))
return v;
if(isforwarded(v))
return forwardloc(v);
+ if(t == TAG_CPRIM){+ cprim_t *pcp = ptr(v);
+ size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
+ cprim_t *ncp = alloc_words(nw);
+ while(nw--)
+ ((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];
+ nc = tagptr(ncp, TAG_CPRIM);
+ forward(v, nc);
+ return nc;
+ }
+ if(t == TAG_CVALUE)
+ return cvalue_relocate(v);
if(t == TAG_VECTOR){// N.B.: 0-length vectors secretly have space for a first element
size_t i, sz = vector_size(v);
@@ -383,18 +396,6 @@
}
return nc;
}
- if(t == TAG_CPRIM){- cprim_t *pcp = ptr(v);
- size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
- cprim_t *ncp = alloc_words(nw);
- while(nw--)
- ((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];
- nc = tagptr(ncp, TAG_CPRIM);
- forward(v, nc);
- return nc;
- }
- if(t == TAG_CVALUE)
- return cvalue_relocate(v);
if(t == TAG_FUNCTION){function_t *fn = ptr(v);
function_t *nfn = alloc_words(4);
@@ -417,7 +418,7 @@
ng->isconst = 0;
nc = tagptr(ng, TAG_SYM);
forward(v, nc);
- if(ng->binding != UNBOUND)
+ if(__likely(ng->binding != UNBOUND))
ng->binding = relocate(ng->binding);
return nc;
}
@@ -424,12 +425,6 @@
return v;
}
-value_t
-relocate_lispvalue(value_t v)
-{- return relocate(v);
-}
-
static void
trace_globals(symbol_t *root)
{@@ -880,7 +875,7 @@
apply_cl_top:
captured = 0;
func = FL(stack)[FL(sp)-nargs-1];
- ip = cv_data((cvalue_t*)ptr(fn_bcode(func)));
+ ip = cvalue_data(fn_bcode(func));
assert(!ismanaged((uintptr_t)ip));
i = FL(sp)+GET_INT32(ip);
while(i >= FL(nstack))
@@ -1886,7 +1881,7 @@
uint32_t sz = FL(stack)[top-3]+1;
uint32_t bp = top-5-sz;
value_t func = FL(stack)[bp];
- const uint8_t *ip0 = cv_data((cvalue_t*)ptr(fn_bcode(func)));
+ const uint8_t *ip0 = cvalue_data(fn_bcode(func));
intptr_t ip = ip1 - ip0 - 1; /* -1: ip1 is *after* the one that was being executed */
value_t v = alloc_vector(sz+1, 0);
vector_elt(v, 0) = fixnum(ip);
@@ -2163,7 +2158,7 @@
{int i;
- memset(&fl, 0, sizeof(fl));
+ fl = calloc(1, sizeof(*fl));
FL(scr_width) = 80;
FL(heapsize) = initial_heapsize;
--- a/flisp.h
+++ b/flisp.h
@@ -271,8 +271,6 @@
void (*print_traverse)(value_t self);
} cvtable_t;
-value_t relocate_lispvalue(value_t v);
-
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
typedef struct _fltype_t {@@ -318,13 +316,13 @@
#define cv_isPOD(cv) (cv_class(cv)->init != nil)
#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
#define cvalue_len(v) cv_len((cvalue_t*)ptr(v))
-#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
+#define value2c(type, v) ((type)cvalue_data(v))
#define cp_class(cp) (((cprim_t*)(cp))->type)
#define cp_type(cp) (cp_class(cp)->type)
#define cp_numtype(cp) (cp_class(cp)->numtype)
#define cp_data(cp) (&((cprim_t*)(cp))->_space[0])
// WARNING: multiple evaluation!
-#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cv_data(ptr(v)))
+#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cvalue_data(v))
#define BUILTIN(lname, cname) \
value_t fn_builtin_##cname(value_t *args, uint32_t nargs)
@@ -340,21 +338,31 @@
struct Fl {value_t *stack;
uint32_t sp;
+ uint32_t heapsize;//bytes
+ uint8_t *fromspace;
uint32_t curr_frame;
- value_t Nil, t, f;
-
- value_t *gchandles[N_GC_HANDLES];
- uint32_t ngchandles;
uint32_t nstack;
- uint8_t *fromspace;
uint8_t *tospace;
uint8_t *curheap;
uint8_t *lim;
- uint32_t heapsize;//bytes
- uint32_t *consflags;
- size_t gccalls;
+ size_t malloc_pressure;
+
+ value_t Nil, t, f;
+ value_t eof, quote;
+ value_t lambda, trycatch;
+ value_t backquote, comma, commaat, commadot, function;
+
+ bool grew;
+
+ cvalue_t **finalizers;
+ size_t nfinalizers;
+ size_t maxfinalizers;
+
+ value_t *gchandles[N_GC_HANDLES];
+ uint32_t ngchandles;
+
fl_readstate_t *readstate;
symbol_t *symtab;
@@ -363,10 +371,6 @@
uint32_t throwing_frame; // active frame when exception was thrown
value_t lasterror;
- value_t eof, quote;
- value_t lambda, trycatch;
- value_t backquote, comma, commaat, commadot, function;
-
value_t printwidthsym, printreadablysym, printprettysym, printlengthsym;
value_t printlevelsym, builtins_table_sym;
value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
@@ -410,11 +414,6 @@
fltype_t *stringtype, *runestringtype;
fltype_t *builtintype;
- size_t malloc_pressure;
- cvalue_t **finalizers;
- size_t nfinalizers;
- size_t maxfinalizers;
-
uint32_t gensym_ctr;
// two static buffers for gensym printing so there can be two
// gensym names available at a time, mostly for compare()
@@ -422,11 +421,13 @@
int gsnameno;
bool exiting;
- bool grew;
value_t fsosym;
fltype_t *fsotype;
+ uint32_t *consflags;
+ size_t gccalls;
+
htable_t printconses;
uint32_t printlabel;
int print_pretty;
@@ -438,8 +439,8 @@
int hpos, vpos;
};
-extern Fl fl;
-#define FL(f) fl.f
+extern __thread Fl *fl;
+#define FL(f) fl->f
extern double D_PNAN, D_NNAN, D_PINF, D_NINF;
extern float F_PNAN, F_NNAN, F_PINF, F_NINF;
--- a/flmain.c
+++ b/flmain.c
@@ -38,7 +38,7 @@
randomize();
ios_init_stdstreams();
- fl_init(512*1024);
+ fl_init(2*1024*1024);
value_t f = cvalue(FL(iostreamtype), (int)sizeof(ios_t));
ios_t *s = value2c(ios_t*, f);
--- a/iostream.c
+++ b/iostream.c
@@ -248,10 +248,7 @@
n = ft->size;
}
value_t cv = cvalue(ft, n);
- uint8_t *data;
- if(iscvalue(cv))
- data = cv_data(ptr(cv));
- else data = cp_data(ptr(cv));
+ uint8_t *data = cptr(cv);
size_t got = ios_read(s, data, n);
if(got < n)
//lerrorf(FL(IOError), "end of input reached");
--- a/sixel.c
+++ b/sixel.c
@@ -224,8 +224,8 @@
static void
relocate_sixeloutput(value_t oldv, value_t newv)
{- fso_t *oldf = cv_data(ptr(oldv));
- fso_t *f = cv_data(ptr(newv));
+ fso_t *oldf = cvalue_data(oldv);
+ fso_t *f = cvalue_data(newv);
sixel_output_destroy(oldf->out);
SIXELSTATUS r = sixel_output_new(&f->out, fso_write, f, salloc);
if(SIXEL_FAILED(r))
--- a/string.c
+++ b/string.c
@@ -101,7 +101,7 @@
if(term)
newsz += sizeof(Rune);
value_t runestr = cvalue(FL(runestringtype), newsz);
- ptr = cv_data(ptr(args[0])); // relocatable pointer
+ ptr = cvalue_data(args[0]); // relocatable pointer
Rune *r = cvalue_data(runestr);
for(size_t i = 0; i < nb; i++)
ptr += chartorune(r+i, ptr);
@@ -158,11 +158,11 @@
c = fl_cons(cvalue_string(ssz), FL(Nil));
// we've done allocation; reload movable pointers
- s = cv_data(ptr(args[0]));
- delim = cv_data(ptr(args[1]));
+ s = cvalue_data(args[0]);
+ delim = cvalue_data(args[1]);
if(ssz)
- memmove(cv_data(ptr(car_(c))), &s[tokstart], ssz);
+ memmove(cvalue_data(car_(c)), &s[tokstart], ssz);
// link new cell
if(last == FL(Nil))
@@ -201,7 +201,7 @@
return symbol_value(FL(emptystringsym));
value_t ns = cvalue_string(endbytes-startbytes);
s = cvalue_data(args[0]); // reload after alloc
- memmove(cv_data(ptr(ns)), s+startbytes, endbytes-startbytes);
+ memmove(cvalue_data(ns), s+startbytes, endbytes-startbytes);
return ns;
}
--- a/table.c
+++ b/table.c
@@ -8,7 +8,7 @@
static void
print_htable(value_t v, ios_t *f)
{- htable_t *h = (htable_t*)cv_data(ptr(v));
+ htable_t *h = cvalue_data(v);
size_t i;
int first = 1;
fl_print_str("#table(", f);@@ -28,7 +28,7 @@
static void
print_traverse_htable(value_t self)
{- htable_t *h = (htable_t*)cv_data(ptr(self));
+ htable_t *h = cvalue_data(self);
size_t i;
for(i = 0; i < h->size; i += 2){ if(h->table[i+1] != HT_NOTFOUND){@@ -41,7 +41,7 @@
static void
free_htable(value_t self)
{- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
+ htable_t *h = cvalue_data(self);
htable_free(h);
}
@@ -48,14 +48,14 @@
static void
relocate_htable(value_t oldv, value_t newv)
{- htable_t *oldh = (htable_t*)cv_data(ptr(oldv));
- htable_t *h = (htable_t*)cv_data(ptr(newv));
+ htable_t *oldh = cvalue_data(oldv);
+ htable_t *h = cvalue_data(newv);
if(oldh->table == &oldh->_space[0])
h->table = &h->_space[0];
size_t i;
for(i = 0; i < h->size; i++){if(h->table[i] != HT_NOTFOUND)
- h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]);
+ h->table[i] = (void*)relocate((value_t)h->table[i]);
}
}
@@ -83,7 +83,7 @@
{if(!ishashtable(v))
type_error("table", v);- return (htable_t*)cv_data((cvalue_t*)ptr(v));
+ return cvalue_data(v);
}
BUILTIN("table", table)@@ -97,7 +97,7 @@
nt = cvalue_nofinalizer(FL(tabletype), sizeof(htable_t));
else
nt = cvalue(FL(tabletype), 2*sizeof(void*));
- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
+ htable_t *h = cvalue_data(nt);
htable_new(h, cnt/2);
size_t i;
value_t k = FL(Nil), arg;
@@ -184,7 +184,7 @@
if(table[i+1] != HT_NOTFOUND){zero = fl_applyn(3, f, (value_t)table[i], (value_t)table[i+1], zero);
// reload pointer
- h = (htable_t*)cv_data(ptr(t));
+ h = cvalue_data(t);
if(h->size != n)
lerrorf(FL(EnumerationError), "table modified");
table = h->table;