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

Run clang-format on all C code for the first time

This commit is contained in:
Lassi Kortela 2019-08-09 14:02:02 +03:00
parent 7ab81c9e56
commit 6a6a7071a9
47 changed files with 5888 additions and 4880 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
builtins.c
View File

@ -32,21 +32,21 @@ static value_t fl_nconc(value_t *args, u_int32_t nargs)
{ {
if (nargs == 0) if (nargs == 0)
return FL_NIL; return FL_NIL;
value_t lst, first=FL_NIL; value_t lst, first = FL_NIL;
value_t *pcdr = &first; value_t *pcdr = &first;
cons_t *c; cons_t *c;
uint32_t i=0; uint32_t i = 0;
while (1) { while (1) {
lst = args[i++]; lst = args[i++];
if (i >= nargs) break; if (i >= nargs)
break;
if (iscons(lst)) { if (iscons(lst)) {
*pcdr = lst; *pcdr = lst;
c = (cons_t*)ptr(lst); c = (cons_t *)ptr(lst);
while (iscons(c->cdr)) while (iscons(c->cdr))
c = (cons_t*)ptr(c->cdr); c = (cons_t *)ptr(c->cdr);
pcdr = &c->cdr; pcdr = &c->cdr;
} } else if (lst != FL_NIL) {
else if (lst != FL_NIL) {
type_error("nconc", "cons", lst); type_error("nconc", "cons", lst);
} }
} }
@ -74,7 +74,7 @@ static value_t fl_memq(value_t *args, u_int32_t nargs)
{ {
argcount("memq", nargs, 2); argcount("memq", nargs, 2);
while (iscons(args[1])) { while (iscons(args[1])) {
cons_t *c = (cons_t*)ptr(args[1]); cons_t *c = (cons_t *)ptr(args[1]);
if (c->car == args[0]) if (c->car == args[0])
return args[1]; return args[1];
args[1] = c->cdr; args[1] = c->cdr;
@ -89,23 +89,19 @@ static value_t fl_length(value_t *args, u_int32_t nargs)
cvalue_t *cv; cvalue_t *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 = (cvalue_t*)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(u8_charlen(*(uint32_t*)cp_data((cprim_t*)cv))); return fixnum(u8_charlen(*(uint32_t *)cp_data((cprim_t *)cv)));
} } else if (iscvalue(a)) {
else if (iscvalue(a)) { cv = (cvalue_t *)ptr(a);
cv = (cvalue_t*)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) {
return fixnum(0); return fixnum(0);
} } else if (iscons(a)) {
else if (iscons(a)) {
return fixnum(llength(a)); return fixnum(llength(a));
} }
type_error("length", "sequence", a); type_error("length", "sequence", a);
@ -136,8 +132,8 @@ static value_t fl_symbol(value_t *args, u_int32_t nargs)
static value_t fl_keywordp(value_t *args, u_int32_t nargs) static value_t fl_keywordp(value_t *args, u_int32_t nargs)
{ {
argcount("keyword?", nargs, 1); argcount("keyword?", nargs, 1);
return (issymbol(args[0]) && return (issymbol(args[0]) && iskeyword((symbol_t *)ptr(args[0]))) ? FL_T
iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F; : FL_F;
} }
static value_t fl_top_level_value(value_t *args, u_int32_t nargs) static value_t fl_top_level_value(value_t *args, u_int32_t nargs)
@ -162,7 +158,7 @@ static void global_env_list(symbol_t *root, value_t *pv)
{ {
while (root != NULL) { while (root != NULL) {
if (root->name[0] != ':' && (root->binding != UNBOUND)) { if (root->name[0] != ':' && (root->binding != UNBOUND)) {
*pv = fl_cons(tagptr(root,TAG_SYM), *pv); *pv = fl_cons(tagptr(root, TAG_SYM), *pv);
} }
global_env_list(root->left, pv); global_env_list(root->left, pv);
root = root->right; root = root->right;
@ -188,7 +184,7 @@ static value_t fl_constantp(value_t *args, u_int32_t nargs)
{ {
argcount("constant?", nargs, 1); argcount("constant?", nargs, 1);
if (issymbol(args[0])) if (issymbol(args[0]))
return (isconstant((symbol_t*)ptr(args[0])) ? FL_T : FL_F); return (isconstant((symbol_t *)ptr(args[0])) ? FL_T : FL_F);
if (iscons(args[0])) { if (iscons(args[0])) {
if (car_(args[0]) == QUOTE) if (car_(args[0]) == QUOTE)
return FL_T; return FL_T;
@ -203,22 +199,22 @@ static value_t fl_integer_valuedp(value_t *args, u_int32_t nargs)
value_t v = args[0]; value_t v = args[0];
if (isfixnum(v)) { if (isfixnum(v)) {
return FL_T; return FL_T;
} } else if (iscprim(v)) {
else if (iscprim(v)) { numerictype_t nt = cp_numtype((cprim_t *)ptr(v));
numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
if (nt < T_FLOAT) if (nt < T_FLOAT)
return FL_T; return FL_T;
void *data = cp_data((cprim_t*)ptr(v)); void *data = cp_data((cprim_t *)ptr(v));
if (nt == T_FLOAT) { if (nt == T_FLOAT) {
float f = *(float*)data; float f = *(float *)data;
if (f < 0) f = -f; if (f < 0)
f = -f;
if (f <= FLT_MAXINT && (float)(int32_t)f == f) if (f <= FLT_MAXINT && (float)(int32_t)f == f)
return FL_T; return FL_T;
} } else {
else {
assert(nt == T_DOUBLE); assert(nt == T_DOUBLE);
double d = *(double*)data; double d = *(double *)data;
if (d < 0) d = -d; if (d < 0)
d = -d;
if (d <= DBL_MAXINT && (double)(int64_t)d == d) if (d <= DBL_MAXINT && (double)(int64_t)d == d)
return FL_T; return FL_T;
} }
@ -231,8 +227,9 @@ static value_t fl_integerp(value_t *args, u_int32_t nargs)
argcount("integer?", nargs, 1); argcount("integer?", nargs, 1);
value_t v = args[0]; value_t v = args[0];
return (isfixnum(v) || return (isfixnum(v) ||
(iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ? (iscprim(v) && cp_numtype((cprim_t *)ptr(v)) < T_FLOAT))
FL_T : FL_F; ? FL_T
: FL_F;
} }
static value_t fl_fixnum(value_t *args, u_int32_t nargs) static value_t fl_fixnum(value_t *args, u_int32_t nargs)
@ -240,9 +237,8 @@ static value_t fl_fixnum(value_t *args, u_int32_t nargs)
argcount("fixnum", nargs, 1); argcount("fixnum", nargs, 1);
if (isfixnum(args[0])) { if (isfixnum(args[0])) {
return args[0]; return args[0];
} } else if (iscprim(args[0])) {
else if (iscprim(args[0])) { cprim_t *cp = (cprim_t *)ptr(args[0]);
cprim_t *cp = (cprim_t*)ptr(args[0]);
return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp))); return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
} }
type_error("fixnum", "number", args[0]); type_error("fixnum", "number", args[0]);
@ -254,14 +250,14 @@ static value_t fl_truncate(value_t *args, u_int32_t nargs)
if (isfixnum(args[0])) if (isfixnum(args[0]))
return args[0]; return args[0];
if (iscprim(args[0])) { if (iscprim(args[0])) {
cprim_t *cp = (cprim_t*)ptr(args[0]); cprim_t *cp = (cprim_t *)ptr(args[0]);
void *data = cp_data(cp); void *data = cp_data(cp);
numerictype_t nt = cp_numtype(cp); numerictype_t nt = cp_numtype(cp);
double d; double d;
if (nt == T_FLOAT) if (nt == T_FLOAT)
d = (double)*(float*)data; d = (double)*(float *)data;
else if (nt == T_DOUBLE) else if (nt == T_DOUBLE)
d = *(double*)data; d = *(double *)data;
else else
return args[0]; return args[0];
if (d > 0) { if (d > 0) {
@ -291,8 +287,8 @@ static value_t fl_vector_alloc(value_t *args, u_int32_t nargs)
else else
f = FL_UNSPECIFIED; f = FL_UNSPECIFIED;
int k; int k;
for(k=0; k < i; k++) for (k = 0; k < i; k++)
vector_elt(v,k) = f; vector_elt(v, k) = f;
return v; return v;
} }
@ -308,7 +304,7 @@ static double todouble(value_t a, char *fname)
if (isfixnum(a)) if (isfixnum(a))
return (double)numval(a); return (double)numval(a);
if (iscprim(a)) { if (iscprim(a)) {
cprim_t *cp = (cprim_t*)ptr(a); cprim_t *cp = (cprim_t *)ptr(a);
numerictype_t nt = cp_numtype(cp); numerictype_t nt = cp_numtype(cp);
return conv_to_double(cp_data(cp), nt); return conv_to_double(cp_data(cp), nt);
} }
@ -368,7 +364,8 @@ static value_t fl_os_getenv(value_t *args, uint32_t nargs)
argcount("os.getenv", nargs, 1); argcount("os.getenv", nargs, 1);
char *name = tostring(args[0], "os.getenv"); char *name = tostring(args[0], "os.getenv");
char *val = getenv(name); char *val = getenv(name);
if (val == NULL) return FL_F; if (val == NULL)
return FL_F;
if (*val == 0) if (*val == 0)
return symbol_value(emptystringsym); return symbol_value(emptystringsym);
return cvalue_static_cstring(val); return cvalue_static_cstring(val);
@ -386,8 +383,7 @@ static value_t fl_os_setenv(value_t *args, uint32_t nargs)
(void)unsetenv(name); (void)unsetenv(name);
result = 0; result = 0;
#endif #endif
} } else {
else {
char *val = tostring(args[1], "os.setenv"); char *val = tostring(args[1], "os.setenv");
result = setenv(name, val, 1); result = setenv(name, val, 1);
} }
@ -398,10 +394,11 @@ static value_t fl_os_setenv(value_t *args, uint32_t nargs)
static value_t fl_rand(value_t *args, u_int32_t nargs) static value_t fl_rand(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)nargs; (void)args;
(void)nargs;
fixnum_t r; fixnum_t r;
#ifdef BITS64 #ifdef BITS64
r = ((((uint64_t)random())<<32) | random()) & 0x1fffffffffffffffLL; r = ((((uint64_t)random()) << 32) | random()) & 0x1fffffffffffffffLL;
#else #else
r = random() & 0x1fffffff; r = random() & 0x1fffffff;
#endif #endif
@ -409,7 +406,8 @@ static value_t fl_rand(value_t *args, u_int32_t nargs)
} }
static value_t fl_rand32(value_t *args, u_int32_t nargs) static value_t fl_rand32(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)nargs; (void)args;
(void)nargs;
uint32_t r = random(); uint32_t r = random();
#ifdef BITS64 #ifdef BITS64
return fixnum(r); return fixnum(r);
@ -419,33 +417,36 @@ static value_t fl_rand32(value_t *args, u_int32_t nargs)
} }
static value_t fl_rand64(value_t *args, u_int32_t nargs) static value_t fl_rand64(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)nargs; (void)args;
uint64_t r = (((uint64_t)random())<<32) | random(); (void)nargs;
uint64_t r = (((uint64_t)random()) << 32) | random();
return mk_uint64(r); return mk_uint64(r);
} }
static value_t fl_randd(value_t *args, u_int32_t nargs) static value_t fl_randd(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)nargs; (void)args;
(void)nargs;
return mk_double(rand_double()); return mk_double(rand_double());
} }
static value_t fl_randf(value_t *args, u_int32_t nargs) static value_t fl_randf(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)nargs; (void)args;
(void)nargs;
return mk_float(rand_float()); return mk_float(rand_float());
} }
#define MATH_FUNC_1ARG(name) \ #define MATH_FUNC_1ARG(name) \
static value_t fl_##name(value_t *args, u_int32_t nargs) \ static value_t fl_##name(value_t *args, u_int32_t nargs) \
{ \ { \
argcount(#name, nargs, 1); \ argcount(#name, nargs, 1); \
if (iscprim(args[0])) { \ if (iscprim(args[0])) { \
cprim_t *cp = (cprim_t*)ptr(args[0]); \ cprim_t *cp = (cprim_t *)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \ numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \ if (nt == T_FLOAT) \
return mk_float(name##f(*(float*)cp_data(cp))); \ return mk_float(name##f(*(float *)cp_data(cp))); \
} \ } \
return mk_double(name(todouble(args[0], #name))); \ return mk_double(name(todouble(args[0], #name))); \
} }
MATH_FUNC_1ARG(sqrt) MATH_FUNC_1ARG(sqrt)
MATH_FUNC_1ARG(exp) MATH_FUNC_1ARG(exp)
@ -494,11 +495,11 @@ static builtinspec_t builtin_info[] = {
{ "rand.float", fl_randf }, { "rand.float", fl_randf },
{ "sqrt", fl_sqrt }, { "sqrt", fl_sqrt },
{ "exp", fl_exp }, { "exp", fl_exp },
{ "log", fl_log }, { "log", fl_log },
{ "sin", fl_sin }, { "sin", fl_sin },
{ "cos", fl_cos }, { "cos", fl_cos },
{ "tan", fl_tan }, { "tan", fl_tan },
{ "asin", fl_asin }, { "asin", fl_asin },
{ "acos", fl_acos }, { "acos", fl_acos },
{ "atan", fl_atan }, { "atan", fl_atan },

878
cvalues.c
View File

File diff suppressed because it is too large Load Diff

225
equal.c
View File

@ -1,12 +1,12 @@
#define BOUNDED_COMPARE_BOUND 128 #define BOUNDED_COMPARE_BOUND 128
#define BOUNDED_HASH_BOUND 16384 #define BOUNDED_HASH_BOUND 16384
// comparable tag // comparable tag
#define cmptag(v) (isfixnum(v) ? TAG_NUM : tag(v)) #define cmptag(v) (isfixnum(v) ? TAG_NUM : tag(v))
static value_t eq_class(htable_t *table, value_t key) static value_t eq_class(htable_t *table, value_t key)
{ {
value_t c = (value_t)ptrhash_get(table, (void*)key); value_t c = (value_t)ptrhash_get(table, (void *)key);
if (c == (value_t)HT_NOTFOUND) if (c == (value_t)HT_NOTFOUND)
return NIL; return NIL;
if (c == key) if (c == key)
@ -14,14 +14,14 @@ static value_t eq_class(htable_t *table, value_t key)
return eq_class(table, c); return eq_class(table, c);
} }
static void eq_union(htable_t *table, value_t a, value_t b, static void eq_union(htable_t *table, value_t a, value_t b, value_t c,
value_t c, value_t cb) value_t cb)
{ {
value_t ca = (c==NIL ? a : c); value_t ca = (c == NIL ? a : c);
if (cb != NIL) if (cb != NIL)
ptrhash_put(table, (void*)cb, (void*)ca); ptrhash_put(table, (void *)cb, (void *)ca);
ptrhash_put(table, (void*)a, (void*)ca); ptrhash_put(table, (void *)a, (void *)ca);
ptrhash_put(table, (void*)b, (void*)ca); ptrhash_put(table, (void *)b, (void *)ca);
} }
static value_t bounded_compare(value_t a, value_t b, int bound, int eq); static value_t bounded_compare(value_t a, value_t b, int bound, int eq);
@ -32,15 +32,19 @@ static value_t bounded_vector_compare(value_t a, value_t b, int bound, int eq)
size_t la = vector_size(a); size_t la = vector_size(a);
size_t lb = vector_size(b); size_t lb = vector_size(b);
size_t m, i; size_t m, i;
if (eq && (la!=lb)) return fixnum(1); if (eq && (la != lb))
return fixnum(1);
m = la < lb ? la : lb; m = la < lb ? la : lb;
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
value_t d = bounded_compare(vector_elt(a,i), vector_elt(b,i), value_t d =
bound-1, eq); bounded_compare(vector_elt(a, i), vector_elt(b, i), bound - 1, eq);
if (d==NIL || numval(d)!=0) return d; if (d == NIL || numval(d) != 0)
return d;
} }
if (la < lb) return fixnum(-1); if (la < lb)
if (la > lb) return fixnum(1); return fixnum(-1);
if (la > lb)
return fixnum(1);
return fixnum(0); return fixnum(0);
} }
@ -50,40 +54,43 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
{ {
value_t d; value_t d;
compare_top: compare_top:
if (a == b) return fixnum(0); if (a == b)
return fixnum(0);
if (bound <= 0) if (bound <= 0)
return NIL; return NIL;
int taga = tag(a); int taga = tag(a);
int tagb = cmptag(b); int tagb = cmptag(b);
int c; int c;
switch (taga) { switch (taga) {
case TAG_NUM : case TAG_NUM:
case TAG_NUM1: case TAG_NUM1:
if (isfixnum(b)) { if (isfixnum(b)) {
return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1); return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
} }
if (iscprim(b)) { if (iscprim(b)) {
if (cp_class((cprim_t*)ptr(b)) == wchartype) if (cp_class((cprim_t *)ptr(b)) == wchartype)
return fixnum(1); return fixnum(1);
return fixnum(numeric_compare(a, b, eq, 1, NULL)); return fixnum(numeric_compare(a, b, eq, 1, NULL));
} }
return fixnum(-1); return fixnum(-1);
case TAG_SYM: case TAG_SYM:
if (eq) return fixnum(1); if (eq)
if (tagb < TAG_SYM) return fixnum(1); return fixnum(1);
if (tagb > TAG_SYM) return fixnum(-1); if (tagb < TAG_SYM)
return fixnum(1);
if (tagb > TAG_SYM)
return fixnum(-1);
return fixnum(strcmp(symbol_name(a), symbol_name(b))); return fixnum(strcmp(symbol_name(a), symbol_name(b)));
case TAG_VECTOR: case TAG_VECTOR:
if (isvector(b)) if (isvector(b))
return bounded_vector_compare(a, b, bound, eq); return bounded_vector_compare(a, b, bound, eq);
break; break;
case TAG_CPRIM: case TAG_CPRIM:
if (cp_class((cprim_t*)ptr(a)) == wchartype) { if (cp_class((cprim_t *)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype) if (!iscprim(b) || cp_class((cprim_t *)ptr(b)) != wchartype)
return fixnum(-1); return fixnum(-1);
} } else if (iscprim(b) && cp_class((cprim_t *)ptr(b)) == wchartype) {
else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) {
return fixnum(1); return fixnum(1);
} }
c = numeric_compare(a, b, eq, 1, NULL); c = numeric_compare(a, b, eq, 1, NULL);
@ -92,7 +99,7 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
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((cvalue_t *)ptr(a)) && cv_isPOD((cvalue_t *)ptr(b)))
return cvalue_compare(a, b); return cvalue_compare(a, b);
return fixnum(1); return fixnum(1);
} }
@ -100,24 +107,30 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
case TAG_FUNCTION: case TAG_FUNCTION:
if (tagb == TAG_FUNCTION) { if (tagb == TAG_FUNCTION) {
if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) { if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) {
function_t *fa = (function_t*)ptr(a); function_t *fa = (function_t *)ptr(a);
function_t *fb = (function_t*)ptr(b); function_t *fb = (function_t *)ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq); d = bounded_compare(fa->bcode, fb->bcode, bound - 1, eq);
if (d==NIL || numval(d) != 0) return d; if (d == NIL || numval(d) != 0)
d = bounded_compare(fa->vals, fb->vals, bound-1, eq); return d;
if (d==NIL || numval(d) != 0) return d; d = bounded_compare(fa->vals, fb->vals, bound - 1, eq);
d = bounded_compare(fa->env, fb->env, bound-1, eq); if (d == NIL || numval(d) != 0)
if (d==NIL || numval(d) != 0) return d; return d;
d = bounded_compare(fa->env, fb->env, bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
return fixnum(0); return fixnum(0);
} }
return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1); return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1);
} }
break; break;
case TAG_CONS: case TAG_CONS:
if (tagb < TAG_CONS) return fixnum(1); if (tagb < TAG_CONS)
d = bounded_compare(car_(a), car_(b), bound-1, eq); return fixnum(1);
if (d==NIL || numval(d) != 0) return d; d = bounded_compare(car_(a), car_(b), bound - 1, eq);
a = cdr_(a); b = cdr_(b); if (d == NIL || numval(d) != 0)
return d;
a = cdr_(a);
b = cdr_(b);
bound--; bound--;
goto compare_top; goto compare_top;
} }
@ -133,107 +146,113 @@ static value_t cyc_vector_compare(value_t a, value_t b, htable_t *table,
value_t d, xa, xb, ca, cb; value_t d, xa, xb, ca, cb;
// first try to prove them different with no recursion // first try to prove them different with no recursion
if (eq && (la!=lb)) return fixnum(1); if (eq && (la != lb))
return fixnum(1);
m = la < lb ? la : lb; m = la < lb ? la : lb;
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
xa = vector_elt(a,i); xa = vector_elt(a, i);
xb = vector_elt(b,i); xb = vector_elt(b, i);
if (leafp(xa) || leafp(xb)) { if (leafp(xa) || leafp(xb)) {
d = bounded_compare(xa, xb, 1, eq); d = bounded_compare(xa, xb, 1, eq);
if (d!=NIL && numval(d)!=0) return d; if (d != NIL && numval(d) != 0)
} return d;
else if (tag(xa) < tag(xb)) { } else if (tag(xa) < tag(xb)) {
return fixnum(-1); return fixnum(-1);
} } else if (tag(xa) > tag(xb)) {
else if (tag(xa) > tag(xb)) {
return fixnum(1); return fixnum(1);
} }
} }
ca = eq_class(table, a); ca = eq_class(table, a);
cb = eq_class(table, b); cb = eq_class(table, b);
if (ca!=NIL && ca==cb) if (ca != NIL && ca == cb)
return fixnum(0); return fixnum(0);
eq_union(table, a, b, ca, cb); eq_union(table, a, b, ca, cb);
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
xa = vector_elt(a,i); xa = vector_elt(a, i);
xb = vector_elt(b,i); xb = vector_elt(b, i);
if (!leafp(xa) || tag(xa)==TAG_FUNCTION) { if (!leafp(xa) || tag(xa) == TAG_FUNCTION) {
d = cyc_compare(xa, xb, table, eq); d = cyc_compare(xa, xb, table, eq);
if (numval(d)!=0) if (numval(d) != 0)
return d; return d;
} }
} }
if (la < lb) return fixnum(-1); if (la < lb)
if (la > lb) return fixnum(1); return fixnum(-1);
if (la > lb)
return fixnum(1);
return fixnum(0); return fixnum(0);
} }
static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq) static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq)
{ {
value_t d, ca, cb; value_t d, ca, cb;
cyc_compare_top: cyc_compare_top:
if (a==b) if (a == b)
return fixnum(0); return fixnum(0);
if (iscons(a)) { if (iscons(a)) {
if (iscons(b)) { if (iscons(b)) {
value_t aa = car_(a); value_t da = cdr_(a); value_t aa = car_(a);
value_t ab = car_(b); value_t db = cdr_(b); value_t da = cdr_(a);
int tagaa = tag(aa); int tagda = tag(da); value_t ab = car_(b);
int tagab = tag(ab); int tagdb = tag(db); value_t db = cdr_(b);
int tagaa = tag(aa);
int tagda = tag(da);
int tagab = tag(ab);
int tagdb = tag(db);
if (leafp(aa) || leafp(ab)) { if (leafp(aa) || leafp(ab)) {
d = bounded_compare(aa, ab, 1, eq); d = bounded_compare(aa, ab, 1, eq);
if (d!=NIL && numval(d)!=0) return d; if (d != NIL && numval(d) != 0)
} return d;
else if (tagaa < tagab) } else if (tagaa < tagab)
return fixnum(-1); return fixnum(-1);
else if (tagaa > tagab) else if (tagaa > tagab)
return fixnum(1); return fixnum(1);
if (leafp(da) || leafp(db)) { if (leafp(da) || leafp(db)) {
d = bounded_compare(da, db, 1, eq); d = bounded_compare(da, db, 1, eq);
if (d!=NIL && numval(d)!=0) return d; if (d != NIL && numval(d) != 0)
} return d;
else if (tagda < tagdb) } else if (tagda < tagdb)
return fixnum(-1); return fixnum(-1);
else if (tagda > tagdb) else if (tagda > tagdb)
return fixnum(1); return fixnum(1);
ca = eq_class(table, a); ca = eq_class(table, a);
cb = eq_class(table, b); cb = eq_class(table, b);
if (ca!=NIL && ca==cb) if (ca != NIL && ca == cb)
return fixnum(0); return fixnum(0);
eq_union(table, a, b, ca, cb); eq_union(table, a, b, ca, cb);
d = cyc_compare(aa, ab, table, eq); d = cyc_compare(aa, ab, table, eq);
if (numval(d)!=0) return d; if (numval(d) != 0)
return d;
a = da; a = da;
b = db; b = db;
goto cyc_compare_top; goto cyc_compare_top;
} } else {
else {
return fixnum(1); return fixnum(1);
} }
} } else if (isvector(a) && isvector(b)) {
else if (isvector(a) && isvector(b)) {
return cyc_vector_compare(a, b, table, eq); return cyc_vector_compare(a, b, table, eq);
} } else if (isclosure(a) && isclosure(b)) {
else if (isclosure(a) && isclosure(b)) { function_t *fa = (function_t *)ptr(a);
function_t *fa = (function_t*)ptr(a); function_t *fb = (function_t *)ptr(b);
function_t *fb = (function_t*)ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, 1, eq); d = bounded_compare(fa->bcode, fb->bcode, 1, eq);
if (numval(d) != 0) return d; if (numval(d) != 0)
return d;
ca = eq_class(table, a); ca = eq_class(table, a);
cb = eq_class(table, b); cb = eq_class(table, b);
if (ca!=NIL && ca==cb) if (ca != NIL && ca == cb)
return fixnum(0); return fixnum(0);
eq_union(table, a, b, ca, cb); eq_union(table, a, b, ca, cb);
d = cyc_compare(fa->vals, fb->vals, table, eq); d = cyc_compare(fa->vals, fb->vals, table, eq);
if (numval(d) != 0) return d; if (numval(d) != 0)
return d;
a = fa->env; a = fa->env;
b = fb->env; b = fb->env;
goto cyc_compare_top; goto cyc_compare_top;
@ -242,10 +261,7 @@ static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq)
} }
static htable_t equal_eq_hashtable; static htable_t equal_eq_hashtable;
void comparehash_init(void) void comparehash_init(void) { htable_new(&equal_eq_hashtable, 512); }
{
htable_new(&equal_eq_hashtable, 512);
}
// 'eq' means unordered comparison is sufficient // 'eq' means unordered comparison is sufficient
static value_t compare_(value_t a, value_t b, int eq) static value_t compare_(value_t a, value_t b, int eq)
@ -258,16 +274,13 @@ static value_t compare_(value_t a, value_t b, int eq)
return guess; return guess;
} }
value_t fl_compare(value_t a, value_t b) value_t fl_compare(value_t a, value_t b) { return compare_(a, b, 0); }
{
return compare_(a, b, 0);
}
value_t fl_equal(value_t a, value_t b) value_t fl_equal(value_t a, value_t b)
{ {
if (eq_comparable(a, b)) if (eq_comparable(a, b))
return (a == b) ? FL_T : FL_F; return (a == b) ? FL_T : FL_F;
return (numval(compare_(a,b,1))==0 ? FL_T : FL_F); return (numval(compare_(a, b, 1)) == 0 ? FL_T : FL_F);
} }
/* /*
@ -282,7 +295,7 @@ value_t fl_equal(value_t a, value_t b)
#define MIX(a, b) int64hash((int64_t)(a) ^ (int64_t)(b)); #define MIX(a, b) int64hash((int64_t)(a) ^ (int64_t)(b));
#define doublehash(a) int64hash(a) #define doublehash(a) int64hash(a)
#else #else
#define MIX(a, b) int64to32hash(((int64_t)(a))<<32 | ((int64_t)(b))) #define MIX(a, b) int64to32hash(((int64_t)(a)) << 32 | ((int64_t)(b)))
#define doublehash(a) int64to32hash(a) #define doublehash(a) int64to32hash(a)
#endif #endif
@ -301,27 +314,27 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
void *data; void *data;
uptrint_t h = 0; uptrint_t h = 0;
int oob2, tg = tag(a); int oob2, tg = tag(a);
switch(tg) { switch (tg) {
case TAG_NUM : case TAG_NUM:
case TAG_NUM1: case TAG_NUM1:
u.d = (double)numval(a); u.d = (double)numval(a);
return doublehash(u.i64); return doublehash(u.i64);
case TAG_FUNCTION: case TAG_FUNCTION:
if (uintval(a) > N_BUILTINS) if (uintval(a) > N_BUILTINS)
return bounded_hash(((function_t*)ptr(a))->bcode, bound, oob); return bounded_hash(((function_t *)ptr(a))->bcode, bound, oob);
return inthash(a); return inthash(a);
case TAG_SYM: case TAG_SYM:
return ((symbol_t*)ptr(a))->hash; return ((symbol_t *)ptr(a))->hash;
case TAG_CPRIM: case TAG_CPRIM:
cp = (cprim_t*)ptr(a); cp = (cprim_t *)ptr(a);
data = cp_data(cp); data = cp_data(cp);
if (cp_class(cp) == wchartype) if (cp_class(cp) == wchartype)
return inthash(*(int32_t*)data); return inthash(*(int32_t *)data);
nt = cp_numtype(cp); nt = cp_numtype(cp);
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 = (cvalue_t *)ptr(a);
data = cv_data(cv); data = cv_data(cv);
return memhash(data, cv_len(cv)); return memhash(data, cv_len(cv));
@ -331,10 +344,10 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
return 1; return 1;
} }
len = vector_size(a); len = vector_size(a);
for(i=0; i < len; i++) { for (i = 0; i < len; i++) {
h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1); h = MIX(h, bounded_hash(vector_elt(a, i), bound / 2, &oob2) ^ 1);
if (oob2) if (oob2)
bound/=2; bound /= 2;
*oob = *oob || oob2; *oob = *oob || oob2;
} }
return h; return h;
@ -345,11 +358,11 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
*oob = 1; *oob = 1;
return h; return h;
} }
h = MIX(h, bounded_hash(car_(a), bound/2, &oob2)); h = MIX(h, bounded_hash(car_(a), bound / 2, &oob2));
// bounds balancing: try to share the bounds efficiently // bounds balancing: try to share the bounds efficiently
// so we can hash better when a list is cdr-deep (a common case) // so we can hash better when a list is cdr-deep (a common case)
if (oob2) if (oob2)
bound/=2; bound /= 2;
else else
bound--; bound--;
// recursive OOB propagation. otherwise this case is slow: // recursive OOB propagation. otherwise this case is slow:
@ -357,7 +370,7 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
*oob = *oob || oob2; *oob = *oob || oob2;
a = cdr_(a); a = cdr_(a);
} while (iscons(a)); } while (iscons(a));
h = MIX(h, bounded_hash(a, bound-1, &oob2)^2); h = MIX(h, bounded_hash(a, bound - 1, &oob2) ^ 2);
*oob = *oob || oob2; *oob = *oob || oob2;
return h; return h;
} }
@ -367,13 +380,13 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
int equal_lispvalue(value_t a, value_t b) int equal_lispvalue(value_t a, value_t b)
{ {
if (eq_comparable(a, b)) if (eq_comparable(a, b))
return (a==b); return (a == b);
return (numval(compare_(a,b,1))==0); return (numval(compare_(a, b, 1)) == 0);
} }
uptrint_t hash_lispvalue(value_t a) uptrint_t hash_lispvalue(value_t a)
{ {
int oob=0; int oob = 0;
uptrint_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob); uptrint_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
return n; return n;
} }

2
equalhash.c
View File

@ -11,6 +11,6 @@
#include "htable.inc" #include "htable.inc"
#define _equal_lispvalue_(x,y) equal_lispvalue((value_t)(x),(value_t)(y)) #define _equal_lispvalue_(x, y) equal_lispvalue((value_t)(x), (value_t)(y))
HTIMPL(equalhash, hash_lispvalue, _equal_lispvalue_) HTIMPL(equalhash, hash_lispvalue, _equal_lispvalue_)

1873
flisp.c
View File

File diff suppressed because it is too large Load Diff

247
flisp.h
View File

@ -19,96 +19,104 @@ typedef struct {
typedef struct _symbol_t { typedef struct _symbol_t {
uptrint_t flags; uptrint_t flags;
value_t binding; // global value binding value_t binding; // global value binding
struct _fltype_t *type; struct _fltype_t *type;
uint32_t hash; uint32_t hash;
void *dlcache; // dlsym address void *dlcache; // dlsym address
// below fields are private // below fields are private
struct _symbol_t *left; struct _symbol_t *left;
struct _symbol_t *right; struct _symbol_t *right;
union { union {
char name[1]; char name[1];
void *_pad; // ensure field aligned to pointer size void *_pad; // ensure field aligned to pointer size
}; };
} symbol_t; } symbol_t;
typedef struct { typedef struct {
value_t isconst; value_t isconst;
value_t binding; // global value binding value_t binding; // global value binding
struct _fltype_t *type; struct _fltype_t *type;
uint32_t id; uint32_t id;
} gensym_t; } gensym_t;
#define TAG_NUM 0x0 #define TAG_NUM 0x0
#define TAG_CPRIM 0x1 #define TAG_CPRIM 0x1
#define TAG_FUNCTION 0x2 #define TAG_FUNCTION 0x2
#define TAG_VECTOR 0x3 #define TAG_VECTOR 0x3
#define TAG_NUM1 0x4 #define TAG_NUM1 0x4
#define TAG_CVALUE 0x5 #define TAG_CVALUE 0x5
#define TAG_SYM 0x6 #define TAG_SYM 0x6
#define TAG_CONS 0x7 #define TAG_CONS 0x7
#define UNBOUND ((value_t)0x1) // an invalid value #define UNBOUND ((value_t)0x1) // an invalid value
#define TAG_FWD UNBOUND #define TAG_FWD UNBOUND
#define tag(x) ((x)&0x7) #define tag(x) ((x)&0x7)
#define ptr(x) ((void*)((x)&(~(value_t)0x7))) #define ptr(x) ((void *)((x) & (~(value_t)0x7)))
#define tagptr(p,t) (((value_t)(p)) | (t)) #define tagptr(p, t) (((value_t)(p)) | (t))
#define fixnum(x) ((value_t)(((fixnum_t)(x))<<2)) #define fixnum(x) ((value_t)(((fixnum_t)(x)) << 2))
#define numval(x) (((fixnum_t)(x))>>2) #define numval(x) (((fixnum_t)(x)) >> 2)
#ifdef BITS64 #ifdef BITS64
#define fits_fixnum(x) (((x)>>61) == 0 || (~((x)>>61)) == 0) #define fits_fixnum(x) (((x) >> 61) == 0 || (~((x) >> 61)) == 0)
#else #else
#define fits_fixnum(x) (((x)>>29) == 0 || (~((x)>>29)) == 0) #define fits_fixnum(x) (((x) >> 29) == 0 || (~((x) >> 29)) == 0)
#endif #endif
#define fits_bits(x,b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0) #define fits_bits(x, b) (((x) >> (b - 1)) == 0 || (~((x) >> (b - 1))) == 0)
#define uintval(x) (((unsigned int)(x))>>3) #define uintval(x) (((unsigned int)(x)) >> 3)
#define builtin(n) tagptr((((int)n)<<3), TAG_FUNCTION) #define builtin(n) tagptr((((int)n) << 3), TAG_FUNCTION)
#define iscons(x) (tag(x) == TAG_CONS) #define iscons(x) (tag(x) == TAG_CONS)
#define issymbol(x) (tag(x) == TAG_SYM) #define issymbol(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (((x)&3) == TAG_NUM) #define isfixnum(x) (((x)&3) == TAG_NUM)
#define bothfixnums(x,y) ((((x)|(y))&3) == TAG_NUM) #define bothfixnums(x, y) ((((x) | (y)) & 3) == TAG_NUM)
#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET) #define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET)
#define isvector(x) (tag(x) == TAG_VECTOR) #define isvector(x) (tag(x) == TAG_VECTOR)
#define iscvalue(x) (tag(x) == TAG_CVALUE) #define iscvalue(x) (tag(x) == TAG_CVALUE)
#define iscprim(x) (tag(x) == TAG_CPRIM) #define iscprim(x) (tag(x) == TAG_CPRIM)
#define selfevaluating(x) (tag(x)<6) #define selfevaluating(x) (tag(x) < 6)
// comparable with == // comparable with ==
#define eq_comparable(a,b) (!(((a)|(b))&1)) #define eq_comparable(a, b) (!(((a) | (b)) & 1))
#define eq_comparablep(a) (!((a)&1)) #define eq_comparablep(a) (!((a)&1))
// doesn't lead to other values // doesn't lead to other values
#define leafp(a) (((a)&3) != 3) #define leafp(a) (((a)&3) != 3)
#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD) #define isforwarded(v) (((value_t *)ptr(v))[0] == TAG_FWD)
#define forwardloc(v) (((value_t*)ptr(v))[1]) #define forwardloc(v) (((value_t *)ptr(v))[1])
#define forward(v,to) do { (((value_t*)ptr(v))[0] = TAG_FWD); \ #define forward(v, to) \
(((value_t*)ptr(v))[1] = to); } while (0) do { \
(((value_t *)ptr(v))[0] = TAG_FWD); \
(((value_t *)ptr(v))[1] = to); \
} while (0)
#define vector_size(v) (((size_t*)ptr(v))[0]>>2) #define vector_size(v) (((size_t *)ptr(v))[0] >> 2)
#define vector_setsize(v,n) (((size_t*)ptr(v))[0] = ((n)<<2)) #define vector_setsize(v, n) (((size_t *)ptr(v))[0] = ((n) << 2))
#define vector_elt(v,i) (((value_t*)ptr(v))[1+(i)]) #define vector_elt(v, i) (((value_t *)ptr(v))[1 + (i)])
#define vector_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3)) #define vector_grow_amt(x) ((x) < 8 ? 5 : 6 * ((x) >> 3))
// functions ending in _ are unsafe, faster versions // functions ending in _ are unsafe, faster versions
#define car_(v) (((cons_t*)ptr(v))->car) #define car_(v) (((cons_t *)ptr(v))->car)
#define cdr_(v) (((cons_t*)ptr(v))->cdr) #define cdr_(v) (((cons_t *)ptr(v))->cdr)
#define car(v) (tocons((v),"car")->car) #define car(v) (tocons((v), "car")->car)
#define cdr(v) (tocons((v),"cdr")->cdr) #define cdr(v) (tocons((v), "cdr")->cdr)
#define fn_bcode(f) (((value_t*)ptr(f))[0]) #define fn_bcode(f) (((value_t *)ptr(f))[0])
#define fn_vals(f) (((value_t*)ptr(f))[1]) #define fn_vals(f) (((value_t *)ptr(f))[1])
#define fn_env(f) (((value_t*)ptr(f))[2]) #define fn_env(f) (((value_t *)ptr(f))[2])
#define fn_name(f) (((value_t*)ptr(f))[3]) #define fn_name(f) (((value_t *)ptr(f))[3])
#define set(s, v) (((symbol_t*)ptr(s))->binding = (v)) #define set(s, v) (((symbol_t *)ptr(s))->binding = (v))
#define setc(s, v) do { ((symbol_t*)ptr(s))->flags |= 1; \ #define setc(s, v) \
((symbol_t*)ptr(s))->binding = (v); } while (0) do { \
#define isconstant(s) ((s)->flags&0x1) ((symbol_t *)ptr(s))->flags |= 1; \
#define iskeyword(s) ((s)->flags&0x2) ((symbol_t *)ptr(s))->binding = (v); \
#define symbol_value(s) (((symbol_t*)ptr(s))->binding) } while (0)
#define ismanaged(v) ((((unsigned char*)ptr(v)) >= fromspace) && \ #define isconstant(s) ((s)->flags & 0x1)
(((unsigned char*)ptr(v)) < fromspace+heapsize)) #define iskeyword(s) ((s)->flags & 0x2)
#define isgensym(x) (issymbol(x) && ismanaged(x)) #define symbol_value(s) (((symbol_t *)ptr(s))->binding)
#define ismanaged(v) \
((((unsigned char *)ptr(v)) >= fromspace) && \
(((unsigned char *)ptr(v)) < fromspace + heapsize))
#define isgensym(x) (issymbol(x) && ismanaged(x))
#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) (iscvalue(x) && (cv_class((cvalue_t*)ptr(x))==builtintype)) #define iscbuiltin(x) \
(iscvalue(x) && (cv_class((cvalue_t *)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);
@ -118,8 +126,8 @@ void fl_free_gc_handles(uint32_t n);
// utility for iterating over all arguments in a builtin // utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array // i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count // assumes "nargs" is the argument count
#define FOR_ARGS(i, i0, arg, args) \ #define FOR_ARGS(i, i0, arg, args) \
for(i=i0; ((size_t)i)<nargs && ((arg=args[i]) || 1); i++) for (i = i0; ((size_t)i) < nargs && ((arg = args[i]) || 1); i++)
#define N_BUILTINS ((int)N_OPCODES) #define N_BUILTINS ((int)N_OPCODES)
@ -178,29 +186,33 @@ extern fl_exception_context_t *fl_ctx;
extern uint32_t fl_throwing_frame; extern uint32_t fl_throwing_frame;
extern value_t fl_lasterror; extern value_t fl_lasterror;
#define FL_TRY_EXTERN \ #define FL_TRY_EXTERN \
fl_exception_context_t _ctx; int l__tr, l__ca; \ fl_exception_context_t _ctx; \
fl_savestate(&_ctx); fl_ctx = &_ctx; \ int l__tr, l__ca; \
if (!setjmp(_ctx.buf)) \ fl_savestate(&_ctx); \
for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx=fl_ctx->prev)) fl_ctx = &_ctx; \
if (!setjmp(_ctx.buf)) \
for (l__tr = 1; l__tr; l__tr = 0, (void)(fl_ctx = fl_ctx->prev))
#define FL_CATCH_EXTERN \ #define FL_CATCH_EXTERN \
else \ else for (l__ca = 1; l__ca; l__ca = 0, fl_restorestate(&_ctx))
for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
void lerrorf(value_t e, char *format, ...) __attribute__ ((__noreturn__)); void lerrorf(value_t e, char *format, ...) __attribute__((__noreturn__));
void lerror(value_t e, const char *msg) __attribute__ ((__noreturn__)); void lerror(value_t e, const char *msg) __attribute__((__noreturn__));
void fl_savestate(fl_exception_context_t *_ctx); void fl_savestate(fl_exception_context_t *_ctx);
void fl_restorestate(fl_exception_context_t *_ctx); void fl_restorestate(fl_exception_context_t *_ctx);
void fl_raise(value_t e) __attribute__ ((__noreturn__)); void fl_raise(value_t e) __attribute__((__noreturn__));
void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__)); void type_error(char *fname, char *expected, value_t got)
void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__)); __attribute__((__noreturn__));
void bounds_error(char *fname, value_t arr, value_t ind)
__attribute__((__noreturn__));
extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError; extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
extern value_t UnboundError; extern value_t UnboundError;
static inline void argcount(char *fname, uint32_t nargs, uint32_t c) static inline void argcount(char *fname, uint32_t nargs, uint32_t c)
{ {
if (__unlikely(nargs != c)) if (__unlikely(nargs != c))
lerrorf(ArgError,"%s: too %s arguments", fname, nargs<c ? "few":"many"); lerrorf(ArgError, "%s: too %s arguments", fname,
nargs < c ? "few" : "many");
} }
typedef struct { typedef struct {
@ -211,17 +223,27 @@ typedef struct {
} cvtable_t; } cvtable_t;
/* functions needed to implement the value interface (cvtable_t) */ /* functions needed to implement the value interface (cvtable_t) */
typedef enum { T_INT8, T_UINT8, T_INT16, T_UINT16, T_INT32, T_UINT32, typedef enum {
T_INT64, T_UINT64, T_FLOAT, T_DOUBLE } numerictype_t; T_INT8,
T_UINT8,
T_INT16,
T_UINT16,
T_INT32,
T_UINT32,
T_INT64,
T_UINT64,
T_FLOAT,
T_DOUBLE
} numerictype_t;
#define N_NUMTYPES ((int)T_DOUBLE+1) #define N_NUMTYPES ((int)T_DOUBLE + 1)
#ifdef BITS64 #ifdef BITS64
# define T_LONG T_INT64 #define T_LONG T_INT64
# define T_ULONG T_UINT64 #define T_ULONG T_UINT64
#else #else
# define T_LONG T_INT32 #define T_LONG T_INT32
# define T_ULONG T_UINT32 #define T_ULONG T_UINT32
#endif #endif
value_t relocate_lispvalue(value_t v); value_t relocate_lispvalue(value_t v);
@ -230,7 +252,7 @@ void fl_print_chr(char c, ios_t *f);
void fl_print_str(char *s, ios_t *f); void fl_print_str(char *s, ios_t *f);
void fl_print_child(ios_t *f, value_t v); void fl_print_child(ios_t *f, value_t v);
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*); typedef int (*cvinitfunc_t)(struct _fltype_t *, value_t, void *);
typedef struct _fltype_t { typedef struct _fltype_t {
value_t type; value_t type;
@ -247,10 +269,10 @@ typedef struct _fltype_t {
typedef struct { typedef struct {
fltype_t *type; fltype_t *type;
void *data; void *data;
size_t len; // length of *data in bytes size_t len; // length of *data in bytes
union { union {
value_t parent; // optional value_t parent; // optional
char _space[1]; // variable size char _space[1]; // variable size
}; };
} cvalue_t; } cvalue_t;
@ -271,57 +293,58 @@ typedef struct {
#define CPRIM_NWORDS 2 #define CPRIM_NWORDS 2
#define MAX_INL_SIZE 384 #define MAX_INL_SIZE 384
#define CV_OWNED_BIT 0x1 #define CV_OWNED_BIT 0x1
#define CV_PARENT_BIT 0x2 #define CV_PARENT_BIT 0x2
#define owned(cv) ((uptrint_t)(cv)->type & CV_OWNED_BIT) #define owned(cv) ((uptrint_t)(cv)->type & CV_OWNED_BIT)
#define hasparent(cv) ((uptrint_t)(cv)->type & CV_PARENT_BIT) #define hasparent(cv) ((uptrint_t)(cv)->type & CV_PARENT_BIT)
#define isinlined(cv) ((cv)->data == &(cv)->_space[0]) #define isinlined(cv) ((cv)->data == &(cv)->_space[0])
#define cv_class(cv) ((fltype_t*)(((uptrint_t)(cv)->type)&~3)) #define cv_class(cv) ((fltype_t *)(((uptrint_t)(cv)->type) & ~3))
#define cv_len(cv) ((cv)->len) #define cv_len(cv) ((cv)->len)
#define cv_type(cv) (cv_class(cv)->type) #define cv_type(cv) (cv_class(cv)->type)
#define cv_data(cv) ((cv)->data) #define cv_data(cv) ((cv)->data)
#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((cvalue_t *)ptr(v))
#define cvalue_len(v) cv_len((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)cv_data((cvalue_t *)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)
#define cp_type(cp) (cp_class(cp)->type) #define cp_type(cp) (cp_class(cp)->type)
#define cp_numtype(cp) (cp_class(cp)->numtype) #define cp_numtype(cp) (cp_class(cp)->numtype)
#define cp_data(cp) (&(cp)->_space[0]) #define cp_data(cp) (&(cp)->_space[0])
// WARNING: multiple evaluation! // WARNING: multiple evaluation!
#define cptr(v) \ #define cptr(v) \
(iscprim(v) ? cp_data((cprim_t*)ptr(v)) : cv_data((cvalue_t*)ptr(v))) (iscprim(v) ? cp_data((cprim_t *)ptr(v)) : cv_data((cvalue_t *)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;
typedef uint8_t fl_uint8_t; typedef uint8_t fl_uint8_t;
typedef int16_t fl_int16_t; typedef int16_t fl_int16_t;
typedef uint16_t fl_uint16_t; typedef uint16_t fl_uint16_t;
typedef int32_t fl_int32_t; typedef int32_t fl_int32_t;
typedef uint32_t fl_uint32_t; typedef uint32_t fl_uint32_t;
typedef int64_t fl_int64_t; typedef int64_t fl_int64_t;
typedef uint64_t fl_uint64_t; typedef uint64_t fl_uint64_t;
typedef char fl_char_t; typedef char fl_char_t;
typedef char char_t; typedef char char_t;
typedef long fl_long_t; typedef long fl_long_t;
typedef long long_t; typedef long long_t;
typedef unsigned long fl_ulong_t; typedef unsigned long fl_ulong_t;
typedef unsigned long ulong_t; typedef unsigned long ulong_t;
typedef double fl_double_t; typedef double fl_double_t;
typedef float fl_float_t; typedef float fl_float_t;
typedef value_t (*builtin_t)(value_t*, uint32_t); typedef value_t (*builtin_t)(value_t *, uint32_t);
extern value_t QUOTE; extern value_t QUOTE;
extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym; extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
extern value_t int64sym, uint64sym; extern value_t int64sym, uint64sym;
extern value_t longsym, ulongsym, bytesym, wcharsym; extern value_t longsym, ulongsym, bytesym, wcharsym;
extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym; extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym,
pointersym;
extern value_t stringtypesym, wcstringtypesym, emptystringsym; extern value_t stringtypesym, wcstringtypesym, emptystringsym;
extern value_t unionsym, floatsym, doublesym; extern value_t unionsym, floatsym, doublesym;
extern fltype_t *bytetype, *wchartype; extern fltype_t *bytetype, *wchartype;

12
flmain.c
View File

@ -7,10 +7,10 @@
static value_t argv_list(int argc, char *argv[]) static value_t argv_list(int argc, char *argv[])
{ {
int i; int i;
value_t lst=FL_NIL, temp; value_t lst = FL_NIL, temp;
fl_gc_handle(&lst); fl_gc_handle(&lst);
fl_gc_handle(&temp); fl_gc_handle(&temp);
for(i=argc-1; i >= 0; i--) { for (i = argc - 1; i >= 0; i--) {
temp = cvalue_static_cstring(argv[i]); temp = cvalue_static_cstring(argv[i]);
lst = fl_cons(temp, lst); lst = fl_cons(temp, lst);
} }
@ -24,7 +24,7 @@ int main(int argc, char *argv[])
{ {
char fname_buf[1024]; char fname_buf[1024];
fl_init(512*1024); fl_init(512 * 1024);
fname_buf[0] = '\0'; fname_buf[0] = '\0';
#ifdef INITFILE #ifdef INITFILE
@ -42,7 +42,8 @@ int main(int argc, char *argv[])
value_t args[2]; value_t args[2];
fl_gc_handle(&args[0]); fl_gc_handle(&args[0]);
fl_gc_handle(&args[1]); fl_gc_handle(&args[1]);
FL_TRY_EXTERN { FL_TRY_EXTERN
{
args[0] = cvalue_static_cstring(fname_buf); args[0] = cvalue_static_cstring(fname_buf);
args[1] = symbol(":read"); args[1] = symbol(":read");
value_t f = fl_file(&args[0], 2); value_t f = fl_file(&args[0], 2);
@ -54,7 +55,8 @@ int main(int argc, char *argv[])
(void)fl_applyn(1, symbol_value(symbol("__start")), (void)fl_applyn(1, symbol_value(symbol("__start")),
argv_list(argc, argv)); argv_list(argc, argv));
} }
FL_CATCH_EXTERN { FL_CATCH_EXTERN
{
ios_puts("fatal error:\n", ios_stderr); ios_puts("fatal error:\n", ios_stderr);
fl_print(ios_stderr, fl_lasterror); fl_print(ios_stderr, fl_lasterror);
ios_putc('\n', ios_stderr); ios_putc('\n', ios_stderr);

138
iostream.c
View File

@ -20,14 +20,14 @@ void print_iostream(value_t v, ios_t *f)
void free_iostream(value_t self) void free_iostream(value_t self)
{ {
ios_t *s = value2c(ios_t*, self); ios_t *s = value2c(ios_t *, self);
ios_close(s); ios_close(s);
} }
void relocate_iostream(value_t oldv, value_t newv) void relocate_iostream(value_t oldv, value_t newv)
{ {
ios_t *olds = value2c(ios_t*, oldv); ios_t *olds = value2c(ios_t *, oldv);
ios_t *news = value2c(ios_t*, newv); ios_t *news = value2c(ios_t *, newv);
if (news->buf == &olds->local[0]) { if (news->buf == &olds->local[0]) {
news->buf = &news->local[0]; news->buf = &news->local[0];
} }
@ -38,7 +38,7 @@ cvtable_t 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((cvalue_t *)ptr(v)) == iostreamtype;
} }
value_t fl_iostreamp(value_t *args, uint32_t nargs) value_t fl_iostreamp(value_t *args, uint32_t nargs)
@ -64,33 +64,40 @@ static ios_t *toiostream(value_t v, char *fname)
{ {
if (!fl_isiostream(v)) if (!fl_isiostream(v))
type_error(fname, "iostream", v); type_error(fname, "iostream", v);
return value2c(ios_t*, v); return value2c(ios_t *, v);
} }
ios_t *fl_toiostream(value_t v, char *fname) ios_t *fl_toiostream(value_t v, char *fname) { return toiostream(v, fname); }
{
return toiostream(v, fname);
}
value_t fl_file(value_t *args, uint32_t nargs) value_t fl_file(value_t *args, uint32_t nargs)
{ {
if (nargs < 1) if (nargs < 1)
argcount("file", nargs, 1); argcount("file", nargs, 1);
int i, r=0, w=0, c=0, t=0, a=0; int i, r = 0, w = 0, c = 0, t = 0, a = 0;
for(i=1; i < (int)nargs; i++) { for (i = 1; i < (int)nargs; i++) {
if (args[i] == wrsym) w = 1; if (args[i] == wrsym)
else if (args[i] == apsym) { a = 1; w = 1; } w = 1;
else if (args[i] == crsym) { c = 1; w = 1; } else if (args[i] == apsym) {
else if (args[i] == truncsym) { t = 1; w = 1; } a = 1;
else if (args[i] == rdsym) r = 1; w = 1;
} else if (args[i] == crsym) {
c = 1;
w = 1;
} else if (args[i] == truncsym) {
t = 1;
w = 1;
} else if (args[i] == rdsym)
r = 1;
} }
if ((r|w|c|t|a) == 0) r = 1; // default to reading if ((r | w | c | t | a) == 0)
r = 1; // default to reading
value_t f = cvalue(iostreamtype, sizeof(ios_t)); value_t f = cvalue(iostreamtype, sizeof(ios_t));
char *fname = tostring(args[0], "file"); char *fname = tostring(args[0], "file");
ios_t *s = value2c(ios_t*, f); ios_t *s = value2c(ios_t *, f);
if (ios_file(s, fname, r, w, c, t) == NULL) if (ios_file(s, fname, r, w, c, t) == NULL)
lerrorf(IOError, "file: could not open \"%s\"", fname); lerrorf(IOError, "file: could not open \"%s\"", fname);
if (a) ios_seek_end(s); if (a)
ios_seek_end(s);
return f; return f;
} }
@ -99,7 +106,7 @@ value_t fl_buffer(value_t *args, u_int32_t nargs)
argcount("buffer", nargs, 0); argcount("buffer", nargs, 0);
(void)args; (void)args;
value_t f = cvalue(iostreamtype, sizeof(ios_t)); value_t f = cvalue(iostreamtype, sizeof(ios_t));
ios_t *s = value2c(ios_t*, f); ios_t *s = value2c(ios_t *, f);
if (ios_mem(s, 0) == NULL) if (ios_mem(s, 0) == NULL)
lerror(MemoryError, "buffer: could not allocate stream"); lerror(MemoryError, "buffer: could not allocate stream");
return f; return f;
@ -110,18 +117,16 @@ value_t fl_read(value_t *args, u_int32_t nargs)
value_t arg = 0; value_t arg = 0;
if (nargs > 1) { if (nargs > 1) {
argcount("read", nargs, 1); argcount("read", nargs, 1);
} } else if (nargs == 0) {
else if (nargs == 0) {
arg = symbol_value(instrsym); arg = symbol_value(instrsym);
} } else {
else {
arg = args[0]; arg = args[0];
} }
(void)toiostream(arg, "read"); (void)toiostream(arg, "read");
fl_gc_handle(&arg); fl_gc_handle(&arg);
value_t v = fl_read_sexpr(arg); value_t v = fl_read_sexpr(arg);
fl_free_gc_handles(1); fl_free_gc_handles(1);
if (ios_eof(value2c(ios_t*,arg))) if (ios_eof(value2c(ios_t *, arg)))
return FL_EOF; return FL_EOF;
return v; return v;
} }
@ -132,7 +137,7 @@ value_t fl_iogetc(value_t *args, u_int32_t nargs)
ios_t *s = toiostream(args[0], "io.getc"); ios_t *s = toiostream(args[0], "io.getc");
uint32_t wc; uint32_t wc;
if (ios_getutf8(s, &wc) == IOS_EOF) if (ios_getutf8(s, &wc) == IOS_EOF)
//lerror(IOError, "io.getc: end of file reached"); // lerror(IOError, "io.getc: end of file reached");
return FL_EOF; return FL_EOF;
return mk_wchar(wc); return mk_wchar(wc);
} }
@ -151,9 +156,9 @@ value_t fl_ioputc(value_t *args, u_int32_t nargs)
{ {
argcount("io.putc", nargs, 2); argcount("io.putc", nargs, 2);
ios_t *s = toiostream(args[0], "io.putc"); ios_t *s = toiostream(args[0], "io.putc");
if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype) if (!iscprim(args[1]) || ((cprim_t *)ptr(args[1]))->type != wchartype)
type_error("io.putc", "wchar", args[1]); type_error("io.putc", "wchar", args[1]);
uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1])); uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
return fixnum(ios_pututf8(s, wc)); return fixnum(ios_pututf8(s, wc));
} }
@ -161,13 +166,13 @@ value_t fl_ioungetc(value_t *args, u_int32_t nargs)
{ {
argcount("io.ungetc", nargs, 2); argcount("io.ungetc", nargs, 2);
ios_t *s = toiostream(args[0], "io.ungetc"); ios_t *s = toiostream(args[0], "io.ungetc");
if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype) if (!iscprim(args[1]) || ((cprim_t *)ptr(args[1]))->type != wchartype)
type_error("io.ungetc", "wchar", args[1]); type_error("io.ungetc", "wchar", args[1]);
uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1])); uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
if (wc >= 0x80) { if (wc >= 0x80) {
lerror(ArgError, "io_ungetc: unicode not yet supported"); lerror(ArgError, "io_ungetc: unicode not yet supported");
} }
return fixnum(ios_ungetc((int)wc,s)); return fixnum(ios_ungetc((int)wc, s));
} }
value_t fl_ioflush(value_t *args, u_int32_t nargs) value_t fl_ioflush(value_t *args, u_int32_t nargs)
@ -247,8 +252,7 @@ value_t fl_ioread(value_t *args, u_int32_t nargs)
// form (io.read s type count) // form (io.read s type count)
ft = get_array_type(args[1]); ft = get_array_type(args[1]);
n = toulong(args[2], "io.read") * ft->elsz; n = toulong(args[2], "io.read") * ft->elsz;
} } else {
else {
ft = get_type(args[1]); ft = get_type(args[1]);
if (ft->eltype != NULL && !iscons(cdr_(cdr_(args[1])))) if (ft->eltype != NULL && !iscons(cdr_(cdr_(args[1]))))
lerror(ArgError, "io.read: incomplete type"); lerror(ArgError, "io.read: incomplete type");
@ -256,11 +260,13 @@ 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)) data = cv_data((cvalue_t*)ptr(cv)); if (iscvalue(cv))
else data = cp_data((cprim_t*)ptr(cv)); data = cv_data((cvalue_t *)ptr(cv));
size_t got = ios_read(value2c(ios_t*,args[0]), data, n); else
data = cp_data((cprim_t *)ptr(cv));
size_t got = ios_read(value2c(ios_t *, args[0]), data, n);
if (got < n) if (got < n)
//lerror(IOError, "io.read: end of input reached"); // lerror(IOError, "io.read: end of input reached");
return FL_EOF; return FL_EOF;
return cv; return cv;
} }
@ -285,19 +291,19 @@ value_t fl_iowrite(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 4) if (nargs < 2 || nargs > 4)
argcount("io.write", nargs, 2); argcount("io.write", nargs, 2);
ios_t *s = toiostream(args[0], "io.write"); ios_t *s = toiostream(args[0], "io.write");
if (iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype) { if (iscprim(args[1]) && ((cprim_t *)ptr(args[1]))->type == wchartype) {
if (nargs > 2) if (nargs > 2)
lerror(ArgError, lerror(ArgError,
"io.write: offset argument not supported for characters"); "io.write: offset argument not supported for characters");
uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1])); uint32_t wc = *(uint32_t *)cp_data((cprim_t *)ptr(args[1]));
return fixnum(ios_pututf8(s, wc)); return fixnum(ios_pututf8(s, wc));
} }
char *data; char *data;
size_t sz, offs=0; size_t sz, offs = 0;
to_sized_ptr(args[1], "io.write", &data, &sz); to_sized_ptr(args[1], "io.write", &data, &sz);
size_t nb = sz; size_t nb = sz;
if (nargs > 2) { if (nargs > 2) {
get_start_count_args(&args[1], nargs-1, sz, &offs, &nb, "io.write"); get_start_count_args(&args[1], nargs - 1, sz, &offs, &nb, "io.write");
data += offs; data += offs;
} }
return size_wrap(ios_write(s, data, nb)); return size_wrap(ios_write(s, data, nb));
@ -309,7 +315,7 @@ value_t fl_dump(value_t *args, u_int32_t nargs)
argcount("dump", nargs, 1); argcount("dump", nargs, 1);
ios_t *s = toiostream(symbol_value(outstrsym), "dump"); ios_t *s = toiostream(symbol_value(outstrsym), "dump");
char *data; char *data;
size_t sz, offs=0; size_t sz, offs = 0;
to_sized_ptr(args[0], "dump", &data, &sz); to_sized_ptr(args[0], "dump", &data, &sz);
size_t nb = sz; size_t nb = sz;
if (nargs > 1) { if (nargs > 1) {
@ -325,7 +331,7 @@ static char get_delim_arg(value_t arg, char *fname)
size_t uldelim = toulong(arg, fname); size_t uldelim = toulong(arg, fname);
if (uldelim > 0x7f) { if (uldelim > 0x7f) {
// wchars > 0x7f, or anything else > 0xff, are out of range // wchars > 0x7f, or anything else > 0xff, are out of range
if ((iscprim(arg) && cp_class((cprim_t*)ptr(arg))==wchartype) || if ((iscprim(arg) && cp_class((cprim_t *)ptr(arg)) == wchartype) ||
uldelim > 0xff) uldelim > 0xff)
lerrorf(ArgError, "%s: delimiter out of range", fname); lerrorf(ArgError, "%s: delimiter out of range", fname);
} }
@ -336,7 +342,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); cvalue_t *cv = (cvalue_t *)ptr(str);
char *data = cv_data(cv); char *data = cv_data(cv);
ios_t dest; ios_t dest;
ios_mem(&dest, 0); ios_mem(&dest, 0);
@ -352,7 +358,7 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
cv_autorelease(cv); cv_autorelease(cv);
#endif #endif
} }
((char*)cv->data)[n] = '\0'; ((char *)cv->data)[n] = '\0';
if (n == 0 && ios_eof(src)) if (n == 0 && ios_eof(src))
return FL_EOF; return FL_EOF;
return str; return str;
@ -384,19 +390,19 @@ value_t stream_to_string(value_t *ps)
{ {
value_t str; value_t str;
size_t n; size_t n;
ios_t *st = value2c(ios_t*,*ps); ios_t *st = value2c(ios_t *, *ps);
if (st->buf == &st->local[0]) { if (st->buf == &st->local[0]) {
n = st->size; n = st->size;
str = cvalue_string(n); str = cvalue_string(n);
memcpy(cvalue_data(str), value2c(ios_t*,*ps)->buf, n); memcpy(cvalue_data(str), value2c(ios_t *, *ps)->buf, n);
ios_trunc(value2c(ios_t*,*ps), 0); ios_trunc(value2c(ios_t *, *ps), 0);
} } else {
else { char *b = ios_takebuf(st, &n);
char *b = ios_takebuf(st, &n); n--; n--;
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((cvalue_t *)ptr(str));
#endif #endif
} }
return str; return str;
@ -422,13 +428,13 @@ static builtinspec_t iostreamfunc_info[] = {
{ "write", fl_write }, { "write", fl_write },
{ "io.flush", fl_ioflush }, { "io.flush", fl_ioflush },
{ "io.close", fl_ioclose }, { "io.close", fl_ioclose },
{ "io.eof?" , fl_ioeof }, { "io.eof?", fl_ioeof },
{ "io.seek" , fl_ioseek }, { "io.seek", fl_ioseek },
{ "io.pos", fl_iopos }, { "io.pos", fl_iopos },
{ "io.getc" , fl_iogetc }, { "io.getc", fl_iogetc },
{ "io.ungetc", fl_ioungetc }, { "io.ungetc", fl_ioungetc },
{ "io.putc" , fl_ioputc }, { "io.putc", fl_ioputc },
{ "io.peekc" , fl_iopeekc }, { "io.peekc", fl_iopeekc },
{ "io.discardbuffer", fl_iopurge }, { "io.discardbuffer", fl_iopurge },
{ "io.read", fl_ioread }, { "io.read", fl_ioread },
{ "io.write", fl_iowrite }, { "io.write", fl_iowrite },
@ -450,14 +456,14 @@ void iostream_init(void)
truncsym = symbol(":truncate"); truncsym = symbol(":truncate");
instrsym = symbol("*input-stream*"); instrsym = symbol("*input-stream*");
outstrsym = symbol("*output-stream*"); outstrsym = symbol("*output-stream*");
iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t), iostreamtype =
&iostream_vtable, NULL); define_opaque_type(iostreamsym, sizeof(ios_t), &iostream_vtable, NULL);
assign_global_builtins(iostreamfunc_info); assign_global_builtins(iostreamfunc_info);
setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout, setc(symbol("*stdout*"),
sizeof(ios_t), FL_NIL)); cvalue_from_ref(iostreamtype, ios_stdout, sizeof(ios_t), FL_NIL));
setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr, setc(symbol("*stderr*"),
sizeof(ios_t), FL_NIL)); cvalue_from_ref(iostreamtype, ios_stderr, sizeof(ios_t), FL_NIL));
setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin, setc(symbol("*stdin*"),
sizeof(ios_t), FL_NIL)); cvalue_from_ref(iostreamtype, ios_stdin, sizeof(ios_t), FL_NIL));
} }

492
llt/bitvector-ops.c
View File

@ -20,12 +20,15 @@ u_int32_t bitreverse(u_int32_t x)
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
x = _bswap(x); x = _bswap(x);
#else #else
x = (x >> 16) | (x << 16); m = 0xff00ff00; x = (x >> 16) | (x << 16);
m = 0xff00ff00;
x = ((x & m) >> 8) | ((x & ~m) << 8); x = ((x & m) >> 8) | ((x & ~m) << 8);
#endif #endif
m = 0xf0f0f0f0; m = 0xf0f0f0f0;
x = ((x & m) >> 4) | ((x & ~m) << 4); m = 0xcccccccc; x = ((x & m) >> 4) | ((x & ~m) << 4);
x = ((x & m) >> 2) | ((x & ~m) << 2); m = 0xaaaaaaaa; m = 0xcccccccc;
x = ((x & m) >> 2) | ((x & ~m) << 2);
m = 0xaaaaaaaa;
x = ((x & m) >> 1) | ((x & ~m) << 1); x = ((x & m) >> 1) | ((x & ~m) << 1);
return x; return x;
@ -38,18 +41,19 @@ u_int32_t bitreverse(u_int32_t x)
void bitvector_shr(u_int32_t *b, size_t n, u_int32_t s) void bitvector_shr(u_int32_t *b, size_t n, u_int32_t s)
{ {
u_int32_t i; u_int32_t i;
if (s == 0 || n == 0) return; if (s == 0 || n == 0)
i = (s>>5); return;
i = (s >> 5);
if (i) { if (i) {
n -= i; n -= i;
memmove(b, &b[i], n*4); memmove(b, &b[i], n * 4);
memset(&b[n], 0, i*4); memset(&b[n], 0, i * 4);
s &= 31; s &= 31;
} }
for(i=0; i < n-1; i++) { for (i = 0; i < n - 1; i++) {
b[i] = (b[i]>>s) | (b[i+1]<<(32-s)); b[i] = (b[i] >> s) | (b[i + 1] << (32 - s));
} }
b[i]>>=s; b[i] >>= s;
} }
// out-of-place version, good for re-aligning a strided submatrix to // out-of-place version, good for re-aligning a strided submatrix to
@ -59,39 +63,41 @@ void bitvector_shr(u_int32_t *b, size_t n, u_int32_t s)
void bitvector_shr_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s) void bitvector_shr_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s)
{ {
u_int32_t i, j; u_int32_t i, j;
if (n == 0) return; if (n == 0)
return;
if (s == 0) { if (s == 0) {
memcpy(dest, b, n*4); memcpy(dest, b, n * 4);
return; return;
} }
j = (s>>5); j = (s >> 5);
if (j) { if (j) {
n -= j; n -= j;
memset(&dest[n], 0, j*4); memset(&dest[n], 0, j * 4);
s &= 31; s &= 31;
b = &b[j]; b = &b[j];
} }
for(i=0; i < n-1; i++) { for (i = 0; i < n - 1; i++) {
dest[i] = (b[i]>>s) | (b[i+1]<<(32-s)); dest[i] = (b[i] >> s) | (b[i + 1] << (32 - s));
} }
dest[i] = b[i]>>s; dest[i] = b[i] >> s;
} }
void bitvector_shl(u_int32_t *b, size_t n, u_int32_t s) void bitvector_shl(u_int32_t *b, size_t n, u_int32_t s)
{ {
u_int32_t i, scrap=0, temp; u_int32_t i, scrap = 0, temp;
if (s == 0 || n == 0) return; if (s == 0 || n == 0)
i = (s>>5); return;
i = (s >> 5);
if (i) { if (i) {
n -= i; n -= i;
memmove(&b[i], b, n*4); memmove(&b[i], b, n * 4);
memset(b, 0, i*4); memset(b, 0, i * 4);
s &= 31; s &= 31;
b = &b[i]; b = &b[i];
} }
for(i=0; i < n; i++) { for (i = 0; i < n; i++) {
temp = (b[i]<<s) | scrap; temp = (b[i] << s) | scrap;
scrap = b[i]>>(32-s); scrap = b[i] >> (32 - s);
b[i] = temp; b[i] = temp;
} }
} }
@ -101,22 +107,23 @@ void bitvector_shl(u_int32_t *b, size_t n, u_int32_t s)
void bitvector_shl_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s, void bitvector_shl_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s,
bool_t scrap) bool_t scrap)
{ {
u_int32_t i, j, sc=0; u_int32_t i, j, sc = 0;
if (n == 0) return; if (n == 0)
return;
if (s == 0) { if (s == 0) {
memcpy(dest, b, n*4); memcpy(dest, b, n * 4);
return; return;
} }
j = (s>>5); j = (s >> 5);
if (j) { if (j) {
n -= j; n -= j;
memset(dest, 0, j*4); memset(dest, 0, j * 4);
s &= 31; s &= 31;
dest = &dest[j]; dest = &dest[j];
} }
for(i=0; i < n; i++) { for (i = 0; i < n; i++) {
dest[i] = (b[i]<<s) | sc; dest[i] = (b[i] << s) | sc;
sc = b[i]>>(32-s); sc = b[i] >> (32 - s);
} }
if (scrap) if (scrap)
dest[i] = sc; dest[i] = sc;
@ -124,35 +131,48 @@ void bitvector_shl_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s,
// set nbits to c, starting at given bit offset // set nbits to c, starting at given bit offset
// assumes offs < 32 // assumes offs < 32
void bitvector_fill(u_int32_t *b, u_int32_t offs, u_int32_t c, u_int32_t nbits) void bitvector_fill(u_int32_t *b, u_int32_t offs, u_int32_t c,
u_int32_t nbits)
{ {
index_t i; index_t i;
u_int32_t nw, tail; u_int32_t nw, tail;
u_int32_t mask; u_int32_t mask;
if (nbits == 0) return; if (nbits == 0)
nw = (offs+nbits+31)>>5; return;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) { if (nw == 1) {
mask = (lomask(nbits)<<offs); mask = (lomask(nbits) << offs);
if (c) b[0]|=mask; else b[0]&=(~mask); if (c)
b[0] |= mask;
else
b[0] &= (~mask);
return; return;
} }
mask = lomask(offs); mask = lomask(offs);
if (c) b[0]|=(~mask); else b[0]&=mask; if (c)
b[0] |= (~mask);
else
b[0] &= mask;
if (c) mask=ONES32; else mask = 0; if (c)
for(i=1; i < nw-1; i++) mask = ONES32;
else
mask = 0;
for (i = 1; i < nw - 1; i++)
b[i] = mask; b[i] = mask;
tail = (offs+nbits)&31; tail = (offs + nbits) & 31;
if (tail==0) { if (tail == 0) {
b[i] = mask; b[i] = mask;
} } else {
else {
mask = lomask(tail); mask = lomask(tail);
if (c) b[i]|=mask; else b[i]&=(~mask); if (c)
b[i] |= mask;
else
b[i] &= (~mask);
} }
} }
@ -162,123 +182,135 @@ void bitvector_not(u_int32_t *b, u_int32_t offs, u_int32_t nbits)
u_int32_t nw, tail; u_int32_t nw, tail;
u_int32_t mask; u_int32_t mask;
if (nbits == 0) return; if (nbits == 0)
nw = (offs+nbits+31)>>5; return;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) { if (nw == 1) {
mask = (lomask(nbits)<<offs); mask = (lomask(nbits) << offs);
b[0] ^= mask; b[0] ^= mask;
return; return;
} }
mask = ~lomask(offs); mask = ~lomask(offs);
b[0]^=mask; b[0] ^= mask;
for(i=1; i < nw-1; i++) for (i = 1; i < nw - 1; i++)
b[i] = ~b[i]; b[i] = ~b[i];
tail = (offs+nbits)&31; tail = (offs + nbits) & 31;
if (tail==0) { if (tail == 0) {
b[i] = ~b[i]; b[i] = ~b[i];
} } else {
else {
mask = lomask(tail); mask = lomask(tail);
b[i]^=mask; b[i] ^= mask;
} }
} }
// constant-space bit vector copy in a single pass, with arbitrary // constant-space bit vector copy in a single pass, with arbitrary
// offsets and lengths. to get this right, there are 16 cases to handle! // offsets and lengths. to get this right, there are 16 cases to handle!
#define BITVECTOR_COPY_OP(name, OP) \ #define BITVECTOR_COPY_OP(name, OP) \
void bitvector_##name(u_int32_t *dest, u_int32_t doffs, \ void bitvector_##name(u_int32_t *dest, u_int32_t doffs, u_int32_t *src, \
u_int32_t *src, u_int32_t soffs, u_int32_t nbits) \ u_int32_t soffs, u_int32_t nbits) \
{ \ { \
index_t i; \ index_t i; \
u_int32_t s, nw, tail, snw; \ u_int32_t s, nw, tail, snw; \
u_int32_t mask, scrap; \ u_int32_t mask, scrap; \
\ \
if (nbits == 0) return; \ if (nbits == 0) \
nw = (doffs+nbits+31)>>5; \ return; \
nw = (doffs + nbits + 31) >> 5; \
\ \
if (soffs == doffs) { \ if (soffs == doffs) { \
if (nw == 1) { \ if (nw == 1) { \
mask = (lomask(nbits)<<doffs); \ mask = (lomask(nbits) << doffs); \
dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
return; \
} \
mask = ~lomask(doffs); \
dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \ dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
for (i = 1; i < nw - 1; i++) \
dest[i] = OP(src[i]); \
tail = (doffs + nbits) & 31; \
if (tail == 0) { \
dest[i] = src[i]; \
} else { \
mask = lomask(tail); \
dest[i] = (dest[i] & ~mask) | (OP(src[i]) & mask); \
} \
return; \ return; \
} \ } \
mask = ~lomask(doffs); \ snw = (soffs + nbits + 31) >> 5; \
dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \ if (soffs < doffs) { \
for(i=1; i < nw-1; i++) \ s = doffs - soffs; \
dest[i] = OP(src[i]); \ if (nw == 1) { \
tail = (doffs+nbits)&31; \ mask = (lomask(nbits) << doffs); \
if (tail==0) { dest[i]=src[i]; } else { \ dest[0] = (dest[0] & ~mask) | ((OP(src[0]) << s) & mask); \
mask = lomask(tail); \ return; \
dest[i] = (dest[i] & ~mask) | (OP(src[i]) & mask); } \ } \
return; \ mask = ~lomask(doffs); \
} \ dest[0] = (dest[0] & ~mask) | ((OP(src[0]) << s) & mask); \
snw = (soffs+nbits+31)>>5; \ scrap = OP(src[0]) >> (32 - s); \
if (soffs < doffs) { \ for (i = 1; i < snw - 1; i++) { \
s = doffs-soffs; \ dest[i] = (OP(src[i]) << s) | scrap; \
if (nw == 1) { \ scrap = OP(src[i]) >> (32 - s); \
mask = (lomask(nbits)<<doffs); \ } \
dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \ tail = (doffs + nbits) & 31; \
return; \ if (tail == 0) { \
} \ mask = ONES32; \
mask = ~lomask(doffs); \ } else { \
dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \ mask = lomask(tail); \
scrap = OP(src[0])>>(32-s); \ } \
for(i=1; i < snw-1; i++) { \ if (snw == nw) { \
dest[i] = (OP(src[i])<<s) | scrap; \ dest[i] = \
scrap = OP(src[i])>>(32-s); \ (dest[i] & ~mask) | (((OP(src[i]) << s) | scrap) & mask); \
} \ } else /* snw < nw */ { \
tail = (doffs+nbits)&31; \ if (snw == 1) { \
if (tail==0) { mask=ONES32; } else { mask = lomask(tail); } \ dest[i] = (dest[i] & ~mask) | \
if (snw == nw) { \ (((OP(src[i]) << s) | scrap) & mask); \
dest[i] = (dest[i] & ~mask) | (((OP(src[i])<<s)|scrap) & mask); \ } else { \
} \ dest[i] = (OP(src[i]) << s) | scrap; \
else /* snw < nw */ { \ scrap = OP(src[i]) >> (32 - s); \
i++; \
dest[i] = (dest[i] & ~mask) | (scrap & mask); \
} \
} \
} else { \
s = soffs - doffs; \
if (snw == 1) { \ if (snw == 1) { \
dest[i] = (dest[i] & ~mask) | \ mask = (lomask(nbits) << doffs); \
(((OP(src[i])<<s) | scrap) & mask); \ dest[0] = (dest[0] & ~mask) | ((OP(src[0]) >> s) & mask); \
return; \
} \ } \
else { \ if (nw == 1) { \
dest[i] = (OP(src[i])<<s) | scrap; \ mask = (lomask(nbits) << doffs); \
scrap = OP(src[i])>>(32-s); \ dest[0] = \
i++; \ (dest[0] & ~mask) | \
dest[i] = (dest[i] & ~mask) | (scrap & mask); \ (((OP(src[0]) >> s) | (OP(src[1]) << (32 - s))) & mask); \
return; \
} \
mask = ~lomask(doffs); \
dest[0] = \
(dest[0] & ~mask) | \
(((OP(src[0]) >> s) | (OP(src[1]) << (32 - s))) & mask); \
for (i = 1; i < nw - 1; i++) { \
dest[i] = (OP(src[i]) >> s) | (OP(src[i + 1]) << (32 - s)); \
} \
tail = (doffs + nbits) & 31; \
if (tail == 0) { \
mask = ONES32; \
} else { \
mask = lomask(tail); \
} \
if (snw == nw) { \
dest[i] = (dest[i] & ~mask) | ((OP(src[i]) >> s) & mask); \
} else /* snw > nw */ { \
dest[i] = \
(dest[i] & ~mask) | \
(((OP(src[i]) >> s) | (OP(src[i + 1]) << (32 - s))) & mask); \
} \ } \
} \ } \
} \ }
else { \
s = soffs-doffs; \
if (snw == 1) { \
mask = (lomask(nbits)<<doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0])>>s) & mask); \
return; \
} \
if (nw == 1) { \
mask = (lomask(nbits)<<doffs); \
dest[0] = (dest[0] & ~mask) | \
(((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
return; \
} \
mask = ~lomask(doffs); \
dest[0] = (dest[0] & ~mask) | \
(((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
for(i=1; i < nw-1; i++) { \
dest[i] = (OP(src[i])>>s) | (OP(src[i+1])<<(32-s)); \
} \
tail = (doffs+nbits)&31; \
if (tail==0) { mask=ONES32; } else { mask = lomask(tail); } \
if (snw == nw) { \
dest[i] = (dest[i] & ~mask) | ((OP(src[i])>>s) & mask); \
} \
else /* snw > nw */ { \
dest[i] = (dest[i] & ~mask) | \
(((OP(src[i])>>s)|(OP(src[i+1])<<(32-s))) & mask); \
} \
} \
}
#define BV_COPY(a) (a) #define BV_COPY(a) (a)
#define BV_NOT(a) (~(a)) #define BV_NOT(a) (~(a))
@ -287,7 +319,8 @@ BITVECTOR_COPY_OP(not_to, BV_NOT)
// right-shift the bits in one logical "row" of a long 2d bit vector // right-shift the bits in one logical "row" of a long 2d bit vector
/* /*
void bitvector_shr_row(u_int32_t *b, u_int32_t offs, size_t nbits, u_int32_t s) void bitvector_shr_row(u_int32_t *b, u_int32_t offs, size_t nbits, u_int32_t
s)
{ {
} }
*/ */
@ -302,20 +335,21 @@ void bitvector_reverse_to(u_int32_t *dest, u_int32_t *src, u_int32_t soffs,
index_t i; index_t i;
u_int32_t nw, tail; u_int32_t nw, tail;
if (nbits == 0) return; if (nbits == 0)
return;
nw = (soffs+nbits+31)>>5; nw = (soffs + nbits + 31) >> 5;
// first, reverse the words while reversing bit order within each word // first, reverse the words while reversing bit order within each word
for(i=0; i < nw/2; i++) { for (i = 0; i < nw / 2; i++) {
dest[i] = bitreverse(src[nw-i-1]); dest[i] = bitreverse(src[nw - i - 1]);
dest[nw-i-1] = bitreverse(src[i]); dest[nw - i - 1] = bitreverse(src[i]);
} }
if (nw&0x1) if (nw & 0x1)
dest[i] = bitreverse(src[i]); dest[i] = bitreverse(src[i]);
tail = (soffs+nbits)&31; tail = (soffs + nbits) & 31;
if (tail) if (tail)
bitvector_shr(dest, nw, 32-tail); bitvector_shr(dest, nw, 32 - tail);
} }
void bitvector_reverse(u_int32_t *b, u_int32_t offs, u_int32_t nbits) void bitvector_reverse(u_int32_t *b, u_int32_t offs, u_int32_t nbits)
@ -324,20 +358,22 @@ void bitvector_reverse(u_int32_t *b, u_int32_t offs, u_int32_t nbits)
u_int32_t nw, tail; u_int32_t nw, tail;
u_int32_t *temp; u_int32_t *temp;
if (nbits == 0) return; if (nbits == 0)
return;
nw = (offs+nbits+31)>>5; nw = (offs + nbits + 31) >> 5;
temp = (nw > MALLOC_CUTOFF) ? malloc(nw*4) : alloca(nw*4); temp = (nw > MALLOC_CUTOFF) ? malloc(nw * 4) : alloca(nw * 4);
for(i=0; i < nw/2; i++) { for (i = 0; i < nw / 2; i++) {
temp[i] = bitreverse(b[nw-i-1]); temp[i] = bitreverse(b[nw - i - 1]);
temp[nw-i-1] = bitreverse(b[i]); temp[nw - i - 1] = bitreverse(b[i]);
} }
if (nw&0x1) if (nw & 0x1)
temp[i] = bitreverse(b[i]); temp[i] = bitreverse(b[i]);
tail = (offs+nbits)&31; tail = (offs + nbits) & 31;
bitvector_copy(b, offs, temp, (32-tail)&31, nbits); bitvector_copy(b, offs, temp, (32 - tail) & 31, nbits);
if (nw > MALLOC_CUTOFF) free(temp); if (nw > MALLOC_CUTOFF)
free(temp);
} }
u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits) u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits)
@ -346,16 +382,17 @@ u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits)
u_int32_t ntail; u_int32_t ntail;
u_int64_t ans; u_int64_t ans;
if (nbits == 0) return 0; if (nbits == 0)
nw = ((u_int64_t)offs+nbits+31)>>5; return 0;
nw = ((u_int64_t)offs + nbits + 31) >> 5;
if (nw == 1) { if (nw == 1) {
return count_bits(b[0] & (lomask(nbits)<<offs)); return count_bits(b[0] & (lomask(nbits) << offs));
} }
ans = count_bits(b[0]>>offs); // first end cap ans = count_bits(b[0] >> offs); // first end cap
for(i=1; i < nw-1; i++) { for (i = 1; i < nw - 1; i++) {
/* popcnt can be computed branch-free, so these special cases /* popcnt can be computed branch-free, so these special cases
probably don't help much */ probably don't help much */
/* /*
@ -369,8 +406,9 @@ u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits)
ans += count_bits(b[i]); ans += count_bits(b[i]);
} }
ntail = (offs+(u_int32_t)nbits)&31; ntail = (offs + (u_int32_t)nbits) & 31;
ans += count_bits(b[i]&(ntail>0?lomask(ntail):ONES32)); // last end cap ans +=
count_bits(b[i] & (ntail > 0 ? lomask(ntail) : ONES32)); // last end cap
return ans; return ans;
} }
@ -381,29 +419,34 @@ u_int32_t bitvector_any0(u_int32_t *b, u_int32_t offs, u_int32_t nbits)
u_int32_t nw, tail; u_int32_t nw, tail;
u_int32_t mask; u_int32_t mask;
if (nbits == 0) return 0; if (nbits == 0)
nw = (offs+nbits+31)>>5; return 0;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) { if (nw == 1) {
mask = (lomask(nbits)<<offs); mask = (lomask(nbits) << offs);
if ((b[0] & mask) != mask) return 1; if ((b[0] & mask) != mask)
return 1;
return 0; return 0;
} }
mask = ~lomask(offs); mask = ~lomask(offs);
if ((b[0] & mask) != mask) return 1; if ((b[0] & mask) != mask)
return 1;
for(i=1; i < nw-1; i++) { for (i = 1; i < nw - 1; i++) {
if (b[i] != ONES32) return 1; if (b[i] != ONES32)
return 1;
} }
tail = (offs+nbits)&31; tail = (offs + nbits) & 31;
if (tail==0) { if (tail == 0) {
if (b[i] != ONES32) return 1; if (b[i] != ONES32)
} return 1;
else { } else {
mask = lomask(tail); mask = lomask(tail);
if ((b[i] & mask) != mask) return 1; if ((b[i] & mask) != mask)
return 1;
} }
return 0; return 0;
} }
@ -414,29 +457,34 @@ u_int32_t bitvector_any1(u_int32_t *b, u_int32_t offs, u_int32_t nbits)
u_int32_t nw, tail; u_int32_t nw, tail;
u_int32_t mask; u_int32_t mask;
if (nbits == 0) return 0; if (nbits == 0)
nw = (offs+nbits+31)>>5; return 0;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) { if (nw == 1) {
mask = (lomask(nbits)<<offs); mask = (lomask(nbits) << offs);
if ((b[0] & mask) != 0) return 1; if ((b[0] & mask) != 0)
return 1;
return 0; return 0;
} }
mask = ~lomask(offs); mask = ~lomask(offs);
if ((b[0] & mask) != 0) return 1; if ((b[0] & mask) != 0)
return 1;
for(i=1; i < nw-1; i++) { for (i = 1; i < nw - 1; i++) {
if (b[i] != 0) return 1; if (b[i] != 0)
return 1;
} }
tail = (offs+nbits)&31; tail = (offs + nbits) & 31;
if (tail==0) { if (tail == 0) {
if (b[i] != 0) return 1; if (b[i] != 0)
} return 1;
else { } else {
mask = lomask(tail); mask = lomask(tail);
if ((b[i] & mask) != 0) return 1; if ((b[i] & mask) != 0)
return 1;
} }
return 0; return 0;
} }
@ -445,41 +493,45 @@ static void adjust_offset_to(u_int32_t *dest, u_int32_t *src, u_int32_t nw,
u_int32_t soffs, u_int32_t newoffs) u_int32_t soffs, u_int32_t newoffs)
{ {
if (newoffs > soffs) if (newoffs > soffs)
bitvector_shl_to(dest, src, nw, newoffs-soffs, 1); bitvector_shl_to(dest, src, nw, newoffs - soffs, 1);
else else
bitvector_shr_to(dest, src, nw, soffs-newoffs); bitvector_shr_to(dest, src, nw, soffs - newoffs);
} }
#define BITVECTOR_BINARY_OP_TO(opname, OP) \ #define BITVECTOR_BINARY_OP_TO(opname, OP) \
void bitvector_##opname##_to(u_int32_t *dest, u_int32_t doffs, \ void bitvector_##opname##_to( \
u_int32_t *a, u_int32_t aoffs, \ u_int32_t *dest, u_int32_t doffs, u_int32_t *a, u_int32_t aoffs, \
u_int32_t *b, u_int32_t boffs, u_int32_t nbits) \ u_int32_t *b, u_int32_t boffs, u_int32_t nbits) \
{ \ { \
u_int32_t nw = (doffs+nbits+31)>>5; \ u_int32_t nw = (doffs + nbits + 31) >> 5; \
u_int32_t *temp = nw>MALLOC_CUTOFF ? malloc((nw+1)*4) : alloca((nw+1)*4);\ u_int32_t *temp = \
u_int32_t i, anw, bnw; \ nw > MALLOC_CUTOFF ? malloc((nw + 1) * 4) : alloca((nw + 1) * 4); \
if (aoffs == boffs) { \ u_int32_t i, anw, bnw; \
anw = (aoffs+nbits+31)>>5; \ if (aoffs == boffs) { \
} \ anw = (aoffs + nbits + 31) >> 5; \
else if (aoffs == doffs) { \ } else if (aoffs == doffs) { \
bnw = (boffs+nbits+31)>>5; \ bnw = (boffs + nbits + 31) >> 5; \
adjust_offset_to(temp, b, bnw, boffs, aoffs); \ adjust_offset_to(temp, b, bnw, boffs, aoffs); \
b = temp; anw = nw; \ b = temp; \
} \ anw = nw; \
else { \ } else { \
anw = (aoffs+nbits+31)>>5; \ anw = (aoffs + nbits + 31) >> 5; \
bnw = (boffs+nbits+31)>>5; \ bnw = (boffs + nbits + 31) >> 5; \
adjust_offset_to(temp, a, anw, aoffs, boffs); \ adjust_offset_to(temp, a, anw, aoffs, boffs); \
a = temp; aoffs = boffs; anw = bnw; \ a = temp; \
} \ aoffs = boffs; \
for(i=0; i < anw; i++) temp[i] = OP(a[i], b[i]); \ anw = bnw; \
bitvector_copy(dest, doffs, temp, aoffs, nbits); \ } \
if (nw>MALLOC_CUTOFF) free(temp); \ for (i = 0; i < anw; i++) \
} temp[i] = OP(a[i], b[i]); \
bitvector_copy(dest, doffs, temp, aoffs, nbits); \
if (nw > MALLOC_CUTOFF) \
free(temp); \
}
#define BV_AND(a,b) ((a)&(b)) #define BV_AND(a, b) ((a) & (b))
#define BV_OR(a,b) ((a)|(b)) #define BV_OR(a, b) ((a) | (b))
#define BV_XOR(a,b) ((a)^(b)) #define BV_XOR(a, b) ((a) ^ (b))
BITVECTOR_BINARY_OP_TO(and, BV_AND) BITVECTOR_BINARY_OP_TO(and, BV_AND)
BITVECTOR_BINARY_OP_TO(or, BV_OR) BITVECTOR_BINARY_OP_TO(or, BV_OR)
BITVECTOR_BINARY_OP_TO(xor, BV_XOR) BITVECTOR_BINARY_OP_TO(xor, BV_XOR)

74
llt/bitvector.c
View File

@ -44,12 +44,13 @@ u_int32_t *bitvector_resize(u_int32_t *b, uint64_t oldsz, uint64_t newsz,
int initzero) int initzero)
{ {
u_int32_t *p; u_int32_t *p;
size_t sz = ((newsz+31)>>5) * sizeof(uint32_t); size_t sz = ((newsz + 31) >> 5) * sizeof(uint32_t);
p = LLT_REALLOC(b, sz); p = LLT_REALLOC(b, sz);
if (p == NULL) return NULL; if (p == NULL)
if (initzero && newsz>oldsz) { return NULL;
size_t osz = ((oldsz+31)>>5) * sizeof(uint32_t); if (initzero && newsz > oldsz) {
memset(&p[osz/sizeof(uint32_t)], 0, sz-osz); size_t osz = ((oldsz + 31) >> 5) * sizeof(uint32_t);
memset(&p[osz / sizeof(uint32_t)], 0, sz - osz);
} }
return p; return p;
} }
@ -59,34 +60,44 @@ u_int32_t *bitvector_new(u_int64_t n, int initzero)
return bitvector_resize(NULL, 0, n, initzero); return bitvector_resize(NULL, 0, n, initzero);
} }
size_t bitvector_nwords(u_int64_t nbits) size_t bitvector_nwords(u_int64_t nbits) { return ((nbits + 31) >> 5); }
{
return ((nbits+31)>>5);
}
void bitvector_set(u_int32_t *b, u_int64_t n, u_int32_t c) void bitvector_set(u_int32_t *b, u_int64_t n, u_int32_t c)
{ {
if (c) if (c)
b[n>>5] |= (1<<(n&31)); b[n >> 5] |= (1 << (n & 31));
else else
b[n>>5] &= ~(1<<(n&31)); b[n >> 5] &= ~(1 << (n & 31));
} }
u_int32_t bitvector_get(u_int32_t *b, u_int64_t n) u_int32_t bitvector_get(u_int32_t *b, u_int64_t n)
{ {
return b[n>>5] & (1<<(n&31)); return b[n >> 5] & (1 << (n & 31));
} }
static int ntz(uint32_t x) static int ntz(uint32_t x)
{ {
int n; int n;
if (x == 0) return 32; if (x == 0)
return 32;
n = 1; n = 1;
if ((x & 0x0000FFFF) == 0) {n = n +16; x = x >>16;} if ((x & 0x0000FFFF) == 0) {
if ((x & 0x000000FF) == 0) {n = n + 8; x = x >> 8;} n = n + 16;
if ((x & 0x0000000F) == 0) {n = n + 4; x = x >> 4;} x = x >> 16;
if ((x & 0x00000003) == 0) {n = n + 2; x = x >> 2;} }
if ((x & 0x000000FF) == 0) {
n = n + 8;
x = x >> 8;
}
if ((x & 0x0000000F) == 0) {
n = n + 4;
x = x >> 4;
}
if ((x & 0x00000003) == 0) {
n = n + 2;
x = x >> 2;
}
return n - (x & 1); return n - (x & 1);
} }
@ -95,35 +106,36 @@ static int ntz(uint32_t x)
// returns n if no set bits. // returns n if no set bits.
uint32_t bitvector_next(uint32_t *b, uint64_t n0, uint64_t n) uint32_t bitvector_next(uint32_t *b, uint64_t n0, uint64_t n)
{ {
if (n0 >= n) return n; if (n0 >= n)
return n;
uint32_t i = n0>>5; uint32_t i = n0 >> 5;
uint32_t nb = n0&31; uint32_t nb = n0 & 31;
uint32_t nw = (n+31)>>5; uint32_t nw = (n + 31) >> 5;
uint32_t w; uint32_t w;
if (i < nw-1 || (n&31)==0) if (i < nw - 1 || (n & 31) == 0)
w = b[i]>>nb; w = b[i] >> nb;
else else
w = (b[i]&lomask(n&31))>>nb; w = (b[i] & lomask(n & 31)) >> nb;
if (w != 0) if (w != 0)
return ntz(w)+n0; return ntz(w) + n0;
if (i == nw-1) if (i == nw - 1)
return n; return n;
i++; i++;
while (i < nw-1) { while (i < nw - 1) {
w = b[i]; w = b[i];
if (w != 0) { if (w != 0) {
return ntz(w) + (i<<5); return ntz(w) + (i << 5);
} }
i++; i++;
} }
w = b[i]; w = b[i];
nb = n&31; nb = n & 31;
i = ntz(w); i = ntz(w);
if (nb == 0) if (nb == 0)
return i + (n-32); return i + (n - 32);
if (i >= nb) if (i >= nb)
return n; return n;
return i + (n-nb); return i + (n - nb);
} }

43
llt/bitvector.h
View File

@ -2,8 +2,8 @@
#define __BITVECTOR_H_ #define __BITVECTOR_H_
// a mask with n set lo or hi bits // a mask with n set lo or hi bits
#define lomask(n) (u_int32_t)((((u_int32_t)1)<<(n))-1) #define lomask(n) (u_int32_t)((((u_int32_t)1) << (n)) - 1)
#define himask(n) (~lomask(32-n)) #define himask(n) (~lomask(32 - n))
#define ONES32 ((u_int32_t)0xffffffff) #define ONES32 ((u_int32_t)0xffffffff)
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
@ -11,11 +11,11 @@
#else #else
static inline u_int32_t count_bits(u_int32_t b) static inline u_int32_t count_bits(u_int32_t b)
{ {
b = b - ((b>>1)&0x55555555); b = b - ((b >> 1) & 0x55555555);
b = ((b>>2)&0x33333333) + (b&0x33333333); b = ((b >> 2) & 0x33333333) + (b & 0x33333333);
b = ((b>>4)+b)&0x0f0f0f0f; b = ((b >> 4) + b) & 0x0f0f0f0f;
b += (b>>8); b += (b >> 8);
b += (b>>16); b += (b >> 16);
return b & 0x3f; return b & 0x3f;
// here is the non-optimized version, for clarity: // here is the non-optimized version, for clarity:
/* /*
@ -45,24 +45,25 @@ void bitvector_shr_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s);
void bitvector_shl(u_int32_t *b, size_t n, u_int32_t s); void bitvector_shl(u_int32_t *b, size_t n, u_int32_t s);
void bitvector_shl_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s, void bitvector_shl_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s,
bool_t scrap); bool_t scrap);
void bitvector_fill(u_int32_t *b,u_int32_t offs, u_int32_t c, u_int32_t nbits); void bitvector_fill(u_int32_t *b, u_int32_t offs, u_int32_t c,
void bitvector_copy(u_int32_t *dest, u_int32_t doffs, u_int32_t nbits);
u_int32_t *a, u_int32_t aoffs, u_int32_t nbits); void bitvector_copy(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
u_int32_t aoffs, u_int32_t nbits);
void bitvector_not(u_int32_t *b, u_int32_t offs, u_int32_t nbits); void bitvector_not(u_int32_t *b, u_int32_t offs, u_int32_t nbits);
void bitvector_not_to(u_int32_t *dest, u_int32_t doffs, void bitvector_not_to(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
u_int32_t *a, u_int32_t aoffs, u_int32_t nbits); u_int32_t aoffs, u_int32_t nbits);
void bitvector_reverse(u_int32_t *b, u_int32_t offs, u_int32_t nbits); void bitvector_reverse(u_int32_t *b, u_int32_t offs, u_int32_t nbits);
void bitvector_reverse_to(u_int32_t *dest, u_int32_t *src, u_int32_t soffs, void bitvector_reverse_to(u_int32_t *dest, u_int32_t *src, u_int32_t soffs,
u_int32_t nbits); u_int32_t nbits);
void bitvector_and_to(u_int32_t *dest, u_int32_t doffs, void bitvector_and_to(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
u_int32_t *a, u_int32_t aoffs, u_int32_t aoffs, u_int32_t *b, u_int32_t boffs,
u_int32_t *b, u_int32_t boffs, u_int32_t nbits); u_int32_t nbits);
void bitvector_or_to(u_int32_t *dest, u_int32_t doffs, void bitvector_or_to(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
u_int32_t *a, u_int32_t aoffs, u_int32_t aoffs, u_int32_t *b, u_int32_t boffs,
u_int32_t *b, u_int32_t boffs, u_int32_t nbits); u_int32_t nbits);
void bitvector_xor_to(u_int32_t *dest, u_int32_t doffs, void bitvector_xor_to(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
u_int32_t *a, u_int32_t aoffs, u_int32_t aoffs, u_int32_t *b, u_int32_t boffs,
u_int32_t *b, u_int32_t boffs, u_int32_t nbits); u_int32_t nbits);
u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits); u_int64_t bitvector_count(u_int32_t *b, u_int32_t offs, u_int64_t nbits);
u_int32_t bitvector_any0(u_int32_t *b, u_int32_t offs, u_int32_t nbits); u_int32_t bitvector_any0(u_int32_t *b, u_int32_t offs, u_int32_t nbits);
u_int32_t bitvector_any1(u_int32_t *b, u_int32_t offs, u_int32_t nbits); u_int32_t bitvector_any1(u_int32_t *b, u_int32_t offs, u_int32_t nbits);

121
llt/dirpath.c
View File

@ -54,8 +54,7 @@ void path_to_dirname(char *path)
char *sep = strrchr(path, PATHSEP); char *sep = strrchr(path, PATHSEP);
if (sep != NULL) { if (sep != NULL) {
*sep = '\0'; *sep = '\0';
} } else {
else {
path[0] = '\0'; path[0] = '\0';
} }
} }
@ -98,7 +97,7 @@ char *get_exename(char *buf, size_t size)
int mib[4]; int mib[4];
pid_t pid; pid_t pid;
size_t len, plen; size_t len, plen;
char **argv, **argv2; char **argv, **argv2;
char *p, *path, *pathcpy, filename[PATH_MAX]; char *p, *path, *pathcpy, filename[PATH_MAX];
struct stat sbuf; struct stat sbuf;
@ -123,8 +122,8 @@ char *get_exename(char *buf, size_t size)
argv = argv2; argv = argv2;
if (sysctl(mib, 4, argv, &len, NULL, 0) == -1) { if (sysctl(mib, 4, argv, &len, NULL, 0) == -1) {
if (errno == ENOMEM) if (errno == ENOMEM)
continue; // Go back and realloc more memory. continue; // Go back and realloc more memory.
break; // Bail for some other error in sysctl(3). break; // Bail for some other error in sysctl(3).
} }
// If you made it here, congrats! You guessed right! // If you made it here, congrats! You guessed right!
if (*argv != NULL) if (*argv != NULL)
@ -137,56 +136,60 @@ char *get_exename(char *buf, size_t size)
// above, then buf at this point contains some kind of pathname. // above, then buf at this point contains some kind of pathname.
if (buf != NULL) { if (buf != NULL) {
if (strchr(buf, '/') == NULL) { if (strchr(buf, '/') == NULL) {
// buf contains a `basename`-style pathname (i.e. "foo", // buf contains a `basename`-style pathname (i.e. "foo",
// as opposed to "../foo" or "/usr/bin/foo"); search the // as opposed to "../foo" or "/usr/bin/foo"); search the
// PATH for its location. (BTW the setgid(2), setuid(2) // PATH for its location. (BTW the setgid(2), setuid(2)
// calls are a pre-condition for the access(2) call // calls are a pre-condition for the access(2) call
// later.) // later.)
if ( (path = getenv("PATH")) != NULL && if ((path = getenv("PATH")) != NULL && !setgid(getegid()) &&
!setgid(getegid()) && !setuid(geteuid()) ) { !setuid(geteuid())) {
// The strdup(3) call below, if successful, will // The strdup(3) call below, if successful, will
// allocate memory for the PATH string returned by // allocate memory for the PATH string returned by
// getenv(3) above. This is necessary because the man // getenv(3) above. This is necessary because the man
// page of getenv(3) says that its return value // page of getenv(3) says that its return value
// "should be considered read-only"; however, the // "should be considered read-only"; however, the
// strsep(3) call below is going to be destructively // strsep(3) call below is going to be destructively
// modifying that value. ("Hulk smash!") // modifying that value. ("Hulk smash!")
if ((path = strdup(path)) != NULL) { if ((path = strdup(path)) != NULL) {
pathcpy = path; pathcpy = path;
len = strlen(buf); len = strlen(buf);
while ((p = strsep(&pathcpy, ":")) != NULL) { while ((p = strsep(&pathcpy, ":")) != NULL) {
if (*p == '\0') p = "."; if (*p == '\0')
plen = strlen(p); p = ".";
plen = strlen(p);
// strip trailing '/' // strip trailing '/'
while (p[plen-1] == '/') p[--plen] = '\0'; while (p[plen - 1] == '/')
p[--plen] = '\0';
if (plen + 1 + len < sizeof(filename)) { if (plen + 1 + len < sizeof(filename)) {
snprintf(filename, sizeof(filename), "%s/%s", p, buf); snprintf(filename, sizeof(filename), "%s/%s", p,
if ( (stat(filename, &sbuf) == 0) && buf);
S_ISREG(sbuf.st_mode) && if ((stat(filename, &sbuf) == 0) &&
access(filename, X_OK) == 0 ) { S_ISREG(sbuf.st_mode) &&
buf = strdup(filename); access(filename, X_OK) == 0) {
break; buf = strdup(filename);
} break;
} }
} }
free(path); // free the strdup(3) memory allocation. }
} free(path); // free the strdup(3) memory allocation.
} }
else buf = NULL; // call to getenv(3) or [sg]ete?[ug]id(2) failed. } else
} buf = NULL; // call to getenv(3) or [sg]ete?[ug]id(2) failed.
if ( buf != NULL && *buf != '/' ) { }
// buf contains a relative pathname (e.g. "../foo"); if (buf != NULL && *buf != '/') {
// resolve this to an absolute pathname. // buf contains a relative pathname (e.g. "../foo");
if ( strlcpy(filename, buf, sizeof(filename)) >= sizeof(filename) || // resolve this to an absolute pathname.
realpath(filename, buf) == NULL ) if (strlcpy(filename, buf, sizeof(filename)) >=
buf = NULL; sizeof(filename) ||
} realpath(filename, buf) == NULL)
buf = NULL;
}
} }
return buf; return buf;
@ -197,14 +200,14 @@ char *get_exename(char *buf, size_t size)
char *get_exename(char *buf, size_t size) char *get_exename(char *buf, size_t size)
{ {
int mib[4]; int mib[4];
mib[0] = CTL_KERN; mib[0] = CTL_KERN;
mib[1] = KERN_PROC; mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME; mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1; mib[3] = -1;
sysctl(mib, 4, buf, &size, NULL, 0); sysctl(mib, 4, buf, &size, NULL, 0);
return buf; return buf;
} }
#elif defined(WIN32) #elif defined(WIN32)
char *get_exename(char *buf, size_t size) char *get_exename(char *buf, size_t size)
@ -220,7 +223,7 @@ char *get_exename(char *buf, size_t size)
{ {
uint32_t bufsize = (uint32_t)size; uint32_t bufsize = (uint32_t)size;
if (_NSGetExecutablePath(buf, &bufsize)) if (_NSGetExecutablePath(buf, &bufsize))
return NULL; return NULL;
return buf; return buf;
} }
#endif #endif

4
llt/dirpath.h
View File

@ -6,14 +6,14 @@
#define PATHSEPSTRING "\\" #define PATHSEPSTRING "\\"
#define PATHLISTSEP ';' #define PATHLISTSEP ';'
#define PATHLISTSEPSTRING ";" #define PATHLISTSEPSTRING ";"
#define ISPATHSEP(c) ((c)=='/' || (c)=='\\') #define ISPATHSEP(c) ((c) == '/' || (c) == '\\')
#define MAXPATHLEN 1024 #define MAXPATHLEN 1024
#else #else
#define PATHSEP '/' #define PATHSEP '/'
#define PATHSEPSTRING "/" #define PATHSEPSTRING "/"
#define PATHLISTSEP ':' #define PATHLISTSEP ':'
#define PATHLISTSEPSTRING ":" #define PATHLISTSEPSTRING ":"
#define ISPATHSEP(c) ((c)=='/') #define ISPATHSEP(c) ((c) == '/')
#endif #endif
void get_cwd(char *buf, size_t size); void get_cwd(char *buf, size_t size);

174
llt/dtypes.h
View File

@ -16,112 +16,109 @@
We assume the LP64 convention for 64-bit platforms. We assume the LP64 convention for 64-bit platforms.
*/ */
#if defined(__gnu_linux__) #if defined(__gnu_linux__)
# define LINUX #define LINUX
#elif defined(__APPLE__) && defined(__MACH__) #elif defined(__APPLE__) && defined(__MACH__)
# define MACOSX #define MACOSX
#elif defined(__OpenBSD__) #elif defined(__OpenBSD__)
# define OPENBSD #define OPENBSD
#elif defined(__FreeBSD__) #elif defined(__FreeBSD__)
# define FREEBSD #define FREEBSD
#elif defined(_WIN32) #elif defined(_WIN32)
# define WIN32 #define WIN32
#else #else
# error "unknown platform" #error "unknown platform"
#endif #endif
#if defined(OPENBSD) || defined(FREEBSD) #if defined(OPENBSD) || defined(FREEBSD)
#if defined(__x86_64__) #if defined(__x86_64__)
# define __SIZEOF_POINTER__ 8 #define __SIZEOF_POINTER__ 8
#else #else
# define __SIZEOF_POINTER__ 4 #define __SIZEOF_POINTER__ 4
#endif #endif
#endif #endif
#if !defined (BITS32) && !defined (BITS64) #if !defined(BITS32) && !defined(BITS64)
#ifndef __SIZEOF_POINTER__ #ifndef __SIZEOF_POINTER__
# error "__SIZEOF_POINTER__ undefined" #error "__SIZEOF_POINTER__ undefined"
#endif #endif
#if( 8 == __SIZEOF_POINTER__ ) #if (8 == __SIZEOF_POINTER__)
# define BITS64 #define BITS64
#elif( 4 == __SIZEOF_POINTER__ ) #elif (4 == __SIZEOF_POINTER__)
# define BITS32 #define BITS32
#else #else
# error "this is one weird machine" #error "this is one weird machine"
#endif #endif
#endif #endif
#if defined(WIN32) #if defined(WIN32)
# define STDCALL __stdcall #define STDCALL __stdcall
# if defined(IMPORT_EXPORTS) #if defined(IMPORT_EXPORTS)
# define DLLEXPORT __declspec(dllimport) #define DLLEXPORT __declspec(dllimport)
# else
# define DLLEXPORT __declspec(dllexport)
# endif
#else #else
# define STDCALL #define DLLEXPORT __declspec(dllexport)
# define DLLEXPORT __attribute__ ((visibility("default"))) #endif
#else
#define STDCALL
#define DLLEXPORT __attribute__((visibility("default")))
#endif #endif
#if defined(LINUX) #if defined(LINUX)
# include <features.h> #include <features.h>
# include <endian.h> #include <endian.h>
# define LITTLE_ENDIAN __LITTLE_ENDIAN #define LITTLE_ENDIAN __LITTLE_ENDIAN
# define BIG_ENDIAN __BIG_ENDIAN #define BIG_ENDIAN __BIG_ENDIAN
# define PDP_ENDIAN __PDP_ENDIAN #define PDP_ENDIAN __PDP_ENDIAN
# define BYTE_ORDER __BYTE_ORDER #define BYTE_ORDER __BYTE_ORDER
#elif defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD) #elif defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD)
# include <machine/endian.h> #include <machine/endian.h>
# define __LITTLE_ENDIAN LITTLE_ENDIAN #define __LITTLE_ENDIAN LITTLE_ENDIAN
# define __BIG_ENDIAN BIG_ENDIAN #define __BIG_ENDIAN BIG_ENDIAN
# define __PDP_ENDIAN PDP_ENDIAN #define __PDP_ENDIAN PDP_ENDIAN
# define __BYTE_ORDER BYTE_ORDER #define __BYTE_ORDER BYTE_ORDER
#elif defined(WIN32) #elif defined(WIN32)
# define __LITTLE_ENDIAN 1234 #define __LITTLE_ENDIAN 1234
# define __BIG_ENDIAN 4321 #define __BIG_ENDIAN 4321
# define __PDP_ENDIAN 3412 #define __PDP_ENDIAN 3412
# define __BYTE_ORDER __LITTLE_ENDIAN #define __BYTE_ORDER __LITTLE_ENDIAN
# define __FLOAT_WORD_ORDER __LITTLE_ENDIAN #define __FLOAT_WORD_ORDER __LITTLE_ENDIAN
# define LITTLE_ENDIAN __LITTLE_ENDIAN #define LITTLE_ENDIAN __LITTLE_ENDIAN
# define BIG_ENDIAN __BIG_ENDIAN #define BIG_ENDIAN __BIG_ENDIAN
# define PDP_ENDIAN __PDP_ENDIAN #define PDP_ENDIAN __PDP_ENDIAN
# define BYTE_ORDER __BYTE_ORDER #define BYTE_ORDER __BYTE_ORDER
#else #else
# error "unknown platform" #error "unknown platform"
#endif #endif
#ifdef BOEHM_GC #ifdef BOEHM_GC
// boehm GC allocator // boehm GC allocator
#include <gc.h> #include <gc.h>
#define LLT_ALLOC(n) GC_MALLOC(n) #define LLT_ALLOC(n) GC_MALLOC(n)
#define LLT_REALLOC(p,n) GC_REALLOC((p),(n)) #define LLT_REALLOC(p, n) GC_REALLOC((p), (n))
#define LLT_FREE(x) ((void)(x)) #define LLT_FREE(x) ((void)(x))
#else #else
// standard allocator // standard allocator
#define LLT_ALLOC(n) malloc(n) #define LLT_ALLOC(n) malloc(n)
#define LLT_REALLOC(p,n) realloc((p),(n)) #define LLT_REALLOC(p, n) realloc((p), (n))
#define LLT_FREE(x) free(x) #define LLT_FREE(x) free(x)
#endif #endif
typedef int bool_t; typedef int bool_t;
#if defined(__INTEL_COMPILER) && defined(WIN32) #if defined(__INTEL_COMPILER) && defined(WIN32)
# define STATIC_INLINE static #define STATIC_INLINE static
# define INLINE #define INLINE
# ifdef BITS64 #ifdef BITS64
typedef unsigned long size_t; typedef unsigned long size_t;
# else
typedef unsigned int size_t;
# endif
#else #else
# define STATIC_INLINE static inline typedef unsigned int size_t;
# define INLINE inline #endif
#else
#define STATIC_INLINE static inline
#define INLINE inline
#endif #endif
typedef unsigned char byte_t; /* 1 byte */ typedef unsigned char byte_t; /* 1 byte */
#if defined(WIN32) #if defined(WIN32)
typedef short int16_t; typedef short int16_t;
typedef int int32_t; typedef int int32_t;
@ -150,7 +147,7 @@ typedef unsigned long uint_t; // preferred int type on platform
typedef long int_t; typedef long int_t;
typedef int64_t offset_t; typedef int64_t offset_t;
typedef u_int64_t index_t; typedef u_int64_t index_t;
typedef int64_t ptrint_t; // pointer-size int typedef int64_t ptrint_t; // pointer-size int
typedef u_int64_t u_ptrint_t; typedef u_int64_t u_ptrint_t;
#else #else
#define TOP_BIT 0x80000000 #define TOP_BIT 0x80000000
@ -163,55 +160,56 @@ typedef int32_t ptrint_t;
typedef u_int32_t u_ptrint_t; typedef u_int32_t u_ptrint_t;
#endif #endif
typedef u_int8_t uint8_t; typedef u_int8_t uint8_t;
typedef u_int16_t uint16_t; typedef u_int16_t uint16_t;
typedef u_int32_t uint32_t; typedef u_int32_t uint32_t;
typedef u_int64_t uint64_t; typedef u_int64_t uint64_t;
typedef u_ptrint_t uptrint_t; typedef u_ptrint_t uptrint_t;
#define LLT_ALIGN(x, sz) (((x) + (sz-1)) & (-sz)) #define LLT_ALIGN(x, sz) (((x) + (sz - 1)) & (-sz))
// branch prediction annotations // branch prediction annotations
#ifdef __GNUC__ #ifdef __GNUC__
#define __unlikely(x) __builtin_expect(!!(x), 0) #define __unlikely(x) __builtin_expect(!!(x), 0)
#define __likely(x) __builtin_expect(!!(x), 1) #define __likely(x) __builtin_expect(!!(x), 1)
#else #else
#define __unlikely(x) (x) #define __unlikely(x) (x)
#define __likely(x) (x) #define __likely(x) (x)
#endif #endif
#define DBL_MAXINT 9007199254740992LL #define DBL_MAXINT 9007199254740992LL
#define FLT_MAXINT 16777216 #define FLT_MAXINT 16777216
#define U64_MAX 18446744073709551615ULL #define U64_MAX 18446744073709551615ULL
#define S64_MAX 9223372036854775807LL #define S64_MAX 9223372036854775807LL
#define S64_MIN (-S64_MAX - 1LL) #define S64_MIN (-S64_MAX - 1LL)
#define BIT63 0x8000000000000000LL #define BIT63 0x8000000000000000LL
#define U32_MAX 4294967295L #define U32_MAX 4294967295L
#define S32_MAX 2147483647L #define S32_MAX 2147483647L
#define S32_MIN (-S32_MAX - 1L) #define S32_MIN (-S32_MAX - 1L)
#define BIT31 0x80000000 #define BIT31 0x80000000
#define DBL_EPSILON 2.2204460492503131e-16 #define DBL_EPSILON 2.2204460492503131e-16
#define FLT_EPSILON 1.192092896e-7 #define FLT_EPSILON 1.192092896e-7
#define DBL_MAX 1.7976931348623157e+308 #define DBL_MAX 1.7976931348623157e+308
#define DBL_MIN 2.2250738585072014e-308 #define DBL_MIN 2.2250738585072014e-308
#define FLT_MAX 3.402823466e+38 #define FLT_MAX 3.402823466e+38
#define FLT_MIN 1.175494351e-38 #define FLT_MIN 1.175494351e-38
#define LOG2_10 3.3219280948873626 #define LOG2_10 3.3219280948873626
#define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON) #define rel_zero(a, b) (fabs((a) / (b)) < DBL_EPSILON)
#define sign_bit(r) ((*(int64_t*)&(r)) & BIT63) #define sign_bit(r) ((*(int64_t *)&(r)) & BIT63)
#define LABS(n) (((n)^((n)>>(NBITS-1))) - ((n)>>(NBITS-1))) #define LABS(n) (((n) ^ ((n) >> (NBITS - 1))) - ((n) >> (NBITS - 1)))
#define NBABS(n,nb) (((n)^((n)>>((nb)-1))) - ((n)>>((nb)-1))) #define NBABS(n, nb) (((n) ^ ((n) >> ((nb)-1))) - ((n) >> ((nb)-1)))
#define DFINITE(d) (((*(int64_t*)&(d))&0x7ff0000000000000LL)!=0x7ff0000000000000LL) #define DFINITE(d) \
#define DNAN(d) ((d)!=(d)) (((*(int64_t *)&(d)) & 0x7ff0000000000000LL) != 0x7ff0000000000000LL)
#define DNAN(d) ((d) != (d))
extern double D_PNAN; extern double D_PNAN;
extern double D_NNAN; extern double D_NNAN;
extern double D_PINF; extern double D_PINF;
extern double D_NINF; extern double D_NINF;
extern float F_PNAN; extern float F_PNAN;
extern float F_NNAN; extern float F_NNAN;
extern float F_PINF; extern float F_PINF;
extern float F_NINF; extern float F_NINF;
#endif #endif

18
llt/dump.c
View File

@ -11,7 +11,7 @@ static char hexdig[] = "0123456789abcdef";
*/ */
void hexdump(ios_t *dest, const char *buffer, size_t len, size_t startoffs) void hexdump(ios_t *dest, const char *buffer, size_t len, size_t startoffs)
{ {
size_t offs=0; size_t offs = 0;
size_t i, pos; size_t i, pos;
char ch, linebuffer[16]; char ch, linebuffer[16];
char hexc[4]; char hexc[4];
@ -19,18 +19,18 @@ void hexdump(ios_t *dest, const char *buffer, size_t len, size_t startoffs)
hexc[2] = hexc[3] = ' '; hexc[2] = hexc[3] = ' ';
do { do {
ios_printf(dest, "%.8x ", offs+startoffs); ios_printf(dest, "%.8x ", offs + startoffs);
pos = 10; pos = 10;
for(i=0; i < 16 && offs < len; i++, offs++) { for (i = 0; i < 16 && offs < len; i++, offs++) {
ch = buffer[offs]; ch = buffer[offs];
linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch; linebuffer[i] = (ch < 32 || ch >= 0x7f) ? '.' : ch;
hexc[0] = hexdig[((unsigned char)ch)>>4]; hexc[0] = hexdig[((unsigned char)ch) >> 4];
hexc[1] = hexdig[ch&0x0f]; hexc[1] = hexdig[ch & 0x0f];
pos += ios_write(dest, hexc, (i==7 || i==15) ? 4 : 3); pos += ios_write(dest, hexc, (i == 7 || i == 15) ? 4 : 3);
} }
for(; i < 16; i++) for (; i < 16; i++)
linebuffer[i] = ' '; linebuffer[i] = ' ';
ios_write(dest, spc50, 60-pos); ios_write(dest, spc50, 60 - pos);
ios_putc('|', dest); ios_putc('|', dest);
ios_write(dest, linebuffer, 16); ios_write(dest, linebuffer, 16);
ios_write(dest, "|\n", 2); ios_write(dest, "|\n", 2);

57
llt/hashing.c
View File

@ -13,45 +13,48 @@
uint_t nextipow2(uint_t i) uint_t nextipow2(uint_t i)
{ {
if (i==0) return 1; if (i == 0)
if ((i&(i-1))==0) return i; return 1;
if (i&TOP_BIT) return TOP_BIT; if ((i & (i - 1)) == 0)
return i;
if (i & TOP_BIT)
return TOP_BIT;
// repeatedly clear bottom bit // repeatedly clear bottom bit
while (i&(i-1)) while (i & (i - 1))
i = i&(i-1); i = i & (i - 1);
return i<<1; return i << 1;
} }
u_int32_t int32hash(u_int32_t a) u_int32_t int32hash(u_int32_t a)
{ {
a = (a+0x7ed55d16) + (a<<12); a = (a + 0x7ed55d16) + (a << 12);
a = (a^0xc761c23c) ^ (a>>19); a = (a ^ 0xc761c23c) ^ (a >> 19);
a = (a+0x165667b1) + (a<<5); a = (a + 0x165667b1) + (a << 5);
a = (a+0xd3a2646c) ^ (a<<9); a = (a + 0xd3a2646c) ^ (a << 9);
a = (a+0xfd7046c5) + (a<<3); a = (a + 0xfd7046c5) + (a << 3);
a = (a^0xb55a4f09) ^ (a>>16); a = (a ^ 0xb55a4f09) ^ (a >> 16);
return a; return a;
} }
u_int64_t int64hash(u_int64_t key) u_int64_t int64hash(u_int64_t key)
{ {
key = (~key) + (key << 21); // key = (key << 21) - key - 1; key = (~key) + (key << 21); // key = (key << 21) - key - 1;
key = key ^ (key >> 24); key = key ^ (key >> 24);
key = (key + (key << 3)) + (key << 8); // key * 265 key = (key + (key << 3)) + (key << 8); // key * 265
key = key ^ (key >> 14); key = key ^ (key >> 14);
key = (key + (key << 2)) + (key << 4); // key * 21 key = (key + (key << 2)) + (key << 4); // key * 21
key = key ^ (key >> 28); key = key ^ (key >> 28);
key = key + (key << 31); key = key + (key << 31);
return key; return key;
} }
u_int32_t int64to32hash(u_int64_t key) u_int32_t int64to32hash(u_int64_t key)
{ {
key = (~key) + (key << 18); // key = (key << 18) - key - 1; key = (~key) + (key << 18); // key = (key << 18) - key - 1;
key = key ^ (key >> 31); key = key ^ (key >> 31);
key = key * 21; // key = (key + (key << 2)) + (key << 4); key = key * 21; // key = (key + (key << 2)) + (key << 4);
key = key ^ (key >> 11); key = key ^ (key >> 11);
key = key + (key << 6); key = key + (key << 6);
key = key ^ (key >> 22); key = key ^ (key >> 22);
@ -60,17 +63,17 @@ u_int32_t int64to32hash(u_int64_t key)
#include "lookup3.c" #include "lookup3.c"
u_int64_t memhash(const char* buf, size_t n) u_int64_t memhash(const char *buf, size_t n)
{ {
u_int32_t c=0xcafe8881, b=0x4d6a087c; u_int32_t c = 0xcafe8881, b = 0x4d6a087c;
hashlittle2(buf, n, &c, &b); hashlittle2(buf, n, &c, &b);
return (u_int64_t)c | (((u_int64_t)b)<<32); return (u_int64_t)c | (((u_int64_t)b) << 32);
} }
u_int32_t memhash32(const char* buf, size_t n) u_int32_t memhash32(const char *buf, size_t n)
{ {
u_int32_t c=0xcafe8881, b=0x4d6a087c; u_int32_t c = 0xcafe8881, b = 0x4d6a087c;
hashlittle2(buf, n, &c, &b); hashlittle2(buf, n, &c, &b);
return c; return c;

4
llt/hashing.h
View File

@ -10,7 +10,7 @@ u_int32_t int64to32hash(u_int64_t key);
#else #else
#define inthash int32hash #define inthash int32hash
#endif #endif
u_int64_t memhash(const char* buf, size_t n); u_int64_t memhash(const char *buf, size_t n);
u_int32_t memhash32(const char* buf, size_t n); u_int32_t memhash32(const char *buf, size_t n);
#endif #endif

23
llt/htable.c
View File

@ -14,20 +14,20 @@
htable_t *htable_new(htable_t *h, size_t size) htable_t *htable_new(htable_t *h, size_t size)
{ {
if (size <= HT_N_INLINE/2) { if (size <= HT_N_INLINE / 2) {
h->size = size = HT_N_INLINE; h->size = size = HT_N_INLINE;
h->table = &h->_space[0]; h->table = &h->_space[0];
} } else {
else {
size = nextipow2(size); size = nextipow2(size);
size *= 2; // 2 pointers per key/value pair size *= 2; // 2 pointers per key/value pair
size *= 2; // aim for 50% occupancy size *= 2; // aim for 50% occupancy
h->size = size; h->size = size;
h->table = (void**)LLT_ALLOC(size*sizeof(void*)); h->table = (void **)LLT_ALLOC(size * sizeof(void *));
} }
if (h->table == NULL) return NULL; if (h->table == NULL)
return NULL;
size_t i; size_t i;
for(i=0; i < size; i++) for (i = 0; i < size; i++)
h->table[i] = HT_NOTFOUND; h->table[i] = HT_NOTFOUND;
return h; return h;
} }
@ -42,15 +42,16 @@ void htable_free(htable_t *h)
void htable_reset(htable_t *h, size_t sz) void htable_reset(htable_t *h, size_t sz)
{ {
sz = nextipow2(sz); sz = nextipow2(sz);
if (h->size > sz*4 && h->size > HT_N_INLINE) { if (h->size > sz * 4 && h->size > HT_N_INLINE) {
size_t newsz = sz*4; size_t newsz = sz * 4;
void **newtab = (void**)LLT_REALLOC(h->table, newsz*sizeof(void*)); void **newtab =
(void **)LLT_REALLOC(h->table, newsz * sizeof(void *));
if (newtab == NULL) if (newtab == NULL)
return; return;
h->size = newsz; h->size = newsz;
h->table = newtab; h->table = newtab;
} }
size_t i, hsz=h->size; size_t i, hsz = h->size;
for(i=0; i < hsz; i++) for (i = 0; i < hsz; i++)
h->table[i] = HT_NOTFOUND; h->table[i] = HT_NOTFOUND;
} }

2
llt/htable.h
View File

@ -10,7 +10,7 @@ typedef struct {
} htable_t; } htable_t;
// define this to be an invalid key/value // define this to be an invalid key/value
#define HT_NOTFOUND ((void*)1) #define HT_NOTFOUND ((void *)1)
// initialize and free // initialize and free
htable_t *htable_new(htable_t *h, size_t size); htable_t *htable_new(htable_t *h, size_t size);

48
llt/ieee754.h
View File

@ -6,14 +6,14 @@ union ieee754_float {
struct { struct {
#if BYTE_ORDER == BIG_ENDIAN #if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1; unsigned int negative : 1;
unsigned int exponent:8; unsigned int exponent : 8;
unsigned int mantissa:23; unsigned int mantissa : 23;
#endif #endif
#if BYTE_ORDER == LITTLE_ENDIAN #if BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa:23; unsigned int mantissa : 23;
unsigned int exponent:8; unsigned int exponent : 8;
unsigned int negative:1; unsigned int negative : 1;
#endif #endif
} ieee; } ieee;
}; };
@ -25,16 +25,16 @@ union ieee754_double {
struct { struct {
#if BYTE_ORDER == BIG_ENDIAN #if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1; unsigned int negative : 1;
unsigned int exponent:11; unsigned int exponent : 11;
unsigned int mantissa0:20; unsigned int mantissa0 : 20;
unsigned int mantissa1:32; unsigned int mantissa1 : 32;
#endif #endif
#if BYTE_ORDER == LITTLE_ENDIAN #if BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa1:32; unsigned int mantissa1 : 32;
unsigned int mantissa0:20; unsigned int mantissa0 : 20;
unsigned int exponent:11; unsigned int exponent : 11;
unsigned int negative:1; unsigned int negative : 1;
#endif #endif
} ieee; } ieee;
}; };
@ -46,18 +46,18 @@ union ieee854_long_double {
struct { struct {
#if BYTE_ORDER == BIG_ENDIAN #if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1; unsigned int negative : 1;
unsigned int exponent:15; unsigned int exponent : 15;
unsigned int empty:16; unsigned int empty : 16;
unsigned int mantissa0:32; unsigned int mantissa0 : 32;
unsigned int mantissa1:32; unsigned int mantissa1 : 32;
#endif #endif
#if BYTE_ORDER == LITTLE_ENDIAN #if BYTE_ORDER == LITTLE_ENDIAN
unsigned int mantissa1:32; unsigned int mantissa1 : 32;
unsigned int mantissa0:32; unsigned int mantissa0 : 32;
unsigned int exponent:15; unsigned int exponent : 15;
unsigned int negative:1; unsigned int negative : 1;
unsigned int empty:16; unsigned int empty : 16;
#endif #endif
} ieee; } ieee;
}; };

13
llt/int2str.c
View File

@ -4,7 +4,7 @@
char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base) char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
{ {
int i = len-1; int i = len - 1;
uint64_t b = (uint64_t)base; uint64_t b = (uint64_t)base;
char ch; char ch;
dest[i--] = '\0'; dest[i--] = '\0';
@ -13,22 +13,21 @@ char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
if (ch < 10) if (ch < 10)
ch += '0'; ch += '0';
else else
ch = ch-10+'a'; ch = ch - 10 + 'a';
dest[i--] = ch; dest[i--] = ch;
num /= b; num /= b;
if (num == 0) if (num == 0)
break; break;
} }
return &dest[i+1]; return &dest[i + 1];
} }
int isdigit_base(char c, int base) int isdigit_base(char c, int base)
{ {
if (base < 11) if (base < 11)
return (c >= '0' && c < '0'+base); return (c >= '0' && c < '0' + base);
return ((c >= '0' && c <= '9') || return ((c >= '0' && c <= '9') || (c >= 'a' && c < 'a' + base - 10) ||
(c >= 'a' && c < 'a'+base-10) || (c >= 'A' && c < 'A' + base - 10));
(c >= 'A' && c < 'A'+base-10));
} }
/* assumes valid base, returns 1 on error, 0 if OK */ /* assumes valid base, returns 1 on error, 0 if OK */

196
llt/ios.c
View File

@ -5,7 +5,7 @@
#include <limits.h> #include <limits.h>
#include <errno.h> #include <errno.h>
#include <wchar.h> #include <wchar.h>
#include <stdio.h> // for printf #include <stdio.h> // for printf
#include "dtypes.h" #include "dtypes.h"
@ -27,7 +27,7 @@
#include "ios.h" #include "ios.h"
#include "timefuncs.h" #include "timefuncs.h"
#define MOST_OF(x) ((x) - ((x)>>4)) #define MOST_OF(x) ((x) - ((x) >> 4))
/* OS-level primitive wrappers */ /* OS-level primitive wrappers */
@ -36,9 +36,9 @@ void *memrchr(const void *s, int c, size_t n)
{ {
const unsigned char *src = s + n; const unsigned char *src = s + n;
unsigned char uc = c; unsigned char uc = c;
while (--src >= (unsigned char *) s) while (--src >= (unsigned char *)s)
if (*src == uc) if (*src == uc)
return (void *) src; return (void *)src;
return NULL; return NULL;
} }
#else #else
@ -69,7 +69,7 @@ static int _enonfatal(int err)
err == EWOULDBLOCK); err == EWOULDBLOCK);
} }
#define SLEEP_TIME 5//ms #define SLEEP_TIME 5 // ms
// return error code, #bytes read in *nread // return error code, #bytes read in *nread
// these wrappers retry operations until success or a fatal error // these wrappers retry operations until success or a fatal error
@ -98,12 +98,12 @@ static int _os_read_all(long fd, void *buf, size_t n, size_t *nread)
*nread = 0; *nread = 0;
while (n>0) { while (n > 0) {
int err = _os_read(fd, buf, n, &got); int err = _os_read(fd, buf, n, &got);
n -= got; n -= got;
*nread += got; *nread += got;
buf += got; buf += got;
if (err || got==0) if (err || got == 0)
return err; return err;
} }
return 0; return 0;
@ -134,7 +134,7 @@ static int _os_write_all(long fd, void *buf, size_t n, size_t *nwritten)
*nwritten = 0; *nwritten = 0;
while (n>0) { while (n > 0) {
int err = _os_write(fd, buf, n, &wrote); int err = _os_write(fd, buf, n, &wrote);
n -= wrote; n -= wrote;
*nwritten += wrote; *nwritten += wrote;
@ -145,14 +145,13 @@ static int _os_write_all(long fd, void *buf, size_t n, size_t *nwritten)
return 0; return 0;
} }
/* internal utility functions */ /* internal utility functions */
static char *_buf_realloc(ios_t *s, size_t sz) static char *_buf_realloc(ios_t *s, size_t sz)
{ {
char *temp; char *temp;
if ((s->buf==NULL || s->buf==&s->local[0]) && (sz <= IOS_INLSIZE)) { if ((s->buf == NULL || s->buf == &s->local[0]) && (sz <= IOS_INLSIZE)) {
/* TODO: if we want to allow shrinking, see if the buffer shrank /* TODO: if we want to allow shrinking, see if the buffer shrank
down to this size, in which case we need to copy. */ down to this size, in which case we need to copy. */
s->buf = &s->local[0]; s->buf = &s->local[0];
@ -161,18 +160,18 @@ static char *_buf_realloc(ios_t *s, size_t sz)
return s->buf; return s->buf;
} }
if (sz <= s->maxsize) return s->buf; if (sz <= s->maxsize)
return s->buf;
if (s->ownbuf && s->buf != &s->local[0]) { if (s->ownbuf && s->buf != &s->local[0]) {
// if we own the buffer we're free to resize it // if we own the buffer we're free to resize it
// always allocate 1 bigger in case user wants to add a NUL // always allocate 1 bigger in case user wants to add a NUL
// terminator after taking over the buffer // terminator after taking over the buffer
temp = LLT_REALLOC(s->buf, sz+1); temp = LLT_REALLOC(s->buf, sz + 1);
if (temp == NULL) if (temp == NULL)
return NULL; return NULL;
} } else {
else { temp = LLT_ALLOC(sz + 1);
temp = LLT_ALLOC(sz+1);
if (temp == NULL) if (temp == NULL)
return NULL; return NULL;
s->ownbuf = 1; s->ownbuf = 1;
@ -221,7 +220,6 @@ static size_t _write_grow(ios_t *s, char *data, size_t n)
return n; return n;
} }
/* interface functions, low level */ /* interface functions, low level */
static size_t _ios_read(ios_t *s, char *dest, size_t n, int all) static size_t _ios_read(ios_t *s, char *dest, size_t n, int all)
@ -231,14 +229,14 @@ static size_t _ios_read(ios_t *s, char *dest, size_t n, int all)
while (n > 0) { while (n > 0) {
avail = s->size - s->bpos; avail = s->size - s->bpos;
if (avail > 0) { if (avail > 0) {
size_t ncopy = (avail >= n) ? n : avail; size_t ncopy = (avail >= n) ? n : avail;
memcpy(dest, s->buf + s->bpos, ncopy); memcpy(dest, s->buf + s->bpos, ncopy);
s->bpos += ncopy; s->bpos += ncopy;
if (ncopy >= n) { if (ncopy >= n) {
s->state = bst_rd; s->state = bst_rd;
return tot+ncopy; return tot + ncopy;
} }
} }
if (s->bm == bm_mem || s->fd == -1) { if (s->bm == bm_mem || s->fd == -1) {
@ -248,15 +246,15 @@ static size_t _ios_read(ios_t *s, char *dest, size_t n, int all)
s->_eof = 1; s->_eof = 1;
return avail; return avail;
} }
dest += avail; dest += avail;
n -= avail; n -= avail;
tot += avail; tot += avail;
ios_flush(s); ios_flush(s);
s->bpos = s->size = 0; s->bpos = s->size = 0;
s->state = bst_rd; s->state = bst_rd;
s->fpos = -1; s->fpos = -1;
if (n > MOST_OF(s->maxsize)) { if (n > MOST_OF(s->maxsize)) {
// doesn't fit comfortably in buffer; go direct // doesn't fit comfortably in buffer; go direct
@ -268,8 +266,7 @@ static size_t _ios_read(ios_t *s, char *dest, size_t n, int all)
if (got == 0) if (got == 0)
s->_eof = 1; s->_eof = 1;
return tot; return tot;
} } else {
else {
// refill buffer // refill buffer
if (_os_read(s->fd, s->buf, s->maxsize, &got)) { if (_os_read(s->fd, s->buf, s->maxsize, &got)) {
s->_eof = 1; s->_eof = 1;
@ -306,21 +303,21 @@ size_t ios_readprep(ios_t *s, size_t n)
s->state = bst_rd; s->state = bst_rd;
if (space >= n || s->bm == bm_mem || s->fd == -1) if (space >= n || s->bm == bm_mem || s->fd == -1)
return space; return space;
if (s->maxsize < s->bpos+n) { if (s->maxsize < s->bpos + n) {
// it won't fit. grow buffer or move data back. // it won't fit. grow buffer or move data back.
if (n <= s->maxsize && space <= ((s->maxsize)>>2)) { if (n <= s->maxsize && space <= ((s->maxsize) >> 2)) {
if (space) if (space)
memmove(s->buf, s->buf+s->bpos, space); memmove(s->buf, s->buf + s->bpos, space);
s->size -= s->bpos; s->size -= s->bpos;
s->bpos = 0; s->bpos = 0;
} } else {
else { if (_buf_realloc(s, s->bpos + n) == NULL)
if (_buf_realloc(s, s->bpos + n)==NULL)
return space; return space;
} }
} }
size_t got; size_t got;
int result = _os_read(s->fd, s->buf+s->size, s->maxsize - s->size, &got); int result =
_os_read(s->fd, s->buf + s->size, s->maxsize - s->size, &got);
if (result) if (result)
return space; return space;
s->size += got; s->size += got;
@ -329,42 +326,44 @@ size_t ios_readprep(ios_t *s, size_t n)
static void _write_update_pos(ios_t *s) static void _write_update_pos(ios_t *s)
{ {
if (s->bpos > s->ndirty) s->ndirty = s->bpos; if (s->bpos > s->ndirty)
if (s->bpos > s->size) s->size = s->bpos; s->ndirty = s->bpos;
if (s->bpos > s->size)
s->size = s->bpos;
} }
size_t ios_write(ios_t *s, char *data, size_t n) size_t ios_write(ios_t *s, char *data, size_t n)
{ {
if (s->readonly) return 0; if (s->readonly)
if (n == 0) return 0; return 0;
if (n == 0)
return 0;
size_t space; size_t space;
size_t wrote = 0; size_t wrote = 0;
if (s->state == bst_none) s->state = bst_wr; if (s->state == bst_none)
s->state = bst_wr;
if (s->state == bst_rd) { if (s->state == bst_rd) {
if (!s->rereadable) { if (!s->rereadable) {
s->size = 0; s->size = 0;
s->bpos = 0; s->bpos = 0;
} }
space = s->size - s->bpos; space = s->size - s->bpos;
} } else {
else {
space = s->maxsize - s->bpos; space = s->maxsize - s->bpos;
} }
if (s->bm == bm_mem) { if (s->bm == bm_mem) {
wrote = _write_grow(s, data, n); wrote = _write_grow(s, data, n);
} } else if (s->bm == bm_none) {
else if (s->bm == bm_none) {
s->fpos = -1; s->fpos = -1;
_os_write_all(s->fd, data, n, &wrote); _os_write_all(s->fd, data, n, &wrote);
return wrote; return wrote;
} } else if (n <= space) {
else if (n <= space) {
if (s->bm == bm_line) { if (s->bm == bm_line) {
char *nl; char *nl;
if ((nl=(char*)memrchr(data, '\n', n)) != NULL) { if ((nl = (char *)memrchr(data, '\n', n)) != NULL) {
size_t linesz = nl-data+1; size_t linesz = nl - data + 1;
s->bm = bm_block; s->bm = bm_block;
wrote += ios_write(s, data, linesz); wrote += ios_write(s, data, linesz);
ios_flush(s); ios_flush(s);
@ -376,8 +375,7 @@ size_t ios_write(ios_t *s, char *data, size_t n)
memcpy(s->buf + s->bpos, data, n); memcpy(s->buf + s->bpos, data, n);
s->bpos += n; s->bpos += n;
wrote += n; wrote += n;
} } else {
else {
s->state = bst_wr; s->state = bst_wr;
ios_flush(s); ios_flush(s);
if (n > MOST_OF(s->maxsize)) { if (n > MOST_OF(s->maxsize)) {
@ -397,8 +395,7 @@ off_t ios_seek(ios_t *s, off_t pos)
if ((size_t)pos > s->size) if ((size_t)pos > s->size)
return -1; return -1;
s->bpos = pos; s->bpos = pos;
} } else {
else {
ios_flush(s); ios_flush(s);
off_t fdpos = lseek(s->fd, pos, SEEK_SET); off_t fdpos = lseek(s->fd, pos, SEEK_SET);
if (fdpos == (off_t)-1) if (fdpos == (off_t)-1)
@ -413,8 +410,7 @@ off_t ios_seek_end(ios_t *s)
s->_eof = 1; s->_eof = 1;
if (s->bm == bm_mem) { if (s->bm == bm_mem) {
s->bpos = s->size; s->bpos = s->size;
} } else {
else {
ios_flush(s); ios_flush(s);
off_t fdpos = lseek(s->fd, 0, SEEK_END); off_t fdpos = lseek(s->fd, 0, SEEK_END);
if (fdpos == (off_t)-1) if (fdpos == (off_t)-1)
@ -428,22 +424,19 @@ off_t ios_skip(ios_t *s, off_t offs)
{ {
if (offs != 0) { if (offs != 0) {
if (offs > 0) { if (offs > 0) {
if (offs <= (off_t)(s->size-s->bpos)) { if (offs <= (off_t)(s->size - s->bpos)) {
s->bpos += offs; s->bpos += offs;
return 0; return 0;
} } else if (s->bm == bm_mem) {
else if (s->bm == bm_mem) {
// TODO: maybe grow buffer // TODO: maybe grow buffer
return -1; return -1;
} }
} } else if (offs < 0) {
else if (offs < 0) {
if (-offs <= (off_t)s->bpos) { if (-offs <= (off_t)s->bpos) {
s->bpos += offs; s->bpos += offs;
s->_eof = 0; s->_eof = 0;
return 0; return 0;
} } else if (s->bm == bm_mem) {
else if (s->bm == bm_mem) {
return -1; return -1;
} }
} }
@ -489,15 +482,14 @@ size_t ios_trunc(ios_t *s, size_t size)
if (size < s->size) { if (size < s->size) {
if (s->bpos > size) if (s->bpos > size)
s->bpos = size; s->bpos = size;
} } else {
else { if (_buf_realloc(s, size) == NULL)
if (_buf_realloc(s, size)==NULL)
return s->size; return s->size;
} }
s->size = size; s->size = size;
return size; return size;
} }
//todo // todo
return 0; return 0;
} }
@ -524,7 +516,7 @@ int ios_flush(ios_t *s)
} }
} }
size_t nw, ntowrite=s->ndirty; size_t nw, ntowrite = s->ndirty;
s->fpos = -1; s->fpos = -1;
int err = _os_write_all(s->fd, s->buf, ntowrite, &nw); int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
// todo: try recovering from some kinds of errors (e.g. retry) // todo: try recovering from some kinds of errors (e.g. retry)
@ -532,8 +524,7 @@ int ios_flush(ios_t *s)
if (s->state == bst_rd) { if (s->state == bst_rd) {
if (lseek(s->fd, s->size - nw, SEEK_CUR) == (off_t)-1) { if (lseek(s->fd, s->size - nw, SEEK_CUR) == (off_t)-1) {
} }
} } else if (s->state == bst_wr) {
else if (s->state == bst_wr) {
if (s->bpos != nw && if (s->bpos != nw &&
lseek(s->fd, (off_t)s->bpos - (off_t)nw, SEEK_CUR) == (off_t)-1) { lseek(s->fd, (off_t)s->bpos - (off_t)nw, SEEK_CUR) == (off_t)-1) {
} }
@ -563,7 +554,7 @@ void ios_close(ios_t *s)
if (s->fd != -1 && s->ownfd) if (s->fd != -1 && s->ownfd)
close(s->fd); close(s->fd);
s->fd = -1; s->fd = -1;
if (s->buf!=NULL && s->ownbuf && s->buf!=&s->local[0]) if (s->buf != NULL && s->ownbuf && s->buf != &s->local[0])
LLT_FREE(s->buf); LLT_FREE(s->buf);
s->buf = NULL; s->buf = NULL;
s->size = s->maxsize = s->bpos = 0; s->size = s->maxsize = s->bpos = 0;
@ -575,8 +566,7 @@ static void _buf_init(ios_t *s, bufmode_t bm)
if (s->bm == bm_mem || s->bm == bm_none) { if (s->bm == bm_mem || s->bm == bm_none) {
s->buf = &s->local[0]; s->buf = &s->local[0];
s->maxsize = IOS_INLSIZE; s->maxsize = IOS_INLSIZE;
} } else {
else {
s->buf = NULL; s->buf = NULL;
_buf_realloc(s, IOS_BUFSIZE); _buf_realloc(s, IOS_BUFSIZE);
} }
@ -590,18 +580,17 @@ char *ios_takebuf(ios_t *s, size_t *psize)
ios_flush(s); ios_flush(s);
if (s->buf == &s->local[0]) { if (s->buf == &s->local[0]) {
buf = LLT_ALLOC(s->size+1); buf = LLT_ALLOC(s->size + 1);
if (buf == NULL) if (buf == NULL)
return NULL; return NULL;
if (s->size) if (s->size)
memcpy(buf, s->buf, s->size); memcpy(buf, s->buf, s->size);
} } else {
else {
buf = s->buf; buf = s->buf;
} }
buf[s->size] = '\0'; buf[s->size] = '\0';
*psize = s->size+1; // buffer is actually 1 bigger for terminating NUL *psize = s->size + 1; // buffer is actually 1 bigger for terminating NUL
/* empty stream and reinitialize */ /* empty stream and reinitialize */
_buf_init(s, s->bm); _buf_init(s, s->bm);
@ -612,7 +601,7 @@ char *ios_takebuf(ios_t *s, size_t *psize)
int ios_setbuf(ios_t *s, char *buf, size_t size, int own) int ios_setbuf(ios_t *s, char *buf, size_t size, int own)
{ {
ios_flush(s); ios_flush(s);
size_t nvalid=0; size_t nvalid = 0;
nvalid = (size < s->size) ? size : s->size; nvalid = (size < s->size) ? size : s->size;
if (nvalid > 0) if (nvalid > 0)
@ -623,7 +612,7 @@ int ios_setbuf(ios_t *s, char *buf, size_t size, int own)
} }
s->size = nvalid; s->size = nvalid;
if (s->buf!=NULL && s->ownbuf && s->buf!=&s->local[0]) if (s->buf != NULL && s->ownbuf && s->buf != &s->local[0])
LLT_FREE(s->buf); LLT_FREE(s->buf);
s->buf = buf; s->buf = buf;
s->maxsize = size; s->maxsize = size;
@ -642,7 +631,8 @@ int ios_bufmode(ios_t *s, bufmode_t mode)
void ios_set_readonly(ios_t *s) void ios_set_readonly(ios_t *s)
{ {
if (s->readonly) return; if (s->readonly)
return;
ios_flush(s); ios_flush(s);
s->state = bst_none; s->state = bst_none;
s->readonly = 1; s->readonly = 1;
@ -653,14 +643,14 @@ static size_t ios_copy_(ios_t *to, ios_t *from, size_t nbytes, bool_t all)
size_t total = 0, avail; size_t total = 0, avail;
if (!ios_eof(from)) { if (!ios_eof(from)) {
do { do {
avail = ios_readprep(from, IOS_BUFSIZE/2); avail = ios_readprep(from, IOS_BUFSIZE / 2);
if (avail == 0) { if (avail == 0) {
from->_eof = 1; from->_eof = 1;
break; break;
} }
size_t written, ntowrite; size_t written, ntowrite;
ntowrite = (avail <= nbytes || all) ? avail : nbytes; ntowrite = (avail <= nbytes || all) ? avail : nbytes;
written = ios_write(to, from->buf+from->bpos, ntowrite); written = ios_write(to, from->buf + from->bpos, ntowrite);
// TODO: should this be +=written instead? // TODO: should this be +=written instead?
from->bpos += ntowrite; from->bpos += ntowrite;
total += written; total += written;
@ -690,7 +680,7 @@ size_t ios_copyall(ios_t *to, ios_t *from)
size_t ios_copyuntil(ios_t *to, ios_t *from, char delim) size_t ios_copyuntil(ios_t *to, ios_t *from, char delim)
{ {
size_t total = 0, avail=from->size - from->bpos; size_t total = 0, avail = from->size - from->bpos;
int first = 1; int first = 1;
if (!ios_eof(from)) { if (!ios_eof(from)) {
do { do {
@ -699,16 +689,15 @@ size_t ios_copyuntil(ios_t *to, ios_t *from, char delim)
avail = ios_readprep(from, LINE_CHUNK_SIZE); avail = ios_readprep(from, LINE_CHUNK_SIZE);
} }
size_t written; size_t written;
char *pd = (char*)memchr(from->buf+from->bpos, delim, avail); char *pd = (char *)memchr(from->buf + from->bpos, delim, avail);
if (pd == NULL) { if (pd == NULL) {
written = ios_write(to, from->buf+from->bpos, avail); written = ios_write(to, from->buf + from->bpos, avail);
from->bpos += avail; from->bpos += avail;
total += written; total += written;
avail = 0; avail = 0;
} } else {
else { size_t ntowrite = pd - (from->buf + from->bpos) + 1;
size_t ntowrite = pd - (from->buf+from->bpos) + 1; written = ios_write(to, from->buf + from->bpos, ntowrite);
written = ios_write(to, from->buf+from->bpos, ntowrite);
from->bpos += ntowrite; from->bpos += ntowrite;
total += written; total += written;
return total; return total;
@ -749,16 +738,18 @@ ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc)
// must specify read and/or write // must specify read and/or write
goto open_file_err; goto open_file_err;
int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY; int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY;
if (create) flags |= O_CREAT; if (create)
if (trunc) flags |= O_TRUNC; flags |= O_CREAT;
fd = open(fname, flags, S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH/*644*/); if (trunc)
flags |= O_TRUNC;
fd = open(fname, flags, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH /*644*/);
s = ios_fd(s, fd, 1, 1); s = ios_fd(s, fd, 1, 1);
if (fd == -1) if (fd == -1)
goto open_file_err; goto open_file_err;
if (!wr) if (!wr)
s->readonly = 1; s->readonly = 1;
return s; return s;
open_file_err: open_file_err:
s->fd = -1; s->fd = -1;
return NULL; return NULL;
} }
@ -774,8 +765,9 @@ ios_t *ios_mem(ios_t *s, size_t initsize)
ios_t *ios_str(ios_t *s, char *str) ios_t *ios_str(ios_t *s, char *str)
{ {
size_t n = strlen(str); size_t n = strlen(str);
if (ios_mem(s, n+1)==NULL) return NULL; if (ios_mem(s, n + 1) == NULL)
ios_write(s, str, n+1); return NULL;
ios_write(s, str, n + 1);
ios_seek(s, 0); ios_seek(s, 0);
return s; return s;
} }
@ -793,7 +785,8 @@ ios_t *ios_fd(ios_t *s, long fd, int isfile, int own)
{ {
_ios_init(s); _ios_init(s);
s->fd = fd; s->fd = fd;
if (isfile) s->rereadable = 1; if (isfile)
s->rereadable = 1;
_buf_init(s, bm_block); _buf_init(s, bm_block);
s->ownfd = own; s->ownfd = own;
if (fd == STDERR_FILENO) if (fd == STDERR_FILENO)
@ -840,13 +833,14 @@ int ios_getc(ios_t *s)
char ch; char ch;
if (s->state == bst_rd && s->bpos < s->size) { if (s->state == bst_rd && s->bpos < s->size) {
ch = s->buf[s->bpos++]; ch = s->buf[s->bpos++];
} } else {
else { if (s->_eof)
if (s->_eof) return IOS_EOF; return IOS_EOF;
if (ios_read(s, &ch, 1) < 1) if (ios_read(s, &ch, 1) < 1)
return IOS_EOF; return IOS_EOF;
} }
if (ch == '\n') s->lineno++; if (ch == '\n')
s->lineno++;
return (unsigned char)ch; return (unsigned char)ch;
} }
@ -854,9 +848,11 @@ int ios_peekc(ios_t *s)
{ {
if (s->bpos < s->size) if (s->bpos < s->size)
return (unsigned char)s->buf[s->bpos]; return (unsigned char)s->buf[s->bpos];
if (s->_eof) return IOS_EOF; if (s->_eof)
return IOS_EOF;
size_t n = ios_readprep(s, 1); size_t n = ios_readprep(s, 1);
if (n == 0) return IOS_EOF; if (n == 0)
return IOS_EOF;
return (unsigned char)s->buf[s->bpos]; return (unsigned char)s->buf[s->bpos];
} }
@ -871,7 +867,7 @@ int ios_ungetc(int c, ios_t *s)
return c; return c;
} }
if (s->size == s->maxsize) { if (s->size == s->maxsize) {
if (_buf_realloc(s, s->maxsize*2) == NULL) if (_buf_realloc(s, s->maxsize * 2) == NULL)
return IOS_EOF; return IOS_EOF;
} }
memmove(s->buf + 1, s->buf, s->size); memmove(s->buf + 1, s->buf, s->size);
@ -896,7 +892,7 @@ int ios_getutf8(ios_t *s, uint32_t *pwc)
*pwc = (uint32_t)(unsigned char)c0; *pwc = (uint32_t)(unsigned char)c0;
return 1; return 1;
} }
sz = u8_seqlen(&c0)-1; sz = u8_seqlen(&c0) - 1;
if (ios_ungetc(c, s) == IOS_EOF) if (ios_ungetc(c, s) == IOS_EOF)
return IOS_EOF; return IOS_EOF;
if (ios_readprep(s, sz) < sz) if (ios_readprep(s, sz) < sz)
@ -904,7 +900,7 @@ int ios_getutf8(ios_t *s, uint32_t *pwc)
return IOS_EOF; return IOS_EOF;
size_t i = s->bpos; size_t i = s->bpos;
*pwc = u8_nextchar(s->buf, &i); *pwc = u8_nextchar(s->buf, &i);
ios_read(s, buf, sz+1); ios_read(s, buf, sz + 1);
return 1; return 1;
} }
@ -922,7 +918,7 @@ int ios_peekutf8(ios_t *s, uint32_t *pwc)
*pwc = (uint32_t)(unsigned char)c0; *pwc = (uint32_t)(unsigned char)c0;
return 1; return 1;
} }
sz = u8_seqlen(&c0)-1; sz = u8_seqlen(&c0) - 1;
if (ios_readprep(s, sz) < sz) if (ios_readprep(s, sz) < sz)
return IOS_EOF; return IOS_EOF;
size_t i = s->bpos; size_t i = s->bpos;
@ -959,7 +955,7 @@ int vasprintf(char **strp, const char *fmt, va_list ap);
int ios_vprintf(ios_t *s, const char *format, va_list args) int ios_vprintf(ios_t *s, const char *format, va_list args)
{ {
char *str=NULL; char *str = NULL;
int c; int c;
va_list al; va_list al;
va_copy(al, args); va_copy(al, args);

42
llt/ios.h
View File

@ -23,33 +23,33 @@ typedef struct {
int errcode; int errcode;
char *buf; // start of buffer char *buf; // start of buffer
size_t maxsize; // space allocated to buffer size_t maxsize; // space allocated to buffer
size_t size; // length of valid data in buf, >=ndirty size_t size; // length of valid data in buf, >=ndirty
size_t bpos; // current position in buffer size_t bpos; // current position in buffer
size_t ndirty; // # bytes at &buf[0] that need to be written size_t ndirty; // # bytes at &buf[0] that need to be written
off_t fpos; // cached file pos off_t fpos; // cached file pos
size_t lineno; // current line number size_t lineno; // current line number
// pointer-size integer to support platforms where it might have // pointer-size integer to support platforms where it might have
// to be a pointer // to be a pointer
long fd; long fd;
unsigned char readonly:1; unsigned char readonly : 1;
unsigned char ownbuf:1; unsigned char ownbuf : 1;
unsigned char ownfd:1; unsigned char ownfd : 1;
unsigned char _eof:1; unsigned char _eof : 1;
// this means you can read, seek back, then read the same data // this means you can read, seek back, then read the same data
// again any number of times. usually only true for files and strings. // again any number of times. usually only true for files and strings.
unsigned char rereadable:1; unsigned char rereadable : 1;
// this enables "stenciled writes". you can alternately write and // this enables "stenciled writes". you can alternately write and
// seek without flushing in between. this performs read-before-write // seek without flushing in between. this performs read-before-write
// to populate the buffer, so "rereadable" capability is required. // to populate the buffer, so "rereadable" capability is required.
// this is off by default. // this is off by default.
//unsigned char stenciled:1; // unsigned char stenciled:1;
// request durable writes (fsync) // request durable writes (fsync)
// unsigned char durable:1; // unsigned char durable:1;
@ -62,10 +62,10 @@ typedef struct {
size_t ios_read(ios_t *s, char *dest, size_t n); size_t ios_read(ios_t *s, char *dest, size_t n);
size_t ios_readall(ios_t *s, char *dest, size_t n); size_t ios_readall(ios_t *s, char *dest, size_t n);
size_t ios_write(ios_t *s, char *data, size_t n); size_t ios_write(ios_t *s, char *data, size_t n);
off_t ios_seek(ios_t *s, off_t pos); // absolute seek off_t ios_seek(ios_t *s, off_t pos); // absolute seek
off_t ios_seek_end(ios_t *s); off_t ios_seek_end(ios_t *s);
off_t ios_skip(ios_t *s, off_t offs); // relative seek off_t ios_skip(ios_t *s, off_t offs); // relative seek
off_t ios_pos(ios_t *s); // get current position off_t ios_pos(ios_t *s); // get current position
size_t ios_trunc(ios_t *s, size_t size); size_t ios_trunc(ios_t *s, size_t size);
int ios_eof(ios_t *s); int ios_eof(ios_t *s);
int ios_flush(ios_t *s); int ios_flush(ios_t *s);
@ -80,9 +80,9 @@ size_t ios_copyall(ios_t *to, ios_t *from);
size_t ios_copyuntil(ios_t *to, ios_t *from, char delim); size_t ios_copyuntil(ios_t *to, ios_t *from, char delim);
// ensure at least n bytes are buffered if possible. returns # available. // ensure at least n bytes are buffered if possible. returns # available.
size_t ios_readprep(ios_t *from, size_t n); size_t ios_readprep(ios_t *from, size_t n);
//void ios_lock(ios_t *s); // void ios_lock(ios_t *s);
//int ios_trylock(ios_t *s); // int ios_trylock(ios_t *s);
//int ios_unlock(ios_t *s); // int ios_unlock(ios_t *s);
/* stream creation */ /* stream creation */
ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc); ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc);
@ -126,12 +126,12 @@ int ios_prevutf8(ios_t *s);
/* stdio-style functions */ /* stdio-style functions */
#define IOS_EOF (-1) #define IOS_EOF (-1)
int ios_putc(int c, ios_t *s); int ios_putc(int c, ios_t *s);
//wint_t ios_putwc(ios_t *s, wchar_t wc); // wint_t ios_putwc(ios_t *s, wchar_t wc);
int ios_getc(ios_t *s); int ios_getc(ios_t *s);
int ios_peekc(ios_t *s); int ios_peekc(ios_t *s);
//wint_t ios_getwc(ios_t *s); // wint_t ios_getwc(ios_t *s);
int ios_ungetc(int c, ios_t *s); int ios_ungetc(int c, ios_t *s);
//wint_t ios_ungetwc(ios_t *s, wint_t wc); // wint_t ios_ungetwc(ios_t *s, wint_t wc);
#define ios_puts(str, s) ios_write(s, str, strlen(str)) #define ios_puts(str, s) ios_write(s, str, strlen(str))
/* /*

24
llt/lltinit.c
View File

@ -13,10 +13,10 @@ double D_PNAN;
double D_NNAN; double D_NNAN;
double D_PINF; double D_PINF;
double D_NINF; double D_NINF;
float F_PNAN; float F_PNAN;
float F_NNAN; float F_NNAN;
float F_PINF; float F_PINF;
float F_NINF; float F_NINF;
int locale_is_utf8; int locale_is_utf8;
@ -28,12 +28,12 @@ void llt_init()
ios_init_stdstreams(); ios_init_stdstreams();
D_PNAN = strtod("+NaN",NULL); D_PNAN = strtod("+NaN", NULL);
D_NNAN = -strtod("+NaN",NULL); D_NNAN = -strtod("+NaN", NULL);
D_PINF = strtod("+Inf",NULL); D_PINF = strtod("+Inf", NULL);
D_NINF = strtod("-Inf",NULL); D_NINF = strtod("-Inf", NULL);
F_PNAN = strtof("+NaN",NULL); F_PNAN = strtof("+NaN", NULL);
F_NNAN = -strtof("+NaN",NULL); F_NNAN = -strtof("+NaN", NULL);
F_PINF = strtof("+Inf",NULL); F_PINF = strtof("+Inf", NULL);
F_NINF = strtof("-Inf",NULL); F_NINF = strtof("-Inf", NULL);
} }

1023
llt/lookup3.c
View File

File diff suppressed because it is too large Load Diff

88
llt/mt19937ar.c
View File

@ -1,12 +1,12 @@
/* /*
A C-program for MT19937, with initialization improved 2002/1/26. A C-program for MT19937, with initialization improved 2002/1/26.
Coded by Takuji Nishimura and Makoto Matsumoto. Coded by Takuji Nishimura and Makoto Matsumoto.
Before using, initialize the state by using init_genrand(seed) Before using, initialize the state by using init_genrand(seed)
or init_by_array(init_key, key_length). or init_by_array(init_key, key_length).
Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions modification, are permitted provided that the following conditions
@ -19,15 +19,15 @@
notice, this list of conditions and the following disclaimer in the notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution. documentation and/or other materials provided with the distribution.
3. The names of its contributors may not be used to endorse or promote 3. The names of its contributors may not be used to endorse or promote
products derived from this software without specific prior written products derived from this software without specific prior written
permission. permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
@ -43,23 +43,22 @@
#include <stdio.h> #include <stdio.h>
/* Period parameters */ /* Period parameters */
#define mtN 624 #define mtN 624
#define mtM 397 #define mtM 397
#define MATRIX_A 0x9908b0dfU /* constant vector a */ #define MATRIX_A 0x9908b0dfU /* constant vector a */
#define UPPER_MASK 0x80000000U /* most significant w-r bits */ #define UPPER_MASK 0x80000000U /* most significant w-r bits */
#define LOWER_MASK 0x7fffffffU /* least significant r bits */ #define LOWER_MASK 0x7fffffffU /* least significant r bits */
static uint32_t mt[mtN]; /* the array for the state vector */ static uint32_t mt[mtN]; /* the array for the state vector */
static int mti=mtN+1; /* mti==mtN+1 means mt[mtN] is not initialized */ static int mti = mtN + 1; /* mti==mtN+1 means mt[mtN] is not initialized */
/* initializes mt[mtN] with a seed */ /* initializes mt[mtN] with a seed */
void init_genrand(uint32_t s) void init_genrand(uint32_t s)
{ {
mt[0]= s & 0xffffffffU; mt[0] = s & 0xffffffffU;
for (mti=1; mti<mtN; mti++) { for (mti = 1; mti < mtN; mti++) {
mt[mti] = mt[mti] = (1812433253U * (mt[mti - 1] ^ (mt[mti - 1] >> 30)) + mti);
(1812433253U * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
/* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */ /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
/* In the previous versions, MSBs of the seed affect */ /* In the previous versions, MSBs of the seed affect */
/* only MSBs of the array mt[]. */ /* only MSBs of the array mt[]. */
@ -77,54 +76,63 @@ void init_by_array(uint32_t init_key[], int key_length)
{ {
int i, j, k; int i, j, k;
init_genrand(19650218U); init_genrand(19650218U);
i=1; j=0; i = 1;
k = (mtN>key_length ? mtN : key_length); j = 0;
k = (mtN > key_length ? mtN : key_length);
for (; k; k--) { for (; k; k--) {
mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525U)) mt[i] = (mt[i] ^ ((mt[i - 1] ^ (mt[i - 1] >> 30)) * 1664525U)) +
+ init_key[j] + j; /* non linear */ init_key[j] + j; /* non linear */
mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */ mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
i++; j++; i++;
if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; } j++;
if (j>=key_length) j=0; if (i >= mtN) {
mt[0] = mt[mtN - 1];
i = 1;
}
if (j >= key_length)
j = 0;
} }
for (k=mtN-1; k; k--) { for (k = mtN - 1; k; k--) {
mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941U)) mt[i] = (mt[i] ^ ((mt[i - 1] ^ (mt[i - 1] >> 30)) * 1566083941U)) -
- i; /* non linear */ i; /* non linear */
mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */ mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
i++; i++;
if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; } if (i >= mtN) {
mt[0] = mt[mtN - 1];
i = 1;
}
} }
mt[0] = 0x80000000U; /* MSB is 1; assuring non-zero initial array */ mt[0] = 0x80000000U; /* MSB is 1; assuring non-zero initial array */
} }
/* generates a random number on [0,0xffffffff]-interval */ /* generates a random number on [0,0xffffffff]-interval */
uint32_t genrand_int32(void) uint32_t genrand_int32(void)
{ {
uint32_t y; uint32_t y;
static uint32_t mag01[2]={0x0U, MATRIX_A}; static uint32_t mag01[2] = { 0x0U, MATRIX_A };
/* mag01[x] = x * MATRIX_A for x=0,1 */ /* mag01[x] = x * MATRIX_A for x=0,1 */
if (mti >= mtN) { /* generate mtN words at one time */ if (mti >= mtN) { /* generate mtN words at one time */
int kk; int kk;
if (mti == mtN+1) /* if init_genrand() has not been called, */ if (mti == mtN + 1) /* if init_genrand() has not been called, */
init_genrand(5489U); /* a default initial seed is used */ init_genrand(5489U); /* a default initial seed is used */
for (kk=0;kk<mtN-mtM;kk++) { for (kk = 0; kk < mtN - mtM; kk++) {
y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK); y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK);
mt[kk] = mt[kk+mtM] ^ (y >> 1) ^ mag01[y & 0x1U]; mt[kk] = mt[kk + mtM] ^ (y >> 1) ^ mag01[y & 0x1U];
} }
for (;kk<mtN-1;kk++) { for (; kk < mtN - 1; kk++) {
y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK); y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK);
mt[kk] = mt[kk+(mtM-mtN)] ^ (y >> 1) ^ mag01[y & 0x1U]; mt[kk] = mt[kk + (mtM - mtN)] ^ (y >> 1) ^ mag01[y & 0x1U];
} }
y = (mt[mtN-1]&UPPER_MASK)|(mt[0]&LOWER_MASK); y = (mt[mtN - 1] & UPPER_MASK) | (mt[0] & LOWER_MASK);
mt[mtN-1] = mt[mtM-1] ^ (y >> 1) ^ mag01[y & 0x1U]; mt[mtN - 1] = mt[mtM - 1] ^ (y >> 1) ^ mag01[y & 0x1U];
mti = 0; mti = 0;
} }
y = mt[mti++]; y = mt[mti++];
/* Tempering */ /* Tempering */
@ -169,7 +177,7 @@ double genrand_res53(void)
{ {
uint32_t a=genrand_int32()>>5, b=genrand_int32()>>6; uint32_t a=genrand_int32()>>5, b=genrand_int32()>>6;
return(a*67108864.0+b)*(1.0/9007199254740992.0); return(a*67108864.0+b)*(1.0/9007199254740992.0);
} }
#endif #endif
/* These real versions are due to Isaku Wada, 2002/01/09 added */ /* These real versions are due to Isaku Wada, 2002/01/09 added */
#if 0 #if 0

28
llt/ptrhash.c
View File

@ -12,29 +12,29 @@
#include "dtypes.h" #include "dtypes.h"
#include "ptrhash.h" #include "ptrhash.h"
#define OP_EQ(x,y) ((x)==(y)) #define OP_EQ(x, y) ((x) == (y))
#ifdef BITS64 #ifdef BITS64
static u_int64_t _pinthash(u_int64_t key) static u_int64_t _pinthash(u_int64_t key)
{ {
key = (~key) + (key << 21); // key = (key << 21) - key - 1; key = (~key) + (key << 21); // key = (key << 21) - key - 1;
key = key ^ (key >> 24); key = key ^ (key >> 24);
key = (key + (key << 3)) + (key << 8); // key * 265 key = (key + (key << 3)) + (key << 8); // key * 265
key = key ^ (key >> 14); key = key ^ (key >> 14);
key = (key + (key << 2)) + (key << 4); // key * 21 key = (key + (key << 2)) + (key << 4); // key * 21
key = key ^ (key >> 28); key = key ^ (key >> 28);
key = key + (key << 31); key = key + (key << 31);
return key; return key;
} }
#else #else
static u_int32_t _pinthash(u_int32_t a) static u_int32_t _pinthash(u_int32_t a)
{ {
a = (a+0x7ed55d16) + (a<<12); a = (a + 0x7ed55d16) + (a << 12);
a = (a^0xc761c23c) ^ (a>>19); a = (a ^ 0xc761c23c) ^ (a >> 19);
a = (a+0x165667b1) + (a<<5); a = (a + 0x165667b1) + (a << 5);
a = (a+0xd3a2646c) ^ (a<<9); a = (a + 0xd3a2646c) ^ (a << 9);
a = (a+0xfd7046c5) + (a<<3); a = (a + 0xfd7046c5) + (a << 3);
a = (a^0xb55a4f09) ^ (a>>16); a = (a ^ 0xb55a4f09) ^ (a >> 16);
return a; return a;
} }
#endif #endif

14
llt/random.c
View File

@ -19,7 +19,7 @@ double rand_double()
d.ieee.mantissa0 = genrand_int32(); d.ieee.mantissa0 = genrand_int32();
d.ieee.mantissa1 = genrand_int32(); d.ieee.mantissa1 = genrand_int32();
d.ieee.negative = 0; d.ieee.negative = 0;
d.ieee.exponent = IEEE754_DOUBLE_BIAS + 0; /* 2^0 */ d.ieee.exponent = IEEE754_DOUBLE_BIAS + 0; /* 2^0 */
return d.d - 1.0; return d.d - 1.0;
} }
@ -29,7 +29,7 @@ float rand_float()
f.ieee.mantissa = genrand_int32(); f.ieee.mantissa = genrand_int32();
f.ieee.negative = 0; f.ieee.negative = 0;
f.ieee.exponent = IEEE754_FLOAT_BIAS + 0; /* 2^0 */ f.ieee.exponent = IEEE754_FLOAT_BIAS + 0; /* 2^0 */
return f.f - 1.0; return f.f - 1.0;
} }
@ -46,11 +46,11 @@ double randn()
do { do {
ure = rand_double(); ure = rand_double();
uim = rand_double(); uim = rand_double();
vre = 2*ure - 1; vre = 2 * ure - 1;
vim = 2*uim - 1; vim = 2 * uim - 1;
s = vre*vre + vim*vim; s = vre * vre + vim * vim;
} while (s >= 1); } while (s >= 1);
s = sqrt(-2*log(s)/s); s = sqrt(-2 * log(s) / s);
next = s * vre; next = s * vre;
return s * vim; return s * vim;
} }
@ -58,5 +58,5 @@ double randn()
void randomize() void randomize()
{ {
u_int64_t tm = i64time(); u_int64_t tm = i64time();
init_by_array((uint32_t*)&tm, 2); init_by_array((uint32_t *)&tm, 2);
} }

61
llt/socket.c
View File

@ -15,7 +15,6 @@
#include "socket.h" #include "socket.h"
int mysocket(int domain, int type, int protocol) int mysocket(int domain, int type, int protocol)
{ {
int val; int val;
@ -23,16 +22,16 @@ int mysocket(int domain, int type, int protocol)
if (s < 0) if (s < 0)
return s; return s;
val = 4096; val = 4096;
setsockopt(s, SOL_SOCKET, SO_RCVBUF, (char*)&val, sizeof(int)); setsockopt(s, SOL_SOCKET, SO_RCVBUF, (char *)&val, sizeof(int));
val = 4096; val = 4096;
setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char*)&val, sizeof(int)); setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char *)&val, sizeof(int));
return s; return s;
} }
void set_nonblock(int socket, int yes) void set_nonblock(int socket, int yes)
{ {
int flags; int flags;
flags = fcntl(socket,F_GETFL,0); flags = fcntl(socket, F_GETFL, 0);
assert(flags != -1); assert(flags != -1);
if (yes) if (yes)
fcntl(socket, F_SETFL, flags | O_NONBLOCK); fcntl(socket, F_SETFL, flags | O_NONBLOCK);
@ -41,10 +40,7 @@ void set_nonblock(int socket, int yes)
} }
#ifdef WIN32 #ifdef WIN32
void bzero(void *s, size_t n) void bzero(void *s, size_t n) { memset(s, 0, n); }
{
memset(s, 0, n);
}
#endif #endif
/* returns a socket on which to accept() connections */ /* returns a socket on which to accept() connections */
@ -60,7 +56,7 @@ int open_tcp_port(short portno)
serv_addr.sin_family = AF_INET; serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = htonl(INADDR_ANY); serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
serv_addr.sin_port = htons(portno); serv_addr.sin_port = htons(portno);
if (bind(sockfd, (struct sockaddr*)&serv_addr, sizeof(serv_addr)) < 0) { if (bind(sockfd, (struct sockaddr *)&serv_addr, sizeof(serv_addr)) < 0) {
return -1; return -1;
} }
@ -83,7 +79,8 @@ int open_any_tcp_port(short *portno)
serv_addr.sin_family = AF_INET; serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = htonl(INADDR_ANY); serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
serv_addr.sin_port = htons(*portno); serv_addr.sin_port = htons(*portno);
while (bind(sockfd, (struct sockaddr*)&serv_addr, sizeof(serv_addr)) < 0) { while (bind(sockfd, (struct sockaddr *)&serv_addr, sizeof(serv_addr)) <
0) {
(*portno)++; (*portno)++;
serv_addr.sin_port = htons(*portno); serv_addr.sin_port = htons(*portno);
} }
@ -106,7 +103,8 @@ int open_any_udp_port(short *portno)
serv_addr.sin_family = AF_INET; serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = htonl(INADDR_ANY); serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
serv_addr.sin_port = htons(*portno); serv_addr.sin_port = htons(*portno);
while (bind(sockfd, (struct sockaddr*)&serv_addr, sizeof(serv_addr)) < 0) { while (bind(sockfd, (struct sockaddr *)&serv_addr, sizeof(serv_addr)) <
0) {
(*portno)++; (*portno)++;
serv_addr.sin_port = htons(*portno); serv_addr.sin_port = htons(*portno);
} }
@ -115,17 +113,14 @@ int open_any_udp_port(short *portno)
} }
#ifndef WIN32 #ifndef WIN32
void closesocket(int fd) void closesocket(int fd) { close(fd); }
{
close(fd);
}
#endif #endif
/* returns a socket to use to send data to the given address */ /* returns a socket to use to send data to the given address */
int connect_to_host(char *hostname, short portno) int connect_to_host(char *hostname, short portno)
{ {
struct hostent *host_info; struct hostent *host_info;
int sockfd, yes=1; int sockfd, yes = 1;
struct sockaddr_in host_addr; struct sockaddr_in host_addr;
host_info = gethostbyname(hostname); host_info = gethostbyname(hostname);
@ -138,14 +133,14 @@ int connect_to_host(char *hostname, short portno)
return -1; return -1;
} }
(void)setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int)); (void)setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int));
memset((char*)&host_addr, 0, sizeof(host_addr)); memset((char *)&host_addr, 0, sizeof(host_addr));
host_addr.sin_family = host_info->h_addrtype; host_addr.sin_family = host_info->h_addrtype;
memcpy((char*)&host_addr.sin_addr, host_info->h_addr, memcpy((char *)&host_addr.sin_addr, host_info->h_addr,
host_info->h_length); host_info->h_length);
host_addr.sin_port = htons(portno); host_addr.sin_port = htons(portno);
if (connect(sockfd, (struct sockaddr*)&host_addr, if (connect(sockfd, (struct sockaddr *)&host_addr,
sizeof(struct sockaddr_in)) != 0) { sizeof(struct sockaddr_in)) != 0) {
closesocket(sockfd); closesocket(sockfd);
return -1; return -1;
@ -156,7 +151,7 @@ int connect_to_host(char *hostname, short portno)
int connect_to_addr(struct sockaddr_in *host_addr) int connect_to_addr(struct sockaddr_in *host_addr)
{ {
int sockfd, yes=1; int sockfd, yes = 1;
sockfd = mysocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); sockfd = mysocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if (sockfd < 0) { if (sockfd < 0) {
@ -164,7 +159,7 @@ int connect_to_addr(struct sockaddr_in *host_addr)
} }
(void)setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int)); (void)setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int));
if (connect(sockfd, (struct sockaddr*)host_addr, if (connect(sockfd, (struct sockaddr *)host_addr,
sizeof(struct sockaddr_in)) != 0) { sizeof(struct sockaddr_in)) != 0) {
closesocket(sockfd); closesocket(sockfd);
return -1; return -1;
@ -176,33 +171,33 @@ int connect_to_addr(struct sockaddr_in *host_addr)
/* repeated send until all of buffer is sent */ /* repeated send until all of buffer is sent */
int sendall(int sockfd, char *buffer, int bufLen, int flags) int sendall(int sockfd, char *buffer, int bufLen, int flags)
{ {
int numBytesToSend=bufLen, length; int numBytesToSend = bufLen, length;
while (numBytesToSend>0) { while (numBytesToSend > 0) {
length = send(sockfd, (void *) buffer, numBytesToSend, flags); length = send(sockfd, (void *)buffer, numBytesToSend, flags);
if (length < 0) { if (length < 0) {
return(-1); return (-1);
} }
numBytesToSend -= length ; numBytesToSend -= length;
buffer += length ; buffer += length;
} }
return(bufLen); return (bufLen);
} }
/* repeated read until all of buffer is read */ /* repeated read until all of buffer is read */
int readall(int sockfd, char *buffer, int bufLen, int flags) int readall(int sockfd, char *buffer, int bufLen, int flags)
{ {
int numBytesToRead=bufLen, length; int numBytesToRead = bufLen, length;
while (numBytesToRead>0) { while (numBytesToRead > 0) {
length = recv(sockfd, buffer, numBytesToRead, flags); length = recv(sockfd, buffer, numBytesToRead, flags);
if (length <= 0) { if (length <= 0) {
return(length); return (length);
} }
numBytesToRead -= length; numBytesToRead -= length;
buffer += length; buffer += length;
} }
return(bufLen); return (bufLen);
} }
int addr_eq(struct sockaddr_in *a, struct sockaddr_in *b) int addr_eq(struct sockaddr_in *a, struct sockaddr_in *b)
@ -223,6 +218,6 @@ int socket_ready(int sock)
FD_ZERO(&fds); FD_ZERO(&fds);
FD_SET(sock, &fds); FD_SET(sock, &fds);
select(sock+1, &fds, NULL, NULL, &timeout); select(sock + 1, &fds, NULL, NULL, &timeout);
return FD_ISSET(sock, &fds); return FD_ISSET(sock, &fds);
} }

37
llt/timefuncs.c
View File

@ -35,12 +35,12 @@ double floattime()
struct timeb tstruct; struct timeb tstruct;
ftime(&tstruct); ftime(&tstruct);
return (double)tstruct.time + (double)tstruct.millitm/1.0e3; return (double)tstruct.time + (double)tstruct.millitm / 1.0e3;
} }
#else #else
double tv2float(struct timeval *tv) double tv2float(struct timeval *tv)
{ {
return (double)tv->tv_sec + (double)tv->tv_usec/1.0e6; return (double)tv->tv_sec + (double)tv->tv_usec / 1.0e6;
} }
double diff_time(struct timeval *tv1, struct timeval *tv2) double diff_time(struct timeval *tv1, struct timeval *tv2)
@ -56,11 +56,11 @@ u_int64_t i64time()
#ifdef WIN32 #ifdef WIN32
struct timeb tstruct; struct timeb tstruct;
ftime(&tstruct); ftime(&tstruct);
a = (((u_int64_t)tstruct.time)<<32) + (u_int64_t)tstruct.millitm; a = (((u_int64_t)tstruct.time) << 32) + (u_int64_t)tstruct.millitm;
#else #else
struct timeval now; struct timeval now;
gettimeofday(&now, NULL); gettimeofday(&now, NULL);
a = (((u_int64_t)now.tv_sec)<<32) + (u_int64_t)now.tv_usec; a = (((u_int64_t)now.tv_sec) << 32) + (u_int64_t)now.tv_usec;
#endif #endif
return a; return a;
@ -89,20 +89,24 @@ void timestring(double seconds, char *buffer, size_t len)
localtime_r(&tme, &tm); localtime_r(&tme, &tm);
strftime(buffer, len, fmt, &tm); strftime(buffer, len, fmt, &tm);
#else #else
static char *wdaystr[] = {"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}; static char *wdaystr[] = {
static char *monthstr[] = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug", "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"
"Sep","Oct","Nov","Dec"}; };
static char *monthstr[] = { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
struct tm *tm; struct tm *tm;
int hr; int hr;
tm = localtime(&tme); tm = localtime(&tme);
hr = tm->tm_hour; hr = tm->tm_hour;
if (hr > 12) hr -= 12; if (hr > 12)
if (hr == 0) hr = 12; hr -= 12;
if (hr == 0)
hr = 12;
snprintf(buffer, len, "%s %02d %s %d %02d:%02d:%02d %s %s", snprintf(buffer, len, "%s %02d %s %d %02d:%02d:%02d %s %s",
wdaystr[tm->tm_wday], tm->tm_mday, monthstr[tm->tm_mon], wdaystr[tm->tm_wday], tm->tm_mday, monthstr[tm->tm_mon],
tm->tm_year+1900, hr, tm->tm_min, tm->tm_sec, tm->tm_year + 1900, hr, tm->tm_min, tm->tm_sec,
tm->tm_hour>11 ? "PM" : "AM", ""); tm->tm_hour > 11 ? "PM" : "AM", "");
#endif #endif
} }
@ -117,8 +121,9 @@ double parsetime(const char *str)
res = strptime(str, fmt, &tm); res = strptime(str, fmt, &tm);
if (res != NULL) { if (res != NULL) {
tm.tm_isdst = -1; /* Not set by strptime(); tells mktime() to determine tm.tm_isdst =
whether daylight saving time is in effect */ -1; /* Not set by strptime(); tells mktime() to determine
whether daylight saving time is in effect */
t = mktime(&tm); t = mktime(&tm);
if (t == ((time_t)-1)) if (t == ((time_t)-1))
return -1; return -1;
@ -140,7 +145,7 @@ void sleep_ms(int ms)
#else #else
struct timeval timeout; struct timeval timeout;
timeout.tv_sec = ms/1000; timeout.tv_sec = ms / 1000;
timeout.tv_usec = (ms % 1000) * 1000; timeout.tv_usec = (ms % 1000) * 1000;
select(0, NULL, NULL, NULL, &timeout); select(0, NULL, NULL, NULL, &timeout);
#endif #endif
@ -154,12 +159,12 @@ void timeparts(int32_t *buf, double t)
struct tm tm; struct tm tm;
localtime_r(&tme, &tm); localtime_r(&tme, &tm);
tm.tm_year += 1900; tm.tm_year += 1900;
memcpy(buf, (char*)&tm, sizeof(struct tm)); memcpy(buf, (char *)&tm, sizeof(struct tm));
#else #else
struct tm *tm; struct tm *tm;
tm = localtime(&tme); tm = localtime(&tme);
tm->tm_year += 1900; tm->tm_year += 1900;
memcpy(buf, (char*)tm, sizeof(struct tm)); memcpy(buf, (char *)tm, sizeof(struct tm));
#endif #endif
} }

307
llt/utf8.c
View File

@ -34,20 +34,22 @@
#include "utf8.h" #include "utf8.h"
static const u_int32_t offsetsFromUTF8[6] = { static const u_int32_t offsetsFromUTF8[6] = { 0x00000000UL, 0x00003080UL,
0x00000000UL, 0x00003080UL, 0x000E2080UL, 0x000E2080UL, 0x03C82080UL,
0x03C82080UL, 0xFA082080UL, 0x82082080UL 0xFA082080UL, 0x82082080UL };
};
static const char trailingBytesForUTF8[256] = { static const char trailingBytesForUTF8[256] = {
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5
}; };
/* returns length of next utf-8 sequence */ /* returns length of next utf-8 sequence */
@ -73,9 +75,9 @@ size_t u8_charlen(u_int32_t ch)
size_t u8_codingsize(u_int32_t *wcstr, size_t n) size_t u8_codingsize(u_int32_t *wcstr, size_t n)
{ {
size_t i, c=0; size_t i, c = 0;
for(i=0; i < n; i++) for (i = 0; i < n; i++)
c += u8_charlen(wcstr[i]); c += u8_charlen(wcstr[i]);
return c; return c;
} }
@ -93,16 +95,17 @@ size_t u8_toucs(u_int32_t *dest, size_t sz, const char *src, size_t srcsz)
u_int32_t ch; u_int32_t ch;
const char *src_end = src + srcsz; const char *src_end = src + srcsz;
size_t nb; size_t nb;
size_t i=0; size_t i = 0;
if (sz == 0 || srcsz == 0) if (sz == 0 || srcsz == 0)
return 0; return 0;
while (i < sz) { while (i < sz) {
if (!isutf(*src)) { // invalid sequence if (!isutf(*src)) { // invalid sequence
dest[i++] = 0xFFFD; dest[i++] = 0xFFFD;
src++; src++;
if (src >= src_end) break; if (src >= src_end)
break;
continue; continue;
} }
nb = trailingBytesForUTF8[(unsigned char)*src]; nb = trailingBytesForUTF8[(unsigned char)*src];
@ -111,12 +114,23 @@ size_t u8_toucs(u_int32_t *dest, size_t sz, const char *src, size_t srcsz)
ch = 0; ch = 0;
switch (nb) { switch (nb) {
/* these fall through deliberately */ /* these fall through deliberately */
case 5: ch += (unsigned char)*src++; ch <<= 6; case 5:
case 4: ch += (unsigned char)*src++; ch <<= 6; ch += (unsigned char)*src++;
case 3: ch += (unsigned char)*src++; ch <<= 6; ch <<= 6;
case 2: ch += (unsigned char)*src++; ch <<= 6; case 4:
case 1: ch += (unsigned char)*src++; ch <<= 6; ch += (unsigned char)*src++;
case 0: ch += (unsigned char)*src++; ch <<= 6;
case 3:
ch += (unsigned char)*src++;
ch <<= 6;
case 2:
ch += (unsigned char)*src++;
ch <<= 6;
case 1:
ch += (unsigned char)*src++;
ch <<= 6;
case 0:
ch += (unsigned char)*src++;
} }
ch -= offsetsFromUTF8[nb]; ch -= offsetsFromUTF8[nb];
dest[i++] = ch; dest[i++] = ch;
@ -143,31 +157,28 @@ size_t u8_toutf8(char *dest, size_t sz, const u_int32_t *src, size_t srcsz)
if (dest >= dest_end) if (dest >= dest_end)
break; break;
*dest++ = (char)ch; *dest++ = (char)ch;
} } else if (ch < 0x800) {
else if (ch < 0x800) { if (dest >= dest_end - 1)
if (dest >= dest_end-1)
break; break;
*dest++ = (ch>>6) | 0xC0; *dest++ = (ch >> 6) | 0xC0;
*dest++ = (ch & 0x3F) | 0x80; *dest++ = (ch & 0x3F) | 0x80;
} } else if (ch < 0x10000) {
else if (ch < 0x10000) { if (dest >= dest_end - 2)
if (dest >= dest_end-2)
break; break;
*dest++ = (ch>>12) | 0xE0; *dest++ = (ch >> 12) | 0xE0;
*dest++ = ((ch>>6) & 0x3F) | 0x80; *dest++ = ((ch >> 6) & 0x3F) | 0x80;
*dest++ = (ch & 0x3F) | 0x80; *dest++ = (ch & 0x3F) | 0x80;
} } else if (ch < 0x110000) {
else if (ch < 0x110000) { if (dest >= dest_end - 3)
if (dest >= dest_end-3)
break; break;
*dest++ = (ch>>18) | 0xF0; *dest++ = (ch >> 18) | 0xF0;
*dest++ = ((ch>>12) & 0x3F) | 0x80; *dest++ = ((ch >> 12) & 0x3F) | 0x80;
*dest++ = ((ch>>6) & 0x3F) | 0x80; *dest++ = ((ch >> 6) & 0x3F) | 0x80;
*dest++ = (ch & 0x3F) | 0x80; *dest++ = (ch & 0x3F) | 0x80;
} }
i++; i++;
} }
return (dest-dest0); return (dest - dest0);
} }
size_t u8_wc_toutf8(char *dest, u_int32_t ch) size_t u8_wc_toutf8(char *dest, u_int32_t ch)
@ -177,20 +188,20 @@ size_t u8_wc_toutf8(char *dest, u_int32_t ch)
return 1; return 1;
} }
if (ch < 0x800) { if (ch < 0x800) {
dest[0] = (ch>>6) | 0xC0; dest[0] = (ch >> 6) | 0xC0;
dest[1] = (ch & 0x3F) | 0x80; dest[1] = (ch & 0x3F) | 0x80;
return 2; return 2;
} }
if (ch < 0x10000) { if (ch < 0x10000) {
dest[0] = (ch>>12) | 0xE0; dest[0] = (ch >> 12) | 0xE0;
dest[1] = ((ch>>6) & 0x3F) | 0x80; dest[1] = ((ch >> 6) & 0x3F) | 0x80;
dest[2] = (ch & 0x3F) | 0x80; dest[2] = (ch & 0x3F) | 0x80;
return 3; return 3;
} }
if (ch < 0x110000) { if (ch < 0x110000) {
dest[0] = (ch>>18) | 0xF0; dest[0] = (ch >> 18) | 0xF0;
dest[1] = ((ch>>12) & 0x3F) | 0x80; dest[1] = ((ch >> 12) & 0x3F) | 0x80;
dest[2] = ((ch>>6) & 0x3F) | 0x80; dest[2] = ((ch >> 6) & 0x3F) | 0x80;
dest[3] = (ch & 0x3F) | 0x80; dest[3] = (ch & 0x3F) | 0x80;
return 4; return 4;
} }
@ -200,7 +211,7 @@ size_t u8_wc_toutf8(char *dest, u_int32_t ch)
/* charnum => byte offset */ /* charnum => byte offset */
size_t u8_offset(const char *s, size_t charnum) size_t u8_offset(const char *s, size_t charnum)
{ {
size_t i=0; size_t i = 0;
while (charnum > 0) { while (charnum > 0) {
if (s[i++] & 0x80) { if (s[i++] & 0x80) {
@ -214,7 +225,7 @@ size_t u8_offset(const char *s, size_t charnum)
/* byte offset => charnum */ /* byte offset => charnum */
size_t u8_charnum(const char *s, size_t offset) size_t u8_charnum(const char *s, size_t offset)
{ {
size_t charnum = 0, i=0; size_t charnum = 0, i = 0;
while (i < offset) { while (i < offset) {
if (s[i++] & 0x80) { if (s[i++] & 0x80) {
@ -235,8 +246,9 @@ size_t u8_strlen(const char *s)
lasti = i; lasti = i;
while (s[i] > 0) while (s[i] > 0)
i++; i++;
count += (i-lasti); count += (i - lasti);
if (s[i++]==0) break; if (s[i++] == 0)
break;
(void)(isutf(s[++i]) || isutf(s[++i]) || ++i); (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
count++; count++;
} }
@ -250,31 +262,47 @@ size_t u8_strlen(const char *s)
size_t u8_strwidth(const char *s) size_t u8_strwidth(const char *s)
{ {
u_int32_t ch; u_int32_t ch;
size_t nb, tot=0; size_t nb, tot = 0;
int w; int w;
signed char sc; signed char sc;
while ((sc = (signed char)*s) != 0) { while ((sc = (signed char)*s) != 0) {
if (sc >= 0) { if (sc >= 0) {
s++; s++;
if (sc) tot++; if (sc)
} tot++;
else { } else {
if (!isutf(sc)) { tot++; s++; continue; } if (!isutf(sc)) {
tot++;
s++;
continue;
}
nb = trailingBytesForUTF8[(unsigned char)sc]; nb = trailingBytesForUTF8[(unsigned char)sc];
ch = 0; ch = 0;
switch (nb) { switch (nb) {
/* these fall through deliberately */ /* these fall through deliberately */
case 5: ch += (unsigned char)*s++; ch <<= 6; case 5:
case 4: ch += (unsigned char)*s++; ch <<= 6; ch += (unsigned char)*s++;
case 3: ch += (unsigned char)*s++; ch <<= 6; ch <<= 6;
case 2: ch += (unsigned char)*s++; ch <<= 6; case 4:
case 1: ch += (unsigned char)*s++; ch <<= 6; ch += (unsigned char)*s++;
case 0: ch += (unsigned char)*s++; ch <<= 6;
case 3:
ch += (unsigned char)*s++;
ch <<= 6;
case 2:
ch += (unsigned char)*s++;
ch <<= 6;
case 1:
ch += (unsigned char)*s++;
ch <<= 6;
case 0:
ch += (unsigned char)*s++;
} }
ch -= offsetsFromUTF8[nb]; ch -= offsetsFromUTF8[nb];
w = wcwidth(ch); // might return -1 w = wcwidth(ch); // might return -1
if (w > 0) tot += w; if (w > 0)
tot += w;
} }
} }
return tot; return tot;
@ -291,7 +319,7 @@ u_int32_t u8_nextchar(const char *s, size_t *i)
ch += (unsigned char)s[(*i)]; ch += (unsigned char)s[(*i)];
sz++; sz++;
} while (s[*i] && (++(*i)) && !isutf(s[*i])); } while (s[*i] && (++(*i)) && !isutf(s[*i]));
ch -= offsetsFromUTF8[sz-1]; ch -= offsetsFromUTF8[sz - 1];
return ch; return ch;
} }
@ -307,30 +335,28 @@ u_int32_t u8_nextmemchar(const char *s, size_t *i)
ch += (unsigned char)s[(*i)++]; ch += (unsigned char)s[(*i)++];
sz++; sz++;
} while (!isutf(s[*i])); } while (!isutf(s[*i]));
ch -= offsetsFromUTF8[sz-1]; ch -= offsetsFromUTF8[sz - 1];
return ch; return ch;
} }
void u8_inc(const char *s, size_t *i) void u8_inc(const char *s, size_t *i)
{ {
(void)(isutf(s[++(*i)]) || isutf(s[++(*i)]) || isutf(s[++(*i)]) || ++(*i)); (void)(isutf(s[++(*i)]) || isutf(s[++(*i)]) || isutf(s[++(*i)]) ||
++(*i));
} }
void u8_dec(const char *s, size_t *i) void u8_dec(const char *s, size_t *i)
{ {
(void)(isutf(s[--(*i)]) || isutf(s[--(*i)]) || isutf(s[--(*i)]) || --(*i)); (void)(isutf(s[--(*i)]) || isutf(s[--(*i)]) || isutf(s[--(*i)]) ||
--(*i));
} }
int octal_digit(char c) int octal_digit(char c) { return (c >= '0' && c <= '7'); }
{
return (c >= '0' && c <= '7');
}
int hex_digit(char c) int hex_digit(char c)
{ {
return ((c >= '0' && c <= '9') || return ((c >= '0' && c <= '9') || (c >= 'A' && c <= 'F') ||
(c >= 'A' && c <= 'F') ||
(c >= 'a' && c <= 'f')); (c >= 'a' && c <= 'f'));
} }
@ -362,29 +388,27 @@ size_t u8_read_escape_sequence(const char *str, size_t ssz, u_int32_t *dest)
assert(ssz > 0); assert(ssz > 0);
u_int32_t ch; u_int32_t ch;
char digs[10]; char digs[10];
int dno=0, ndig; int dno = 0, ndig;
size_t i=1; size_t i = 1;
char c0 = str[0]; char c0 = str[0];
if (octal_digit(c0)) { if (octal_digit(c0)) {
i = 0; i = 0;
do { do {
digs[dno++] = str[i++]; digs[dno++] = str[i++];
} while (i<ssz && octal_digit(str[i]) && dno<3); } while (i < ssz && octal_digit(str[i]) && dno < 3);
digs[dno] = '\0'; digs[dno] = '\0';
ch = strtol(digs, NULL, 8); ch = strtol(digs, NULL, 8);
} } else if ((c0 == 'x' && (ndig = 2)) || (c0 == 'u' && (ndig = 4)) ||
else if ((c0=='x' && (ndig=2)) || (c0 == 'U' && (ndig = 8))) {
(c0=='u' && (ndig=4)) || while (i < ssz && hex_digit(str[i]) && dno < ndig) {
(c0=='U' && (ndig=8))) {
while (i<ssz && hex_digit(str[i]) && dno<ndig) {
digs[dno++] = str[i++]; digs[dno++] = str[i++];
} }
if (dno == 0) return 0; if (dno == 0)
return 0;
digs[dno] = '\0'; digs[dno] = '\0';
ch = strtol(digs, NULL, 16); ch = strtol(digs, NULL, 16);
} } else {
else {
ch = (u_int32_t)read_escape_control_char(c0); ch = (u_int32_t)read_escape_control_char(c0);
} }
*dest = ch; *dest = ch;
@ -397,7 +421,7 @@ size_t u8_read_escape_sequence(const char *str, size_t ssz, u_int32_t *dest)
note the double backslash is needed if called on a C string literal */ note the double backslash is needed if called on a C string literal */
size_t u8_unescape(char *buf, size_t sz, const char *src) size_t u8_unescape(char *buf, size_t sz, const char *src)
{ {
size_t c=0, amt; size_t c = 0, amt;
u_int32_t ch; u_int32_t ch;
char temp[4]; char temp[4];
@ -405,14 +429,13 @@ size_t u8_unescape(char *buf, size_t sz, const char *src)
if (*src == '\\') { if (*src == '\\') {
src++; src++;
amt = u8_read_escape_sequence(src, 1000, &ch); amt = u8_read_escape_sequence(src, 1000, &ch);
} } else {
else {
ch = (u_int32_t)*src; ch = (u_int32_t)*src;
amt = 1; amt = 1;
} }
src += amt; src += amt;
amt = u8_wc_toutf8(temp, ch); amt = u8_wc_toutf8(temp, ch);
if (amt > sz-c) if (amt > sz - c)
break; break;
memcpy(&buf[c], temp, amt); memcpy(&buf[c], temp, amt);
c += amt; c += amt;
@ -463,32 +486,29 @@ int u8_escape_wchar(char *buf, size_t sz, u_int32_t ch)
return 1; return 1;
} }
size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end, size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi,
int escape_quotes, int ascii) size_t end, int escape_quotes, int ascii)
{ {
size_t i = *pi, i0; size_t i = *pi, i0;
u_int32_t ch; u_int32_t ch;
char *start = buf; char *start = buf;
char *blim = start + sz-11; char *blim = start + sz - 11;
assert(sz > 11); assert(sz > 11);
while (i<end && buf<blim) { while (i < end && buf < blim) {
// sz-11: leaves room for longest escape sequence // sz-11: leaves room for longest escape sequence
if (escape_quotes && src[i] == '"') { if (escape_quotes && src[i] == '"') {
buf += buf_put2c(buf, "\\\""); buf += buf_put2c(buf, "\\\"");
i++; i++;
} } else if (src[i] == '\\') {
else if (src[i] == '\\') {
buf += buf_put2c(buf, "\\\\"); buf += buf_put2c(buf, "\\\\");
i++; i++;
} } else {
else {
i0 = i; i0 = i;
ch = u8_nextmemchar(src, &i); ch = u8_nextmemchar(src, &i);
if (ascii || !iswprint((wint_t)ch)) { if (ascii || !iswprint((wint_t)ch)) {
buf += u8_escape_wchar(buf, sz - (buf-start), ch); buf += u8_escape_wchar(buf, sz - (buf - start), ch);
} } else {
else {
i = i0; i = i0;
do { do {
*buf++ = src[i++]; *buf++ = src[i++];
@ -498,12 +518,12 @@ size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end,
} }
*buf++ = '\0'; *buf++ = '\0';
*pi = i; *pi = i;
return (buf-start); return (buf - start);
} }
char *u8_strchr(const char *s, u_int32_t ch, size_t *charn) char *u8_strchr(const char *s, u_int32_t ch, size_t *charn)
{ {
size_t i = 0, lasti=0; size_t i = 0, lasti = 0;
u_int32_t c; u_int32_t c;
*charn = 0; *charn = 0;
@ -511,7 +531,7 @@ char *u8_strchr(const char *s, u_int32_t ch, size_t *charn)
c = u8_nextchar(s, &i); c = u8_nextchar(s, &i);
if (c == ch) { if (c == ch) {
/* it's const for us, but not necessarily the caller */ /* it's const for us, but not necessarily the caller */
return (char*)&s[lasti]; return (char *)&s[lasti];
} }
lasti = i; lasti = i;
(*charn)++; (*charn)++;
@ -521,7 +541,7 @@ char *u8_strchr(const char *s, u_int32_t ch, size_t *charn)
char *u8_memchr(const char *s, u_int32_t ch, size_t sz, size_t *charn) char *u8_memchr(const char *s, u_int32_t ch, size_t sz, size_t *charn)
{ {
size_t i = 0, lasti=0; size_t i = 0, lasti = 0;
u_int32_t c; u_int32_t c;
int csz; int csz;
@ -533,10 +553,10 @@ char *u8_memchr(const char *s, u_int32_t ch, size_t sz, size_t *charn)
c += (unsigned char)s[i++]; c += (unsigned char)s[i++];
csz++; csz++;
} while (i < sz && !isutf(s[i])); } while (i < sz && !isutf(s[i]));
c -= offsetsFromUTF8[csz-1]; c -= offsetsFromUTF8[csz - 1];
if (c == ch) { if (c == ch) {
return (char*)&s[lasti]; return (char *)&s[lasti];
} }
lasti = i; lasti = i;
(*charn)++; (*charn)++;
@ -546,18 +566,20 @@ char *u8_memchr(const char *s, u_int32_t ch, size_t sz, size_t *charn)
char *u8_memrchr(const char *s, u_int32_t ch, size_t sz) char *u8_memrchr(const char *s, u_int32_t ch, size_t sz)
{ {
size_t i = sz-1, tempi=0; size_t i = sz - 1, tempi = 0;
u_int32_t c; u_int32_t c;
if (sz == 0) return NULL; if (sz == 0)
return NULL;
while (i && !isutf(s[i])) i--; while (i && !isutf(s[i]))
i--;
while (1) { while (1) {
tempi = i; tempi = i;
c = u8_nextmemchar(s, &tempi); c = u8_nextmemchar(s, &tempi);
if (c == ch) { if (c == ch) {
return (char*)&s[i]; return (char *)&s[i];
} }
if (i == 0) if (i == 0)
break; break;
@ -571,18 +593,20 @@ char *u8_memrchr(const char *s, u_int32_t ch, size_t sz)
int u8_is_locale_utf8(const char *locale) int u8_is_locale_utf8(const char *locale)
{ {
if (locale == NULL) return 0; if (locale == NULL)
return 0;
/* this code based on libutf8 */ /* this code based on libutf8 */
const char* cp = locale; const char *cp = locale;
for (; *cp != '\0' && *cp != '@' && *cp != '+' && *cp != ','; cp++) { for (; *cp != '\0' && *cp != '@' && *cp != '+' && *cp != ','; cp++) {
if (*cp == '.') { if (*cp == '.') {
const char* encoding = ++cp; const char *encoding = ++cp;
for (; *cp != '\0' && *cp != '@' && *cp != '+' && *cp != ','; cp++) for (; *cp != '\0' && *cp != '@' && *cp != '+' && *cp != ',';
cp++)
; ;
if ((cp-encoding == 5 && !strncmp(encoding, "UTF-8", 5)) if ((cp - encoding == 5 && !strncmp(encoding, "UTF-8", 5)) ||
|| (cp-encoding == 4 && !strncmp(encoding, "utf8", 4))) (cp - encoding == 4 && !strncmp(encoding, "utf8", 4)))
return 1; /* it's UTF-8 */ return 1; /* it's UTF-8 */
break; break;
} }
@ -592,25 +616,26 @@ int u8_is_locale_utf8(const char *locale)
size_t u8_vprintf(const char *fmt, va_list ap) size_t u8_vprintf(const char *fmt, va_list ap)
{ {
size_t cnt, sz=0, nc, needfree=0; size_t cnt, sz = 0, nc, needfree = 0;
char *buf; char *buf;
u_int32_t *wcs; u_int32_t *wcs;
sz = 512; sz = 512;
buf = (char*)alloca(sz); buf = (char *)alloca(sz);
cnt = vsnprintf(buf, sz, fmt, ap); cnt = vsnprintf(buf, sz, fmt, ap);
if ((ssize_t)cnt < 0) if ((ssize_t)cnt < 0)
return 0; return 0;
if (cnt >= sz) { if (cnt >= sz) {
buf = (char*)malloc(cnt + 1); buf = (char *)malloc(cnt + 1);
needfree = 1; needfree = 1;
vsnprintf(buf, cnt+1, fmt, ap); vsnprintf(buf, cnt + 1, fmt, ap);
} }
wcs = (u_int32_t*)alloca((cnt+1) * sizeof(u_int32_t)); wcs = (u_int32_t *)alloca((cnt + 1) * sizeof(u_int32_t));
nc = u8_toucs(wcs, cnt+1, buf, cnt); nc = u8_toucs(wcs, cnt + 1, buf, cnt);
wcs[nc] = 0; wcs[nc] = 0;
printf("%ls", (wchar_t*)wcs); printf("%ls", (wchar_t *)wcs);
if (needfree) free(buf); if (needfree)
free(buf);
return nc; return nc;
} }
@ -633,11 +658,11 @@ size_t u8_printf(const char *fmt, ...)
it's hard to know how many characters there are! */ it's hard to know how many characters there are! */
int u8_isvalid(const char *str, int length) int u8_isvalid(const char *str, int length)
{ {
const unsigned char *p, *pend = (unsigned char*)str + length; const unsigned char *p, *pend = (unsigned char *)str + length;
unsigned char c; unsigned char c;
int ab; int ab;
for (p = (unsigned char*)str; p < pend; p++) { for (p = (unsigned char *)str; p < pend; p++) {
c = *p; c = *p;
if (c < 128) if (c < 128)
continue; continue;
@ -657,44 +682,49 @@ int u8_isvalid(const char *str, int length)
switch (ab) { switch (ab) {
/* Check for xx00 000x */ /* Check for xx00 000x */
case 1: case 1:
if ((c & 0x3e) == 0) return 0; if ((c & 0x3e) == 0)
continue; /* We know there aren't any more bytes to check */ return 0;
continue; /* We know there aren't any more bytes to check */
/* Check for 1110 0000, xx0x xxxx */ /* Check for 1110 0000, xx0x xxxx */
case 2: case 2:
if (c == 0xe0 && (*p & 0x20) == 0) return 0; if (c == 0xe0 && (*p & 0x20) == 0)
return 0;
break; break;
/* Check for 1111 0000, xx00 xxxx */ /* Check for 1111 0000, xx00 xxxx */
case 3: case 3:
if (c == 0xf0 && (*p & 0x30) == 0) return 0; if (c == 0xf0 && (*p & 0x30) == 0)
return 0;
break; break;
/* Check for 1111 1000, xx00 0xxx */ /* Check for 1111 1000, xx00 0xxx */
case 4: case 4:
if (c == 0xf8 && (*p & 0x38) == 0) return 0; if (c == 0xf8 && (*p & 0x38) == 0)
return 0;
break; break;
/* Check for leading 0xfe or 0xff, /* Check for leading 0xfe or 0xff,
and then for 1111 1100, xx00 00xx */ and then for 1111 1100, xx00 00xx */
case 5: case 5:
if (c == 0xfe || c == 0xff || if (c == 0xfe || c == 0xff || (c == 0xfc && (*p & 0x3c) == 0))
(c == 0xfc && (*p & 0x3c) == 0)) return 0; return 0;
break; break;
} }
/* Check for valid bytes after the 2nd, if any; all must start 10 */ /* Check for valid bytes after the 2nd, if any; all must start 10 */
while (--ab > 0) { while (--ab > 0) {
if ((*(++p) & 0xc0) != 0x80) return 0; if ((*(++p) & 0xc0) != 0x80)
return 0;
} }
} }
return 1; return 1;
} }
int u8_reverse(char *dest, char * src, size_t len) int u8_reverse(char *dest, char *src, size_t len)
{ {
size_t si=0, di=len; size_t si = 0, di = len;
unsigned char c; unsigned char c;
dest[di] = '\0'; dest[di] = '\0';
@ -704,24 +734,23 @@ int u8_reverse(char *dest, char * src, size_t len)
di--; di--;
dest[di] = c; dest[di] = c;
si++; si++;
} } else {
else { switch (c >> 4) {
switch (c>>4) {
case 0xC: case 0xC:
case 0xD: case 0xD:
di -= 2; di -= 2;
*((int16_t*)&dest[di]) = *((int16_t*)&src[si]); *((int16_t *)&dest[di]) = *((int16_t *)&src[si]);
si += 2; si += 2;
break; break;
case 0xE: case 0xE:
di -= 3; di -= 3;
dest[di] = src[si]; dest[di] = src[si];
*((int16_t*)&dest[di+1]) = *((int16_t*)&src[si+1]); *((int16_t *)&dest[di + 1]) = *((int16_t *)&src[si + 1]);
si += 3; si += 3;
break; break;
case 0xF: case 0xF:
di -= 4; di -= 4;
*((int32_t*)&dest[di]) = *((int32_t*)&src[si]); *((int32_t *)&dest[di]) = *((int32_t *)&src[si]);
si += 4; si += 4;
break; break;
default: default:

6
llt/utf8.h
View File

@ -21,7 +21,7 @@ extern int wcwidth(uint32_t);
#endif #endif
/* is c the start of a utf8 sequence? */ /* is c the start of a utf8 sequence? */
#define isutf(c) (((c)&0xC0)!=0x80) #define isutf(c) (((c)&0xC0) != 0x80)
#define UEOF ((u_int32_t)-1) #define UEOF ((u_int32_t)-1)
@ -91,8 +91,8 @@ size_t u8_unescape(char *buf, size_t sz, const char *src);
returns number of bytes placed in buf, including a NUL terminator. returns number of bytes placed in buf, including a NUL terminator.
*/ */
size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end, size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi,
int escape_quotes, int ascii); size_t end, int escape_quotes, int ascii);
/* utility predicates used by the above */ /* utility predicates used by the above */
int octal_digit(char c); int octal_digit(char c);

111
llt/utils.h
View File

@ -1,49 +1,45 @@
#ifndef __UTILS_H_ #ifndef __UTILS_H_
#define __UTILS_H_ #define __UTILS_H_
#if defined(__amd64__) || defined(_M_AMD64)
#if defined( __amd64__ ) || defined( _M_AMD64 ) #define ARCH_X86_64
# define ARCH_X86_64 #define __CPU__ 686
# define __CPU__ 686 #elif defined(_M_IX86) // msvs, intel, digital mars, watcom
#elif defined( _M_IX86 )//msvs, intel, digital mars, watcom #if !defined(__386__)
# if ! defined( __386__ ) #error "unsupported target: 16-bit x86"
# error "unsupported target: 16-bit x86" #endif
# endif #define ARCH_X86
# define ARCH_X86 #define __CPU__ (_M_IX86 + 86)
# define __CPU__ ( _M_IX86 + 86 ) #elif defined(__i686__) // gnu c
#elif defined( __i686__ )//gnu c #define ARCH_X86
# define ARCH_X86 #define __CPU__ 686
# define __CPU__ 686 #elif defined(__i586__) // gnu c
#elif defined( __i586__ )//gnu c #define ARCH_X86
# define ARCH_X86 #define __CPU__ 586
# define __CPU__ 586 #elif defined(__i486__) // gnu c
#elif defined( __i486__ )//gnu c #define ARCH_X86
# define ARCH_X86 #define __CPU__ 486
# define __CPU__ 486 #elif defined(__i386__) // gnu c
#elif defined( __i386__ )//gnu c #define ARCH_X86
# define ARCH_X86 #define __CPU__ 386
# define __CPU__ 386 #else
#else #error "unknown architecture"
# error "unknown architecture"
#endif #endif
char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base); char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base);
int str2int(char *str, size_t len, int64_t *res, uint32_t base); int str2int(char *str, size_t len, int64_t *res, uint32_t base);
int isdigit_base(char c, int base); int isdigit_base(char c, int base);
#ifdef ARCH_X86_64 #ifdef ARCH_X86_64
# define LEGACY_REGS "=Q" #define LEGACY_REGS "=Q"
#else #else
# define LEGACY_REGS "=q" #define LEGACY_REGS "=q"
#endif #endif
#if !defined(__INTEL_COMPILER) && (defined(ARCH_X86) || defined(ARCH_X86_64)) #if !defined(__INTEL_COMPILER) && (defined(ARCH_X86) || defined(ARCH_X86_64))
STATIC_INLINE u_int16_t ByteSwap16(u_int16_t x) STATIC_INLINE u_int16_t ByteSwap16(u_int16_t x)
{ {
__asm("xchgb %b0,%h0" : __asm("xchgb %b0,%h0" : LEGACY_REGS(x) : "0"(x));
LEGACY_REGS (x) :
"0" (x));
return x; return x;
} }
#define bswap_16(x) ByteSwap16(x) #define bswap_16(x) ByteSwap16(x)
@ -51,16 +47,18 @@ STATIC_INLINE u_int16_t ByteSwap16(u_int16_t x)
STATIC_INLINE u_int32_t ByteSwap32(u_int32_t x) STATIC_INLINE u_int32_t ByteSwap32(u_int32_t x)
{ {
#if __CPU__ > 386 #if __CPU__ > 386
__asm("bswap %0": __asm("bswap %0"
"=r" (x) : : "=r"(x)
:
#else #else
__asm("xchgb %b0,%h0\n"\ __asm("xchgb %b0,%h0\n"
" rorl $16,%0\n" " rorl $16,%0\n"
" xchgb %b0,%h0": " xchgb %b0,%h0"
LEGACY_REGS (x) : : LEGACY_REGS(x)
:
#endif #endif
"0" (x)); "0"(x));
return x; return x;
} }
#define bswap_32(x) ByteSwap32(x) #define bswap_32(x) ByteSwap32(x)
@ -68,42 +66,43 @@ STATIC_INLINE u_int32_t ByteSwap32(u_int32_t x)
STATIC_INLINE u_int64_t ByteSwap64(u_int64_t x) STATIC_INLINE u_int64_t ByteSwap64(u_int64_t x)
{ {
#ifdef ARCH_X86_64 #ifdef ARCH_X86_64
__asm("bswap %0": __asm("bswap %0" : "=r"(x) : "0"(x));
"=r" (x) : return x;
"0" (x));
return x;
#else #else
register union { __extension__ u_int64_t __ll; register union {
u_int32_t __l[2]; } __x; __extension__ u_int64_t __ll;
asm("xchgl %0,%1": u_int32_t __l[2];
"=r"(__x.__l[0]),"=r"(__x.__l[1]): } __x;
"0"(bswap_32((unsigned long)x)),"1"(bswap_32((unsigned long)(x>>32)))); asm("xchgl %0,%1"
return __x.__ll; : "=r"(__x.__l[0]), "=r"(__x.__l[1])
: "0"(bswap_32((unsigned long)x)),
"1"(bswap_32((unsigned long)(x >> 32))));
return __x.__ll;
#endif #endif
} }
#define bswap_64(x) ByteSwap64(x) #define bswap_64(x) ByteSwap64(x)
#else #else
#define bswap_16(x) (((x) & 0x00ff) << 8 | ((x) & 0xff00) >> 8) #define bswap_16(x) (((x)&0x00ff) << 8 | ((x)&0xff00) >> 8)
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
#define bswap_32(x) _bswap(x) #define bswap_32(x) _bswap(x)
#else #else
#define bswap_32(x) \ #define bswap_32(x) \
((((x) & 0xff000000) >> 24) | (((x) & 0x00ff0000) >> 8) | \ ((((x)&0xff000000) >> 24) | (((x)&0x00ff0000) >> 8) | \
(((x) & 0x0000ff00) << 8) | (((x) & 0x000000ff) << 24)) (((x)&0x0000ff00) << 8) | (((x)&0x000000ff) << 24))
#endif #endif
STATIC_INLINE u_int64_t ByteSwap64(u_int64_t x) STATIC_INLINE u_int64_t ByteSwap64(u_int64_t x)
{ {
union { union {
u_int64_t ll; u_int64_t ll;
u_int32_t l[2]; u_int32_t l[2];
} w, r; } w, r;
w.ll = x; w.ll = x;
r.l[0] = bswap_32 (w.l[1]); r.l[0] = bswap_32(w.l[1]);
r.l[1] = bswap_32 (w.l[0]); r.l[1] = bswap_32(w.l[0]);
return r.ll; return r.ll;
} }
#define bswap_64(x) ByteSwap64(x) #define bswap_64(x) ByteSwap64(x)

345
llt/wcwidth.c
View File

@ -1,4 +1,4 @@
#include "dtypes.h" //for DLLEXPORT #include "dtypes.h" //for DLLEXPORT
/* /*
* This is an implementation of wcwidth() and wcswidth() (defined in * This is an implementation of wcwidth() and wcswidth() (defined in
* IEEE Std 1002.1-2001) for Unicode. * IEEE Std 1002.1-2001) for Unicode.
@ -65,31 +65,31 @@
#include <stdint.h> #include <stdint.h>
struct interval { struct interval {
int first; int first;
int last; int last;
}; };
/* auxiliary function for binary search in interval table */ /* auxiliary function for binary search in interval table */
static int bisearch(uint32_t ucs, const struct interval *table, int max) { static int bisearch(uint32_t ucs, const struct interval *table, int max)
int min = 0; {
int mid; int min = 0;
int mid;
if (ucs < table[0].first || ucs > table[max].last)
return 0;
while (max >= min) {
mid = (min + max) / 2;
if (ucs > table[mid].last)
min = mid + 1;
else if (ucs < table[mid].first)
max = mid - 1;
else
return 1;
}
if (ucs < table[0].first || ucs > table[max].last)
return 0; return 0;
while (max >= min) {
mid = (min + max) / 2;
if (ucs > table[mid].last)
min = mid + 1;
else if (ucs < table[mid].first)
max = mid - 1;
else
return 1;
}
return 0;
} }
/* The following two functions define the column width of an ISO 10646 /* The following two functions define the column width of an ISO 10646
* character as follows: * character as follows:
* *
@ -127,103 +127,103 @@ static int bisearch(uint32_t ucs, const struct interval *table, int max) {
DLLEXPORT int wcwidth(uint32_t ucs) DLLEXPORT int wcwidth(uint32_t ucs)
{ {
/* sorted list of non-overlapping intervals of non-spacing characters */ /* sorted list of non-overlapping intervals of non-spacing characters */
/* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */ /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c"
static const struct interval combining[] = { */
{ 0x0300, 0x036F }, { 0x0483, 0x0486 }, { 0x0488, 0x0489 }, static const struct interval combining[] = {
{ 0x0591, 0x05BD }, { 0x05BF, 0x05BF }, { 0x05C1, 0x05C2 }, { 0x0300, 0x036F }, { 0x0483, 0x0486 }, { 0x0488, 0x0489 },
{ 0x05C4, 0x05C5 }, { 0x05C7, 0x05C7 }, { 0x0600, 0x0603 }, { 0x0591, 0x05BD }, { 0x05BF, 0x05BF }, { 0x05C1, 0x05C2 },
{ 0x0610, 0x0615 }, { 0x064B, 0x065E }, { 0x0670, 0x0670 }, { 0x05C4, 0x05C5 }, { 0x05C7, 0x05C7 }, { 0x0600, 0x0603 },
{ 0x06D6, 0x06E4 }, { 0x06E7, 0x06E8 }, { 0x06EA, 0x06ED }, { 0x0610, 0x0615 }, { 0x064B, 0x065E }, { 0x0670, 0x0670 },
{ 0x070F, 0x070F }, { 0x0711, 0x0711 }, { 0x0730, 0x074A }, { 0x06D6, 0x06E4 }, { 0x06E7, 0x06E8 }, { 0x06EA, 0x06ED },
{ 0x07A6, 0x07B0 }, { 0x07EB, 0x07F3 }, { 0x0901, 0x0902 }, { 0x070F, 0x070F }, { 0x0711, 0x0711 }, { 0x0730, 0x074A },
{ 0x093C, 0x093C }, { 0x0941, 0x0948 }, { 0x094D, 0x094D }, { 0x07A6, 0x07B0 }, { 0x07EB, 0x07F3 }, { 0x0901, 0x0902 },
{ 0x0951, 0x0954 }, { 0x0962, 0x0963 }, { 0x0981, 0x0981 }, { 0x093C, 0x093C }, { 0x0941, 0x0948 }, { 0x094D, 0x094D },
{ 0x09BC, 0x09BC }, { 0x09C1, 0x09C4 }, { 0x09CD, 0x09CD }, { 0x0951, 0x0954 }, { 0x0962, 0x0963 }, { 0x0981, 0x0981 },
{ 0x09E2, 0x09E3 }, { 0x0A01, 0x0A02 }, { 0x0A3C, 0x0A3C }, { 0x09BC, 0x09BC }, { 0x09C1, 0x09C4 }, { 0x09CD, 0x09CD },
{ 0x0A41, 0x0A42 }, { 0x0A47, 0x0A48 }, { 0x0A4B, 0x0A4D }, { 0x09E2, 0x09E3 }, { 0x0A01, 0x0A02 }, { 0x0A3C, 0x0A3C },
{ 0x0A70, 0x0A71 }, { 0x0A81, 0x0A82 }, { 0x0ABC, 0x0ABC }, { 0x0A41, 0x0A42 }, { 0x0A47, 0x0A48 }, { 0x0A4B, 0x0A4D },
{ 0x0AC1, 0x0AC5 }, { 0x0AC7, 0x0AC8 }, { 0x0ACD, 0x0ACD }, { 0x0A70, 0x0A71 }, { 0x0A81, 0x0A82 }, { 0x0ABC, 0x0ABC },
{ 0x0AE2, 0x0AE3 }, { 0x0B01, 0x0B01 }, { 0x0B3C, 0x0B3C }, { 0x0AC1, 0x0AC5 }, { 0x0AC7, 0x0AC8 }, { 0x0ACD, 0x0ACD },
{ 0x0B3F, 0x0B3F }, { 0x0B41, 0x0B43 }, { 0x0B4D, 0x0B4D }, { 0x0AE2, 0x0AE3 }, { 0x0B01, 0x0B01 }, { 0x0B3C, 0x0B3C },
{ 0x0B56, 0x0B56 }, { 0x0B82, 0x0B82 }, { 0x0BC0, 0x0BC0 }, { 0x0B3F, 0x0B3F }, { 0x0B41, 0x0B43 }, { 0x0B4D, 0x0B4D },
{ 0x0BCD, 0x0BCD }, { 0x0C3E, 0x0C40 }, { 0x0C46, 0x0C48 }, { 0x0B56, 0x0B56 }, { 0x0B82, 0x0B82 }, { 0x0BC0, 0x0BC0 },
{ 0x0C4A, 0x0C4D }, { 0x0C55, 0x0C56 }, { 0x0CBC, 0x0CBC }, { 0x0BCD, 0x0BCD }, { 0x0C3E, 0x0C40 }, { 0x0C46, 0x0C48 },
{ 0x0CBF, 0x0CBF }, { 0x0CC6, 0x0CC6 }, { 0x0CCC, 0x0CCD }, { 0x0C4A, 0x0C4D }, { 0x0C55, 0x0C56 }, { 0x0CBC, 0x0CBC },
{ 0x0CE2, 0x0CE3 }, { 0x0D41, 0x0D43 }, { 0x0D4D, 0x0D4D }, { 0x0CBF, 0x0CBF }, { 0x0CC6, 0x0CC6 }, { 0x0CCC, 0x0CCD },
{ 0x0DCA, 0x0DCA }, { 0x0DD2, 0x0DD4 }, { 0x0DD6, 0x0DD6 }, { 0x0CE2, 0x0CE3 }, { 0x0D41, 0x0D43 }, { 0x0D4D, 0x0D4D },
{ 0x0E31, 0x0E31 }, { 0x0E34, 0x0E3A }, { 0x0E47, 0x0E4E }, { 0x0DCA, 0x0DCA }, { 0x0DD2, 0x0DD4 }, { 0x0DD6, 0x0DD6 },
{ 0x0EB1, 0x0EB1 }, { 0x0EB4, 0x0EB9 }, { 0x0EBB, 0x0EBC }, { 0x0E31, 0x0E31 }, { 0x0E34, 0x0E3A }, { 0x0E47, 0x0E4E },
{ 0x0EC8, 0x0ECD }, { 0x0F18, 0x0F19 }, { 0x0F35, 0x0F35 }, { 0x0EB1, 0x0EB1 }, { 0x0EB4, 0x0EB9 }, { 0x0EBB, 0x0EBC },
{ 0x0F37, 0x0F37 }, { 0x0F39, 0x0F39 }, { 0x0F71, 0x0F7E }, { 0x0EC8, 0x0ECD }, { 0x0F18, 0x0F19 }, { 0x0F35, 0x0F35 },
{ 0x0F80, 0x0F84 }, { 0x0F86, 0x0F87 }, { 0x0F90, 0x0F97 }, { 0x0F37, 0x0F37 }, { 0x0F39, 0x0F39 }, { 0x0F71, 0x0F7E },
{ 0x0F99, 0x0FBC }, { 0x0FC6, 0x0FC6 }, { 0x102D, 0x1030 }, { 0x0F80, 0x0F84 }, { 0x0F86, 0x0F87 }, { 0x0F90, 0x0F97 },
{ 0x1032, 0x1032 }, { 0x1036, 0x1037 }, { 0x1039, 0x1039 }, { 0x0F99, 0x0FBC }, { 0x0FC6, 0x0FC6 }, { 0x102D, 0x1030 },
{ 0x1058, 0x1059 }, { 0x1160, 0x11FF }, { 0x135F, 0x135F }, { 0x1032, 0x1032 }, { 0x1036, 0x1037 }, { 0x1039, 0x1039 },
{ 0x1712, 0x1714 }, { 0x1732, 0x1734 }, { 0x1752, 0x1753 }, { 0x1058, 0x1059 }, { 0x1160, 0x11FF }, { 0x135F, 0x135F },
{ 0x1772, 0x1773 }, { 0x17B4, 0x17B5 }, { 0x17B7, 0x17BD }, { 0x1712, 0x1714 }, { 0x1732, 0x1734 }, { 0x1752, 0x1753 },
{ 0x17C6, 0x17C6 }, { 0x17C9, 0x17D3 }, { 0x17DD, 0x17DD }, { 0x1772, 0x1773 }, { 0x17B4, 0x17B5 }, { 0x17B7, 0x17BD },
{ 0x180B, 0x180D }, { 0x18A9, 0x18A9 }, { 0x1920, 0x1922 }, { 0x17C6, 0x17C6 }, { 0x17C9, 0x17D3 }, { 0x17DD, 0x17DD },
{ 0x1927, 0x1928 }, { 0x1932, 0x1932 }, { 0x1939, 0x193B }, { 0x180B, 0x180D }, { 0x18A9, 0x18A9 }, { 0x1920, 0x1922 },
{ 0x1A17, 0x1A18 }, { 0x1B00, 0x1B03 }, { 0x1B34, 0x1B34 }, { 0x1927, 0x1928 }, { 0x1932, 0x1932 }, { 0x1939, 0x193B },
{ 0x1B36, 0x1B3A }, { 0x1B3C, 0x1B3C }, { 0x1B42, 0x1B42 }, { 0x1A17, 0x1A18 }, { 0x1B00, 0x1B03 }, { 0x1B34, 0x1B34 },
{ 0x1B6B, 0x1B73 }, { 0x1DC0, 0x1DCA }, { 0x1DFE, 0x1DFF }, { 0x1B36, 0x1B3A }, { 0x1B3C, 0x1B3C }, { 0x1B42, 0x1B42 },
{ 0x200B, 0x200F }, { 0x202A, 0x202E }, { 0x2060, 0x2063 }, { 0x1B6B, 0x1B73 }, { 0x1DC0, 0x1DCA }, { 0x1DFE, 0x1DFF },
{ 0x206A, 0x206F }, { 0x20D0, 0x20EF }, { 0x302A, 0x302F }, { 0x200B, 0x200F }, { 0x202A, 0x202E }, { 0x2060, 0x2063 },
{ 0x3099, 0x309A }, { 0xA806, 0xA806 }, { 0xA80B, 0xA80B }, { 0x206A, 0x206F }, { 0x20D0, 0x20EF }, { 0x302A, 0x302F },
{ 0xA825, 0xA826 }, { 0xFB1E, 0xFB1E }, { 0xFE00, 0xFE0F }, { 0x3099, 0x309A }, { 0xA806, 0xA806 }, { 0xA80B, 0xA80B },
{ 0xFE20, 0xFE23 }, { 0xFEFF, 0xFEFF }, { 0xFFF9, 0xFFFB }, { 0xA825, 0xA826 }, { 0xFB1E, 0xFB1E }, { 0xFE00, 0xFE0F },
{ 0x10A01, 0x10A03 }, { 0x10A05, 0x10A06 }, { 0x10A0C, 0x10A0F }, { 0xFE20, 0xFE23 }, { 0xFEFF, 0xFEFF }, { 0xFFF9, 0xFFFB },
{ 0x10A38, 0x10A3A }, { 0x10A3F, 0x10A3F }, { 0x1D167, 0x1D169 }, { 0x10A01, 0x10A03 }, { 0x10A05, 0x10A06 }, { 0x10A0C, 0x10A0F },
{ 0x1D173, 0x1D182 }, { 0x1D185, 0x1D18B }, { 0x1D1AA, 0x1D1AD }, { 0x10A38, 0x10A3A }, { 0x10A3F, 0x10A3F }, { 0x1D167, 0x1D169 },
{ 0x1D242, 0x1D244 }, { 0xE0001, 0xE0001 }, { 0xE0020, 0xE007F }, { 0x1D173, 0x1D182 }, { 0x1D185, 0x1D18B }, { 0x1D1AA, 0x1D1AD },
{ 0xE0100, 0xE01EF } { 0x1D242, 0x1D244 }, { 0xE0001, 0xE0001 }, { 0xE0020, 0xE007F },
}; { 0xE0100, 0xE01EF }
};
/* test for 8-bit control characters */ /* test for 8-bit control characters */
if (ucs == 0) if (ucs == 0)
return 0; return 0;
if (ucs < 32 || (ucs >= 0x7f && ucs < 0xa0)) if (ucs < 32 || (ucs >= 0x7f && ucs < 0xa0))
return -1; return -1;
/* binary search in table of non-spacing characters */ /* binary search in table of non-spacing characters */
if (bisearch(ucs, combining, if (bisearch(ucs, combining,
sizeof(combining) / sizeof(struct interval) - 1)) sizeof(combining) / sizeof(struct interval) - 1))
return 0; return 0;
/* if we arrive here, ucs is not a combining or C0/C1 control character */ /* if we arrive here, ucs is not a combining or C0/C1 control character */
return 1 + return 1 +
(ucs >= 0x1100 && (ucs >= 0x1100 &&
(ucs <= 0x115f || /* Hangul Jamo init. consonants */ (ucs <= 0x115f || /* Hangul Jamo init. consonants */
ucs == 0x2329 || ucs == 0x232a || ucs == 0x2329 || ucs == 0x232a ||
(ucs >= 0x2e80 && ucs <= 0xa4cf && (ucs >= 0x2e80 && ucs <= 0xa4cf &&
ucs != 0x303f) || /* CJK ... Yi */ ucs != 0x303f) || /* CJK ... Yi */
(ucs >= 0xac00 && ucs <= 0xd7a3) || /* Hangul Syllables */ (ucs >= 0xac00 && ucs <= 0xd7a3) || /* Hangul Syllables */
(ucs >= 0xf900 && ucs <= 0xfaff) || /* CJK Compatibility Ideographs */ (ucs >= 0xf900 &&
(ucs >= 0xfe10 && ucs <= 0xfe19) || /* Vertical forms */ ucs <= 0xfaff) || /* CJK Compatibility Ideographs */
(ucs >= 0xfe30 && ucs <= 0xfe6f) || /* CJK Compatibility Forms */ (ucs >= 0xfe10 && ucs <= 0xfe19) || /* Vertical forms */
(ucs >= 0xff00 && ucs <= 0xff60) || /* Fullwidth Forms */ (ucs >= 0xfe30 && ucs <= 0xfe6f) || /* CJK Compatibility Forms */
(ucs >= 0xffe0 && ucs <= 0xffe6) || (ucs >= 0xff00 && ucs <= 0xff60) || /* Fullwidth Forms */
(ucs >= 0x20000 && ucs <= 0x2fffd) || (ucs >= 0xffe0 && ucs <= 0xffe6) ||
(ucs >= 0x30000 && ucs <= 0x3fffd))); (ucs >= 0x20000 && ucs <= 0x2fffd) ||
(ucs >= 0x30000 && ucs <= 0x3fffd)));
} }
int wcswidth(const uint32_t *pwcs, size_t n) int wcswidth(const uint32_t *pwcs, size_t n)
{ {
int w, width = 0; int w, width = 0;
for (;*pwcs && n-- > 0; pwcs++) for (; *pwcs && n-- > 0; pwcs++)
if ((w = wcwidth(*pwcs)) < 0) if ((w = wcwidth(*pwcs)) < 0)
return -1; return -1;
else else
width += w; width += w;
return width; return width;
} }
/* /*
* The following functions are the same as wcwidth() and * The following functions are the same as wcwidth() and
* wcswidth(), except that spacing characters in the East Asian * wcswidth(), except that spacing characters in the East Asian
@ -235,81 +235,80 @@ int wcswidth(const uint32_t *pwcs, size_t n)
*/ */
int wcwidth_cjk(uint32_t ucs) int wcwidth_cjk(uint32_t ucs)
{ {
/* sorted list of non-overlapping intervals of East Asian Ambiguous /* sorted list of non-overlapping intervals of East Asian Ambiguous
* characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */ * characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */
static const struct interval ambiguous[] = { static const struct interval ambiguous[] = {
{ 0x00A1, 0x00A1 }, { 0x00A4, 0x00A4 }, { 0x00A7, 0x00A8 }, { 0x00A1, 0x00A1 }, { 0x00A4, 0x00A4 }, { 0x00A7, 0x00A8 },
{ 0x00AA, 0x00AA }, { 0x00AE, 0x00AE }, { 0x00B0, 0x00B4 }, { 0x00AA, 0x00AA }, { 0x00AE, 0x00AE }, { 0x00B0, 0x00B4 },
{ 0x00B6, 0x00BA }, { 0x00BC, 0x00BF }, { 0x00C6, 0x00C6 }, { 0x00B6, 0x00BA }, { 0x00BC, 0x00BF }, { 0x00C6, 0x00C6 },
{ 0x00D0, 0x00D0 }, { 0x00D7, 0x00D8 }, { 0x00DE, 0x00E1 }, { 0x00D0, 0x00D0 }, { 0x00D7, 0x00D8 }, { 0x00DE, 0x00E1 },
{ 0x00E6, 0x00E6 }, { 0x00E8, 0x00EA }, { 0x00EC, 0x00ED }, { 0x00E6, 0x00E6 }, { 0x00E8, 0x00EA }, { 0x00EC, 0x00ED },
{ 0x00F0, 0x00F0 }, { 0x00F2, 0x00F3 }, { 0x00F7, 0x00FA }, { 0x00F0, 0x00F0 }, { 0x00F2, 0x00F3 }, { 0x00F7, 0x00FA },
{ 0x00FC, 0x00FC }, { 0x00FE, 0x00FE }, { 0x0101, 0x0101 }, { 0x00FC, 0x00FC }, { 0x00FE, 0x00FE }, { 0x0101, 0x0101 },
{ 0x0111, 0x0111 }, { 0x0113, 0x0113 }, { 0x011B, 0x011B }, { 0x0111, 0x0111 }, { 0x0113, 0x0113 }, { 0x011B, 0x011B },
{ 0x0126, 0x0127 }, { 0x012B, 0x012B }, { 0x0131, 0x0133 }, { 0x0126, 0x0127 }, { 0x012B, 0x012B }, { 0x0131, 0x0133 },
{ 0x0138, 0x0138 }, { 0x013F, 0x0142 }, { 0x0144, 0x0144 }, { 0x0138, 0x0138 }, { 0x013F, 0x0142 }, { 0x0144, 0x0144 },
{ 0x0148, 0x014B }, { 0x014D, 0x014D }, { 0x0152, 0x0153 }, { 0x0148, 0x014B }, { 0x014D, 0x014D }, { 0x0152, 0x0153 },
{ 0x0166, 0x0167 }, { 0x016B, 0x016B }, { 0x01CE, 0x01CE }, { 0x0166, 0x0167 }, { 0x016B, 0x016B }, { 0x01CE, 0x01CE },
{ 0x01D0, 0x01D0 }, { 0x01D2, 0x01D2 }, { 0x01D4, 0x01D4 }, { 0x01D0, 0x01D0 }, { 0x01D2, 0x01D2 }, { 0x01D4, 0x01D4 },
{ 0x01D6, 0x01D6 }, { 0x01D8, 0x01D8 }, { 0x01DA, 0x01DA }, { 0x01D6, 0x01D6 }, { 0x01D8, 0x01D8 }, { 0x01DA, 0x01DA },
{ 0x01DC, 0x01DC }, { 0x0251, 0x0251 }, { 0x0261, 0x0261 }, { 0x01DC, 0x01DC }, { 0x0251, 0x0251 }, { 0x0261, 0x0261 },
{ 0x02C4, 0x02C4 }, { 0x02C7, 0x02C7 }, { 0x02C9, 0x02CB }, { 0x02C4, 0x02C4 }, { 0x02C7, 0x02C7 }, { 0x02C9, 0x02CB },
{ 0x02CD, 0x02CD }, { 0x02D0, 0x02D0 }, { 0x02D8, 0x02DB }, { 0x02CD, 0x02CD }, { 0x02D0, 0x02D0 }, { 0x02D8, 0x02DB },
{ 0x02DD, 0x02DD }, { 0x02DF, 0x02DF }, { 0x0391, 0x03A1 }, { 0x02DD, 0x02DD }, { 0x02DF, 0x02DF }, { 0x0391, 0x03A1 },
{ 0x03A3, 0x03A9 }, { 0x03B1, 0x03C1 }, { 0x03C3, 0x03C9 }, { 0x03A3, 0x03A9 }, { 0x03B1, 0x03C1 }, { 0x03C3, 0x03C9 },
{ 0x0401, 0x0401 }, { 0x0410, 0x044F }, { 0x0451, 0x0451 }, { 0x0401, 0x0401 }, { 0x0410, 0x044F }, { 0x0451, 0x0451 },
{ 0x2010, 0x2010 }, { 0x2013, 0x2016 }, { 0x2018, 0x2019 }, { 0x2010, 0x2010 }, { 0x2013, 0x2016 }, { 0x2018, 0x2019 },
{ 0x201C, 0x201D }, { 0x2020, 0x2022 }, { 0x2024, 0x2027 }, { 0x201C, 0x201D }, { 0x2020, 0x2022 }, { 0x2024, 0x2027 },
{ 0x2030, 0x2030 }, { 0x2032, 0x2033 }, { 0x2035, 0x2035 }, { 0x2030, 0x2030 }, { 0x2032, 0x2033 }, { 0x2035, 0x2035 },
{ 0x203B, 0x203B }, { 0x203E, 0x203E }, { 0x2074, 0x2074 }, { 0x203B, 0x203B }, { 0x203E, 0x203E }, { 0x2074, 0x2074 },
{ 0x207F, 0x207F }, { 0x2081, 0x2084 }, { 0x20AC, 0x20AC }, { 0x207F, 0x207F }, { 0x2081, 0x2084 }, { 0x20AC, 0x20AC },
{ 0x2103, 0x2103 }, { 0x2105, 0x2105 }, { 0x2109, 0x2109 }, { 0x2103, 0x2103 }, { 0x2105, 0x2105 }, { 0x2109, 0x2109 },
{ 0x2113, 0x2113 }, { 0x2116, 0x2116 }, { 0x2121, 0x2122 }, { 0x2113, 0x2113 }, { 0x2116, 0x2116 }, { 0x2121, 0x2122 },
{ 0x2126, 0x2126 }, { 0x212B, 0x212B }, { 0x2153, 0x2154 }, { 0x2126, 0x2126 }, { 0x212B, 0x212B }, { 0x2153, 0x2154 },
{ 0x215B, 0x215E }, { 0x2160, 0x216B }, { 0x2170, 0x2179 }, { 0x215B, 0x215E }, { 0x2160, 0x216B }, { 0x2170, 0x2179 },
{ 0x2190, 0x2199 }, { 0x21B8, 0x21B9 }, { 0x21D2, 0x21D2 }, { 0x2190, 0x2199 }, { 0x21B8, 0x21B9 }, { 0x21D2, 0x21D2 },
{ 0x21D4, 0x21D4 }, { 0x21E7, 0x21E7 }, { 0x2200, 0x2200 }, { 0x21D4, 0x21D4 }, { 0x21E7, 0x21E7 }, { 0x2200, 0x2200 },
{ 0x2202, 0x2203 }, { 0x2207, 0x2208 }, { 0x220B, 0x220B }, { 0x2202, 0x2203 }, { 0x2207, 0x2208 }, { 0x220B, 0x220B },
{ 0x220F, 0x220F }, { 0x2211, 0x2211 }, { 0x2215, 0x2215 }, { 0x220F, 0x220F }, { 0x2211, 0x2211 }, { 0x2215, 0x2215 },
{ 0x221A, 0x221A }, { 0x221D, 0x2220 }, { 0x2223, 0x2223 }, { 0x221A, 0x221A }, { 0x221D, 0x2220 }, { 0x2223, 0x2223 },
{ 0x2225, 0x2225 }, { 0x2227, 0x222C }, { 0x222E, 0x222E }, { 0x2225, 0x2225 }, { 0x2227, 0x222C }, { 0x222E, 0x222E },
{ 0x2234, 0x2237 }, { 0x223C, 0x223D }, { 0x2248, 0x2248 }, { 0x2234, 0x2237 }, { 0x223C, 0x223D }, { 0x2248, 0x2248 },
{ 0x224C, 0x224C }, { 0x2252, 0x2252 }, { 0x2260, 0x2261 }, { 0x224C, 0x224C }, { 0x2252, 0x2252 }, { 0x2260, 0x2261 },
{ 0x2264, 0x2267 }, { 0x226A, 0x226B }, { 0x226E, 0x226F }, { 0x2264, 0x2267 }, { 0x226A, 0x226B }, { 0x226E, 0x226F },
{ 0x2282, 0x2283 }, { 0x2286, 0x2287 }, { 0x2295, 0x2295 }, { 0x2282, 0x2283 }, { 0x2286, 0x2287 }, { 0x2295, 0x2295 },
{ 0x2299, 0x2299 }, { 0x22A5, 0x22A5 }, { 0x22BF, 0x22BF }, { 0x2299, 0x2299 }, { 0x22A5, 0x22A5 }, { 0x22BF, 0x22BF },
{ 0x2312, 0x2312 }, { 0x2460, 0x24E9 }, { 0x24EB, 0x254B }, { 0x2312, 0x2312 }, { 0x2460, 0x24E9 }, { 0x24EB, 0x254B },
{ 0x2550, 0x2573 }, { 0x2580, 0x258F }, { 0x2592, 0x2595 }, { 0x2550, 0x2573 }, { 0x2580, 0x258F }, { 0x2592, 0x2595 },
{ 0x25A0, 0x25A1 }, { 0x25A3, 0x25A9 }, { 0x25B2, 0x25B3 }, { 0x25A0, 0x25A1 }, { 0x25A3, 0x25A9 }, { 0x25B2, 0x25B3 },
{ 0x25B6, 0x25B7 }, { 0x25BC, 0x25BD }, { 0x25C0, 0x25C1 }, { 0x25B6, 0x25B7 }, { 0x25BC, 0x25BD }, { 0x25C0, 0x25C1 },
{ 0x25C6, 0x25C8 }, { 0x25CB, 0x25CB }, { 0x25CE, 0x25D1 }, { 0x25C6, 0x25C8 }, { 0x25CB, 0x25CB }, { 0x25CE, 0x25D1 },
{ 0x25E2, 0x25E5 }, { 0x25EF, 0x25EF }, { 0x2605, 0x2606 }, { 0x25E2, 0x25E5 }, { 0x25EF, 0x25EF }, { 0x2605, 0x2606 },
{ 0x2609, 0x2609 }, { 0x260E, 0x260F }, { 0x2614, 0x2615 }, { 0x2609, 0x2609 }, { 0x260E, 0x260F }, { 0x2614, 0x2615 },
{ 0x261C, 0x261C }, { 0x261E, 0x261E }, { 0x2640, 0x2640 }, { 0x261C, 0x261C }, { 0x261E, 0x261E }, { 0x2640, 0x2640 },
{ 0x2642, 0x2642 }, { 0x2660, 0x2661 }, { 0x2663, 0x2665 }, { 0x2642, 0x2642 }, { 0x2660, 0x2661 }, { 0x2663, 0x2665 },
{ 0x2667, 0x266A }, { 0x266C, 0x266D }, { 0x266F, 0x266F }, { 0x2667, 0x266A }, { 0x266C, 0x266D }, { 0x266F, 0x266F },
{ 0x273D, 0x273D }, { 0x2776, 0x277F }, { 0xE000, 0xF8FF }, { 0x273D, 0x273D }, { 0x2776, 0x277F }, { 0xE000, 0xF8FF },
{ 0xFFFD, 0xFFFD }, { 0xF0000, 0xFFFFD }, { 0x100000, 0x10FFFD } { 0xFFFD, 0xFFFD }, { 0xF0000, 0xFFFFD }, { 0x100000, 0x10FFFD }
}; };
/* binary search in table of non-spacing characters */ /* binary search in table of non-spacing characters */
if (bisearch(ucs, ambiguous, if (bisearch(ucs, ambiguous,
sizeof(ambiguous) / sizeof(struct interval) - 1)) sizeof(ambiguous) / sizeof(struct interval) - 1))
return 2; return 2;
return wcwidth(ucs); return wcwidth(ucs);
} }
int wcswidth_cjk(const uint32_t *pwcs, size_t n) int wcswidth_cjk(const uint32_t *pwcs, size_t n)
{ {
int w, width = 0; int w, width = 0;
for (;*pwcs && n-- > 0; pwcs++) for (; *pwcs && n-- > 0; pwcs++)
if ((w = wcwidth_cjk(*pwcs)) < 0) if ((w = wcwidth_cjk(*pwcs)) < 0)
return -1; return -1;
else else
width += w; width += w;
return width; return width;
} }

30
opaque_type_template.c
View File

@ -12,28 +12,20 @@
static value_t TYPEsym; static value_t TYPEsym;
static fltype_t *TYPEtype; static fltype_t *TYPEtype;
void print_TYPE(value_t v, ios_t *f, int princ) void print_TYPE(value_t v, ios_t *f, int princ) {}
{
}
void print_traverse_TYPE(value_t self) void print_traverse_TYPE(value_t self) {}
{
}
void free_TYPE(value_t self) void free_TYPE(value_t self) {}
{
}
void relocate_TYPE(value_t oldv, value_t newv) void relocate_TYPE(value_t oldv, value_t newv) {}
{
}
cvtable_t TYPE_vtable = { print_TYPE, relocate_TYPE, free_TYPE, cvtable_t TYPE_vtable = { print_TYPE, relocate_TYPE, free_TYPE,
print_traverse_TYPE }; print_traverse_TYPE };
int isTYPE(value_t v) int isTYPE(value_t v)
{ {
return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == TYPEtype; return iscvalue(v) && cv_class((cvalue_t *)ptr(v)) == TYPEtype;
} }
value_t fl_TYPEp(value_t *args, uint32_t nargs) value_t fl_TYPEp(value_t *args, uint32_t nargs)
@ -46,18 +38,16 @@ static TYPE_t *toTYPE(value_t v, char *fname)
{ {
if (!isTYPE(v)) if (!isTYPE(v))
type_error(fname, "TYPE", v); type_error(fname, "TYPE", v);
return (TYPE_t*)cv_data((cvalue_t*)ptr(v)); return (TYPE_t *)cv_data((cvalue_t *)ptr(v));
} }
static builtinspec_t TYPEfunc_info[] = { static builtinspec_t TYPEfunc_info[] = { { "TYPE?", fl_TYPEp },
{ "TYPE?", fl_TYPEp }, { NULL, NULL } };
{ NULL, NULL }
};
void TYPE_init() void TYPE_init()
{ {
TYPEsym = symbol("TYPE"); TYPEsym = symbol("TYPE");
TYPEtype = define_opaque_type(TYPEsym, sizeof(TYPE_t), TYPEtype =
&TYPE_vtable, NULL); define_opaque_type(TYPEsym, sizeof(TYPE_t), &TYPE_vtable, NULL);
assign_global_builtins(TYPEfunc_info); assign_global_builtins(TYPEfunc_info);
} }

220
opcodes.h
View File

@ -2,96 +2,166 @@
#define OPCODES_H #define OPCODES_H
enum { enum {
OP_NOP=0, OP_DUP, OP_POP, OP_CALL, OP_TCALL, OP_JMP, OP_BRF, OP_BRT, OP_NOP = 0,
OP_JMPL, OP_BRFL, OP_BRTL, OP_RET, OP_DUP,
OP_POP,
OP_CALL,
OP_TCALL,
OP_JMP,
OP_BRF,
OP_BRT,
OP_JMPL,
OP_BRFL,
OP_BRTL,
OP_RET,
OP_EQ, OP_EQV, OP_EQUAL, OP_ATOMP, OP_NOT, OP_NULLP, OP_BOOLEANP, OP_EQ,
OP_SYMBOLP, OP_NUMBERP, OP_BOUNDP, OP_PAIRP, OP_BUILTINP, OP_VECTORP, OP_EQV,
OP_FIXNUMP, OP_FUNCTIONP, OP_EQUAL,
OP_ATOMP,
OP_NOT,
OP_NULLP,
OP_BOOLEANP,
OP_SYMBOLP,
OP_NUMBERP,
OP_BOUNDP,
OP_PAIRP,
OP_BUILTINP,
OP_VECTORP,
OP_FIXNUMP,
OP_FUNCTIONP,
OP_CONS, OP_LIST, OP_CAR, OP_CDR, OP_SETCAR, OP_SETCDR, OP_CONS,
OP_LIST,
OP_CAR,
OP_CDR,
OP_SETCAR,
OP_SETCDR,
OP_APPLY, OP_APPLY,
OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_IDIV, OP_NUMEQ, OP_LT, OP_COMPARE, OP_ADD,
OP_SUB,
OP_MUL,
OP_DIV,
OP_IDIV,
OP_NUMEQ,
OP_LT,
OP_COMPARE,
OP_VECTOR, OP_AREF, OP_ASET, OP_VECTOR,
OP_AREF,
OP_ASET,
OP_LOADT, OP_LOADF, OP_LOADNIL, OP_LOAD0, OP_LOAD1, OP_LOADI8, OP_LOADT,
OP_LOADV, OP_LOADVL, OP_LOADF,
OP_LOADG, OP_LOADGL, OP_LOADNIL,
OP_LOADA, OP_LOADAL, OP_LOADC, OP_LOADCL, OP_LOAD0,
OP_SETG, OP_SETGL, OP_LOAD1,
OP_SETA, OP_SETAL, OP_SETC, OP_SETCL, OP_LOADI8,
OP_LOADV,
OP_LOADVL,
OP_LOADG,
OP_LOADGL,
OP_LOADA,
OP_LOADAL,
OP_LOADC,
OP_LOADCL,
OP_SETG,
OP_SETGL,
OP_SETA,
OP_SETAL,
OP_SETC,
OP_SETCL,
OP_CLOSURE, OP_ARGC, OP_VARGC, OP_TRYCATCH, OP_FOR, OP_CLOSURE,
OP_TAPPLY, OP_ADD2, OP_SUB2, OP_NEG, OP_LARGC, OP_LVARGC, OP_ARGC,
OP_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01, OP_CALLL, OP_TCALLL, OP_VARGC,
OP_BRNE, OP_BRNEL, OP_CADR, OP_BRNN, OP_BRNNL, OP_BRN, OP_BRNL, OP_TRYCATCH,
OP_OPTARGS, OP_BRBOUND, OP_KEYARGS, OP_FOR,
OP_TAPPLY,
OP_ADD2,
OP_SUB2,
OP_NEG,
OP_LARGC,
OP_LVARGC,
OP_LOADA0,
OP_LOADA1,
OP_LOADC00,
OP_LOADC01,
OP_CALLL,
OP_TCALLL,
OP_BRNE,
OP_BRNEL,
OP_CADR,
OP_BRNN,
OP_BRNNL,
OP_BRN,
OP_BRNL,
OP_OPTARGS,
OP_BRBOUND,
OP_KEYARGS,
OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST, OP_EOF_OBJECT, OP_BOOL_CONST_T,
OP_BOOL_CONST_F,
OP_THE_EMPTY_LIST,
OP_EOF_OBJECT,
N_OPCODES N_OPCODES
}; };
#ifdef USE_COMPUTED_GOTO #ifdef USE_COMPUTED_GOTO
#define VM_LABELS \ #define VM_LABELS \
static void *vm_labels[] = { \ static void *vm_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, &&L_OP_TCALL, &&L_OP_JMP, \ NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, \
&&L_OP_BRF, &&L_OP_BRT, \ &&L_OP_TCALL, &&L_OP_JMP, &&L_OP_BRF, &&L_OP_BRT, \
&&L_OP_JMPL, &&L_OP_BRFL, &&L_OP_BRTL, &&L_OP_RET, \ &&L_OP_JMPL, &&L_OP_BRFL, &&L_OP_BRTL, &&L_OP_RET, \
\ \
&&L_OP_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, &&L_OP_NOT, \ &&L_OP_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, \
&&L_OP_NULLP, &&L_OP_BOOLEANP, \ &&L_OP_NOT, &&L_OP_NULLP, &&L_OP_BOOLEANP, &&L_OP_SYMBOLP, \
&&L_OP_SYMBOLP, &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, \ &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, &&L_OP_BUILTINP, \
&&L_OP_BUILTINP, &&L_OP_VECTORP, \ &&L_OP_VECTORP, &&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
&&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \ \
\ &&L_OP_CONS, &&L_OP_LIST, &&L_OP_CAR, &&L_OP_CDR, \
&&L_OP_CONS, &&L_OP_LIST, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_SETCAR, \ &&L_OP_SETCAR, &&L_OP_SETCDR, &&L_OP_APPLY, \
&&L_OP_SETCDR, &&L_OP_APPLY, \ \
\ &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, \
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_IDIV, &&L_OP_NUMEQ, \ &&L_OP_IDIV, &&L_OP_NUMEQ, &&L_OP_LT, &&L_OP_COMPARE, \
&&L_OP_LT, &&L_OP_COMPARE, \ \
\ &&L_OP_VECTOR, &&L_OP_AREF, &&L_OP_ASET, \
&&L_OP_VECTOR, &&L_OP_AREF, &&L_OP_ASET, \ \
\ &&L_OP_LOADT, &&L_OP_LOADF, &&L_OP_LOADNIL, &&L_OP_LOAD0, \
&&L_OP_LOADT, &&L_OP_LOADF, &&L_OP_LOADNIL, &&L_OP_LOAD0, &&L_OP_LOAD1, \ &&L_OP_LOAD1, &&L_OP_LOADI8, &&L_OP_LOADV, &&L_OP_LOADVL, \
&&L_OP_LOADI8, \ &&L_OP_LOADG, &&L_OP_LOADGL, &&L_OP_LOADA, &&L_OP_LOADAL, \
&&L_OP_LOADV, &&L_OP_LOADVL, \ &&L_OP_LOADC, &&L_OP_LOADCL, &&L_OP_SETG, &&L_OP_SETGL, \
&&L_OP_LOADG, &&L_OP_LOADGL, \ &&L_OP_SETA, &&L_OP_SETAL, &&L_OP_SETC, &&L_OP_SETCL, \
&&L_OP_LOADA, &&L_OP_LOADAL, &&L_OP_LOADC, &&L_OP_LOADCL, \ \
&&L_OP_SETG, &&L_OP_SETGL, \ &&L_OP_CLOSURE, &&L_OP_ARGC, &&L_OP_VARGC, &&L_OP_TRYCATCH, \
&&L_OP_SETA, &&L_OP_SETAL, &&L_OP_SETC, &&L_OP_SETCL, \ &&L_OP_FOR, &&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, \
\ &&L_OP_NEG, &&L_OP_LARGC, &&L_OP_LVARGC, &&L_OP_LOADA0, \
&&L_OP_CLOSURE, &&L_OP_ARGC, &&L_OP_VARGC, &&L_OP_TRYCATCH, \ &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01, &&L_OP_CALLL, \
&&L_OP_FOR, \ &&L_OP_TCALLL, &&L_OP_BRNE, &&L_OP_BRNEL, &&L_OP_CADR, \
&&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC, \ &&L_OP_BRNN, &&L_OP_BRNNL, &&L_OP_BRN, &&L_OP_BRNL, \
&&L_OP_LVARGC, \ &&L_OP_OPTARGS, &&L_OP_BRBOUND, &&L_OP_KEYARGS \
&&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01, \
&&L_OP_CALLL, &&L_OP_TCALLL, &&L_OP_BRNE, &&L_OP_BRNEL, &&L_OP_CADR,\
&&L_OP_BRNN, &&L_OP_BRNNL, &&L_OP_BRN, &&L_OP_BRNL, \
&&L_OP_OPTARGS, &&L_OP_BRBOUND, &&L_OP_KEYARGS \
} }
#define VM_APPLY_LABELS \ #define VM_APPLY_LABELS \
static void *vm_apply_labels[] = { \ static void *vm_apply_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, &&L_OP_TCALL, &&L_OP_JMP, \ NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, \
&&L_OP_BRF, &&L_OP_BRT, \ &&L_OP_TCALL, &&L_OP_JMP, &&L_OP_BRF, &&L_OP_BRT, \
&&L_OP_JMPL, &&L_OP_BRFL, &&L_OP_BRTL, &&L_OP_RET, \ &&L_OP_JMPL, &&L_OP_BRFL, &&L_OP_BRTL, &&L_OP_RET, \
\ \
&&L_OP_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, &&L_OP_NOT, \ &&L_OP_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, \
&&L_OP_NULLP, &&L_OP_BOOLEANP, \ &&L_OP_NOT, &&L_OP_NULLP, &&L_OP_BOOLEANP, &&L_OP_SYMBOLP, \
&&L_OP_SYMBOLP, &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, \ &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, &&L_OP_BUILTINP, \
&&L_OP_BUILTINP, &&L_OP_VECTORP, \ &&L_OP_VECTORP, &&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
&&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \ \
\ &&L_OP_CONS, &&apply_list, &&L_OP_CAR, &&L_OP_CDR, \
&&L_OP_CONS, &&apply_list, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_SETCAR, \ &&L_OP_SETCAR, &&L_OP_SETCDR, &&apply_apply, \
&&L_OP_SETCDR, &&apply_apply, \ \
\ &&apply_add, &&apply_sub, &&apply_mul, &&apply_div, \
&&apply_add, &&apply_sub, &&apply_mul, &&apply_div, &&L_OP_IDIV, &&L_OP_NUMEQ, \ &&L_OP_IDIV, &&L_OP_NUMEQ, &&L_OP_LT, &&L_OP_COMPARE, \
&&L_OP_LT, &&L_OP_COMPARE, \ \
\ &&apply_vector, &&L_OP_AREF, &&L_OP_ASET \
&&apply_vector, &&L_OP_AREF, &&L_OP_ASET \
} }
#else #else
#define VM_LABELS #define VM_LABELS

351
operators.c
View File

@ -6,10 +6,7 @@
extern double trunc(double x); extern double trunc(double x);
STATIC_INLINE double fpart(double arg) STATIC_INLINE double fpart(double arg) { return arg - trunc(arg); }
{
return arg - trunc(arg);
}
// given a number, determine an appropriate type for storing it // given a number, determine an appropriate type for storing it
#if 0 #if 0
@ -49,11 +46,9 @@ numerictype_t effective_numerictype(double r)
fp = fpart(r); fp = fpart(r);
if (fp != 0 || r > U64_MAX || r < S64_MIN) { if (fp != 0 || r > U64_MAX || r < S64_MIN) {
return T_DOUBLE; return T_DOUBLE;
} } else if (r >= INT_MIN && r <= INT_MAX) {
else if (r >= INT_MIN && r <= INT_MAX) {
return T_INT32; return T_INT32;
} } else if (r <= S64_MAX) {
else if (r <= S64_MAX) {
return T_INT64; return T_INT64;
} }
return T_UINT64; return T_UINT64;
@ -62,22 +57,39 @@ numerictype_t effective_numerictype(double r)
double conv_to_double(void *data, numerictype_t tag) double conv_to_double(void *data, numerictype_t tag)
{ {
double d=0; double d = 0;
switch (tag) { switch (tag) {
case T_INT8: d = (double)*(int8_t*)data; break; case T_INT8:
case T_UINT8: d = (double)*(uint8_t*)data; break; d = (double)*(int8_t *)data;
case T_INT16: d = (double)*(int16_t*)data; break; break;
case T_UINT16: d = (double)*(uint16_t*)data; break; case T_UINT8:
case T_INT32: d = (double)*(int32_t*)data; break; d = (double)*(uint8_t *)data;
case T_UINT32: d = (double)*(uint32_t*)data; break; break;
case T_INT16:
d = (double)*(int16_t *)data;
break;
case T_UINT16:
d = (double)*(uint16_t *)data;
break;
case T_INT32:
d = (double)*(int32_t *)data;
break;
case T_UINT32:
d = (double)*(uint32_t *)data;
break;
case T_INT64: case T_INT64:
d = (double)*(int64_t*)data; d = (double)*(int64_t *)data;
if (d > 0 && *(int64_t*)data < 0) // can happen! if (d > 0 && *(int64_t *)data < 0) // can happen!
d = -d; d = -d;
break; break;
case T_UINT64: d = (double)*(uint64_t*)data; break; case T_UINT64:
case T_FLOAT: d = (double)*(float*)data; break; d = (double)*(uint64_t *)data;
case T_DOUBLE: return *(double*)data; break;
case T_FLOAT:
d = (double)*(float *)data;
break;
case T_DOUBLE:
return *(double *)data;
} }
return d; return d;
} }
@ -85,41 +97,79 @@ double conv_to_double(void *data, numerictype_t tag)
void conv_from_double(void *dest, double d, numerictype_t tag) void conv_from_double(void *dest, double d, numerictype_t tag)
{ {
switch (tag) { switch (tag) {
case T_INT8: *(int8_t*)dest = d; break; case T_INT8:
case T_UINT8: *(uint8_t*)dest = d; break; *(int8_t *)dest = d;
case T_INT16: *(int16_t*)dest = d; break; break;
case T_UINT16: *(uint16_t*)dest = d; break; case T_UINT8:
case T_INT32: *(int32_t*)dest = d; break; *(uint8_t *)dest = d;
case T_UINT32: *(uint32_t*)dest = d; break; break;
case T_INT64: case T_INT16:
*(int64_t*)dest = d; *(int16_t *)dest = d;
if (d > 0 && *(int64_t*)dest < 0) // 0x8000000000000000 is a bitch break;
*(int64_t*)dest = S64_MAX; case T_UINT16:
*(uint16_t *)dest = d;
break;
case T_INT32:
*(int32_t *)dest = d;
break;
case T_UINT32:
*(uint32_t *)dest = d;
break;
case T_INT64:
*(int64_t *)dest = d;
if (d > 0 && *(int64_t *)dest < 0) // 0x8000000000000000 is a bitch
*(int64_t *)dest = S64_MAX;
break;
case T_UINT64:
*(uint64_t *)dest = (int64_t)d;
break;
case T_FLOAT:
*(float *)dest = d;
break;
case T_DOUBLE:
*(double *)dest = d;
break; break;
case T_UINT64: *(uint64_t*)dest = (int64_t)d; break;
case T_FLOAT: *(float*)dest = d; break;
case T_DOUBLE: *(double*)dest = d; break;
} }
} }
#define CONV_TO_INTTYPE(type) \ #define CONV_TO_INTTYPE(type) \
type##_t conv_to_##type(void *data, numerictype_t tag) \ type##_t conv_to_##type(void *data, numerictype_t tag) \
{ \ { \
type##_t i=0; \ type##_t i = 0; \
switch (tag) { \ switch (tag) { \
case T_INT8: i = (type##_t)*(int8_t*)data; break; \ case T_INT8: \
case T_UINT8: i = (type##_t)*(uint8_t*)data; break; \ i = (type##_t) * (int8_t *)data; \
case T_INT16: i = (type##_t)*(int16_t*)data; break; \ break; \
case T_UINT16: i = (type##_t)*(uint16_t*)data; break; \ case T_UINT8: \
case T_INT32: i = (type##_t)*(int32_t*)data; break; \ i = (type##_t) * (uint8_t *)data; \
case T_UINT32: i = (type##_t)*(uint32_t*)data; break; \ break; \
case T_INT64: i = (type##_t)*(int64_t*)data; break; \ case T_INT16: \
case T_UINT64: i = (type##_t)*(uint64_t*)data; break; \ i = (type##_t) * (int16_t *)data; \
case T_FLOAT: i = (type##_t)*(float*)data; break; \ break; \
case T_DOUBLE: i = (type##_t)*(double*)data; break; \ case T_UINT16: \
} \ i = (type##_t) * (uint16_t *)data; \
return i; \ break; \
} case T_INT32: \
i = (type##_t) * (int32_t *)data; \
break; \
case T_UINT32: \
i = (type##_t) * (uint32_t *)data; \
break; \
case T_INT64: \
i = (type##_t) * (int64_t *)data; \
break; \
case T_UINT64: \
i = (type##_t) * (uint64_t *)data; \
break; \
case T_FLOAT: \
i = (type##_t) * (float *)data; \
break; \
case T_DOUBLE: \
i = (type##_t) * (double *)data; \
break; \
} \
return i; \
}
CONV_TO_INTTYPE(int64) CONV_TO_INTTYPE(int64)
CONV_TO_INTTYPE(int32) CONV_TO_INTTYPE(int32)
@ -130,27 +180,43 @@ CONV_TO_INTTYPE(uint32)
// to cast to int64 first. // to cast to int64 first.
uint64_t conv_to_uint64(void *data, numerictype_t tag) uint64_t conv_to_uint64(void *data, numerictype_t tag)
{ {
uint64_t i=0; uint64_t i = 0;
switch (tag) { switch (tag) {
case T_INT8: i = (uint64_t)*(int8_t*)data; break; case T_INT8:
case T_UINT8: i = (uint64_t)*(uint8_t*)data; break; i = (uint64_t) * (int8_t *)data;
case T_INT16: i = (uint64_t)*(int16_t*)data; break; break;
case T_UINT16: i = (uint64_t)*(uint16_t*)data; break; case T_UINT8:
case T_INT32: i = (uint64_t)*(int32_t*)data; break; i = (uint64_t) * (uint8_t *)data;
case T_UINT32: i = (uint64_t)*(uint32_t*)data; break; break;
case T_INT64: i = (uint64_t)*(int64_t*)data; break; case T_INT16:
case T_UINT64: i = (uint64_t)*(uint64_t*)data; break; i = (uint64_t) * (int16_t *)data;
break;
case T_UINT16:
i = (uint64_t) * (uint16_t *)data;
break;
case T_INT32:
i = (uint64_t) * (int32_t *)data;
break;
case T_UINT32:
i = (uint64_t) * (uint32_t *)data;
break;
case T_INT64:
i = (uint64_t) * (int64_t *)data;
break;
case T_UINT64:
i = (uint64_t) * (uint64_t *)data;
break;
case T_FLOAT: case T_FLOAT:
if (*(float*)data >= 0) if (*(float *)data >= 0)
i = (uint64_t)*(float*)data; i = (uint64_t) * (float *)data;
else else
i = (uint64_t)(int64_t)*(float*)data; i = (uint64_t)(int64_t) * (float *)data;
break; break;
case T_DOUBLE: case T_DOUBLE:
if (*(double*)data >= 0) if (*(double *)data >= 0)
i = (uint64_t)*(double*)data; i = (uint64_t) * (double *)data;
else else
i = (uint64_t)(int64_t)*(double*)data; i = (uint64_t)(int64_t) * (double *)data;
break; break;
} }
return i; return i;
@ -159,16 +225,26 @@ uint64_t conv_to_uint64(void *data, numerictype_t tag)
int cmp_same_lt(void *a, void *b, numerictype_t tag) int cmp_same_lt(void *a, void *b, numerictype_t tag)
{ {
switch (tag) { switch (tag) {
case T_INT8: return *(int8_t*)a < *(int8_t*)b; case T_INT8:
case T_UINT8: return *(uint8_t*)a < *(uint8_t*)b; return *(int8_t *)a < *(int8_t *)b;
case T_INT16: return *(int16_t*)a < *(int16_t*)b; case T_UINT8:
case T_UINT16: return *(uint16_t*)a < *(uint16_t*)b; return *(uint8_t *)a < *(uint8_t *)b;
case T_INT32: return *(int32_t*)a < *(int32_t*)b; case T_INT16:
case T_UINT32: return *(uint32_t*)a < *(uint32_t*)b; return *(int16_t *)a < *(int16_t *)b;
case T_INT64: return *(int64_t*)a < *(int64_t*)b; case T_UINT16:
case T_UINT64: return *(uint64_t*)a < *(uint64_t*)b; return *(uint16_t *)a < *(uint16_t *)b;
case T_FLOAT: return *(float*)a < *(float*)b; case T_INT32:
case T_DOUBLE: return *(double*)a < *(double*)b; return *(int32_t *)a < *(int32_t *)b;
case T_UINT32:
return *(uint32_t *)a < *(uint32_t *)b;
case T_INT64:
return *(int64_t *)a < *(int64_t *)b;
case T_UINT64:
return *(uint64_t *)a < *(uint64_t *)b;
case T_FLOAT:
return *(float *)a < *(float *)b;
case T_DOUBLE:
return *(double *)a < *(double *)b;
} }
return 0; return 0;
} }
@ -176,23 +252,33 @@ int cmp_same_lt(void *a, void *b, numerictype_t tag)
int cmp_same_eq(void *a, void *b, numerictype_t tag) int cmp_same_eq(void *a, void *b, numerictype_t tag)
{ {
switch (tag) { switch (tag) {
case T_INT8: return *(int8_t*)a == *(int8_t*)b; case T_INT8:
case T_UINT8: return *(uint8_t*)a == *(uint8_t*)b; return *(int8_t *)a == *(int8_t *)b;
case T_INT16: return *(int16_t*)a == *(int16_t*)b; case T_UINT8:
case T_UINT16: return *(uint16_t*)a == *(uint16_t*)b; return *(uint8_t *)a == *(uint8_t *)b;
case T_INT32: return *(int32_t*)a == *(int32_t*)b; case T_INT16:
case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b; return *(int16_t *)a == *(int16_t *)b;
case T_INT64: return *(int64_t*)a == *(int64_t*)b; case T_UINT16:
case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b; return *(uint16_t *)a == *(uint16_t *)b;
case T_FLOAT: return *(float*)a == *(float*)b; case T_INT32:
case T_DOUBLE: return *(double*)a == *(double*)b; return *(int32_t *)a == *(int32_t *)b;
case T_UINT32:
return *(uint32_t *)a == *(uint32_t *)b;
case T_INT64:
return *(int64_t *)a == *(int64_t *)b;
case T_UINT64:
return *(uint64_t *)a == *(uint64_t *)b;
case T_FLOAT:
return *(float *)a == *(float *)b;
case T_DOUBLE:
return *(double *)a == *(double *)b;
} }
return 0; return 0;
} }
int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag) int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
{ {
if (atag==btag) if (atag == btag)
return cmp_same_lt(a, b, atag); return cmp_same_lt(a, b, atag);
double da = conv_to_double(a, atag); double da = conv_to_double(a, atag);
@ -207,38 +293,38 @@ int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
if (atag == T_UINT64) { if (atag == T_UINT64) {
if (btag == T_INT64) { if (btag == T_INT64) {
if (*(int64_t*)b >= 0) { if (*(int64_t *)b >= 0) {
return (*(uint64_t*)a < (uint64_t)*(int64_t*)b); return (*(uint64_t *)a < (uint64_t) * (int64_t *)b);
} }
return ((int64_t)*(uint64_t*)a < *(int64_t*)b); return ((int64_t) * (uint64_t *)a < *(int64_t *)b);
} else if (btag == T_DOUBLE) {
if (db != db)
return 0;
return (*(uint64_t *)a < (uint64_t) * (double *)b);
} }
else if (btag == T_DOUBLE) { } else if (atag == T_INT64) {
if (db != db) return 0;
return (*(uint64_t*)a < (uint64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
if (btag == T_UINT64) { if (btag == T_UINT64) {
if (*(int64_t*)a >= 0) { if (*(int64_t *)a >= 0) {
return ((uint64_t)*(int64_t*)a < *(uint64_t*)b); return ((uint64_t) * (int64_t *)a < *(uint64_t *)b);
} }
return (*(int64_t*)a < (int64_t)*(uint64_t*)b); return (*(int64_t *)a < (int64_t) * (uint64_t *)b);
} } else if (btag == T_DOUBLE) {
else if (btag == T_DOUBLE) { if (db != db)
if (db != db) return 0; return 0;
return (*(int64_t*)a < (int64_t)*(double*)b); return (*(int64_t *)a < (int64_t) * (double *)b);
} }
} }
if (btag == T_UINT64) { if (btag == T_UINT64) {
if (atag == T_DOUBLE) { if (atag == T_DOUBLE) {
if (da != da) return 0; if (da != da)
return (*(uint64_t*)b > (uint64_t)*(double*)a); return 0;
return (*(uint64_t *)b > (uint64_t) * (double *)a);
} }
} } else if (btag == T_INT64) {
else if (btag == T_INT64) {
if (atag == T_DOUBLE) { if (atag == T_DOUBLE) {
if (da != da) return 0; if (da != da)
return (*(int64_t*)b > (int64_t)*(double*)a); return 0;
return (*(int64_t *)b > (int64_t) * (double *)a);
} }
} }
return 0; return 0;
@ -247,8 +333,11 @@ int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag, int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
int equalnans) int equalnans)
{ {
union { double d; int64_t i64; } u, v; union {
if (atag==btag && (!equalnans || atag < T_FLOAT)) double d;
int64_t i64;
} u, v;
if (atag == btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, atag); return cmp_same_eq(a, b, atag);
double da = conv_to_double(a, atag); double da = conv_to_double(a, atag);
@ -256,7 +345,8 @@ int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT) { if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT) {
if (equalnans) { if (equalnans) {
u.d = da; v.d = db; u.d = da;
v.d = db;
return u.i64 == v.i64; return u.i64 == v.i64;
} }
return (da == db); return (da == db);
@ -269,34 +359,27 @@ int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
// this is safe because if a had been bigger than S64_MAX, // this is safe because if a had been bigger than S64_MAX,
// we would already have concluded that it's bigger than b. // we would already have concluded that it's bigger than b.
if (btag == T_INT64) { if (btag == T_INT64) {
return ((int64_t)*(uint64_t*)a == *(int64_t*)b); return ((int64_t) * (uint64_t *)a == *(int64_t *)b);
} else if (btag == T_DOUBLE) {
return (*(uint64_t *)a == (uint64_t)(int64_t) * (double *)b);
} }
else if (btag == T_DOUBLE) { } else if (atag == T_INT64) {
return (*(uint64_t*)a == (uint64_t)(int64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
if (btag == T_UINT64) { if (btag == T_UINT64) {
return (*(int64_t*)a == (int64_t)*(uint64_t*)b); return (*(int64_t *)a == (int64_t) * (uint64_t *)b);
} else if (btag == T_DOUBLE) {
return (*(int64_t *)a == (int64_t) * (double *)b);
} }
else if (btag == T_DOUBLE) { } else if (btag == T_UINT64) {
return (*(int64_t*)a == (int64_t)*(double*)b);
}
}
else if (btag == T_UINT64) {
if (atag == T_INT64) { if (atag == T_INT64) {
return ((int64_t)*(uint64_t*)b == *(int64_t*)a); return ((int64_t) * (uint64_t *)b == *(int64_t *)a);
} else if (atag == T_DOUBLE) {
return (*(uint64_t *)b == (uint64_t)(int64_t) * (double *)a);
} }
else if (atag == T_DOUBLE) { } else if (btag == T_INT64) {
return (*(uint64_t*)b == (uint64_t)(int64_t)*(double*)a);
}
}
else if (btag == T_INT64) {
if (atag == T_UINT64) { if (atag == T_UINT64) {
return (*(int64_t*)b == (int64_t)*(uint64_t*)a); return (*(int64_t *)b == (int64_t) * (uint64_t *)a);
} } else if (atag == T_DOUBLE) {
else if (atag == T_DOUBLE) { return (*(int64_t *)b == (int64_t) * (double *)a);
return (*(int64_t*)b == (int64_t)*(double*)a);
} }
} }
return 1; return 1;

431
print.c
View File

@ -11,7 +11,7 @@ static fixnum_t print_level;
static fixnum_t P_LEVEL; static fixnum_t P_LEVEL;
static int SCR_WIDTH = 80; static int SCR_WIDTH = 80;
static int HPOS=0, VPOS; static int HPOS = 0, VPOS;
static void outc(char c, ios_t *f) static void outc(char c, ios_t *f)
{ {
ios_putc(c, f); ios_putc(c, f);
@ -33,7 +33,7 @@ static void outsn(char *s, ios_t *f, size_t n)
static int outindent(int n, ios_t *f) static int outindent(int n, ios_t *f)
{ {
// move back to left margin if we get too indented // move back to left margin if we get too indented
if (n > SCR_WIDTH-12) if (n > SCR_WIDTH - 12)
n = 2; n = 2;
int n0 = n; int n0 = n;
ios_putc('\n', f); ios_putc('\n', f);
@ -50,22 +50,16 @@ static int outindent(int n, ios_t *f)
return n0; return n0;
} }
void fl_print_chr(char c, ios_t *f) void fl_print_chr(char c, ios_t *f) { outc(c, f); }
{
outc(c, f);
}
void fl_print_str(char *s, ios_t *f) void fl_print_str(char *s, ios_t *f) { outs(s, f); }
{
outs(s, f);
}
void print_traverse(value_t v) void print_traverse(value_t v)
{ {
value_t *bp; value_t *bp;
while (iscons(v)) { while (iscons(v)) {
if (ismarked(v)) { if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v); bp = (value_t *)ptrhash_bp(&printconses, (void *)v);
if (*bp == (value_t)HT_NOTFOUND) if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++); *bp = fixnum(printlabel++);
return; return;
@ -77,7 +71,7 @@ void print_traverse(value_t v)
if (!ismanaged(v) || issymbol(v)) if (!ismanaged(v) || issymbol(v))
return; return;
if (ismarked(v)) { if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v); bp = (value_t *)ptrhash_bp(&printconses, (void *)v);
if (*bp == (value_t)HT_NOTFOUND) if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++); *bp = fixnum(printlabel++);
return; return;
@ -86,24 +80,21 @@ void print_traverse(value_t v)
if (vector_size(v) > 0) if (vector_size(v) > 0)
mark_cons(v); mark_cons(v);
unsigned int i; unsigned int i;
for(i=0; i < vector_size(v); i++) for (i = 0; i < vector_size(v); i++)
print_traverse(vector_elt(v,i)); print_traverse(vector_elt(v, i));
} } else if (iscprim(v)) {
else if (iscprim(v)) {
// don't consider shared references to e.g. chars // don't consider shared references to e.g. chars
} } else if (isclosure(v)) {
else if (isclosure(v)) {
mark_cons(v); mark_cons(v);
function_t *f = (function_t*)ptr(v); function_t *f = (function_t *)ptr(v);
print_traverse(f->bcode); print_traverse(f->bcode);
print_traverse(f->vals); print_traverse(f->vals);
print_traverse(f->env); print_traverse(f->env);
} } else {
else {
assert(iscvalue(v)); assert(iscvalue(v));
cvalue_t *cv = (cvalue_t*)ptr(v); cvalue_t *cv = (cvalue_t *)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);
fltype_t *t = cv_class(cv); fltype_t *t = cv_class(cv);
if (t->vtable != NULL && t->vtable->print_traverse != NULL) if (t->vtable != NULL && t->vtable->print_traverse != NULL)
@ -113,18 +104,16 @@ void print_traverse(value_t v)
static void print_symbol_name(ios_t *f, char *name) static void print_symbol_name(ios_t *f, char *name)
{ {
int i, escape=0, charescape=0; int i, escape = 0, charescape = 0;
if ((name[0] == '\0') || if ((name[0] == '\0') || (name[0] == '.' && name[1] == '\0') ||
(name[0] == '.' && name[1] == '\0') || (name[0] == '#') || isnumtok(name, NULL))
(name[0] == '#') ||
isnumtok(name, NULL))
escape = 1; escape = 1;
i=0; i = 0;
while (name[i]) { while (name[i]) {
if (!symchar(name[i])) { if (!symchar(name[i])) {
escape = 1; escape = 1;
if (name[i]=='|' || name[i]=='\\') { if (name[i] == '|' || name[i] == '\\') {
charescape = 1; charescape = 1;
break; break;
} }
@ -134,22 +123,20 @@ static void print_symbol_name(ios_t *f, char *name)
if (escape) { if (escape) {
if (charescape) { if (charescape) {
outc('|', f); outc('|', f);
i=0; i = 0;
while (name[i]) { while (name[i]) {
if (name[i]=='|' || name[i]=='\\') if (name[i] == '|' || name[i] == '\\')
outc('\\', f); outc('\\', f);
outc(name[i], f); outc(name[i], f);
i++; i++;
} }
outc('|', f); outc('|', f);
} } else {
else {
outc('|', f); outc('|', f);
outs(name, f); outs(name, f);
outc('|', f); outc('|', f);
} }
} } else {
else {
outs(name, f); outs(name, f);
} }
} }
@ -169,27 +156,28 @@ 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((cvalue_t *)ptr(v)) < SMALL_STR_LEN);
return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL || return (isfixnum(v) || isbuiltin(v) || v == FL_F || v == FL_T ||
v == FL_EOF || iscprim(v)); v == FL_NIL || v == FL_EOF || iscprim(v));
} }
static int smallp(value_t v) static int smallp(value_t v)
{ {
if (tinyp(v)) return 1; if (tinyp(v))
if (fl_isnumber(v)) return 1; return 1;
if (fl_isnumber(v))
return 1;
if (iscons(v)) { if (iscons(v)) {
if (tinyp(car_(v)) && (tinyp(cdr_(v)) || if (tinyp(car_(v)) &&
(iscons(cdr_(v)) && tinyp(car_(cdr_(v))) && (tinyp(cdr_(v)) || (iscons(cdr_(v)) && tinyp(car_(cdr_(v))) &&
cdr_(cdr_(v))==NIL))) cdr_(cdr_(v)) == NIL)))
return 1; return 1;
return 0; return 0;
} }
if (isvector(v)) { if (isvector(v)) {
size_t s = vector_size(v); size_t s = vector_size(v);
return (s == 0 || (tinyp(vector_elt(v,0)) && return (s == 0 || (tinyp(vector_elt(v, 0)) &&
(s == 1 || (s == 2 && (s == 1 || (s == 2 && tinyp(vector_elt(v, 1))))));
tinyp(vector_elt(v,1))))));
} }
return 0; return 0;
} }
@ -208,7 +196,7 @@ static int lengthestimate(value_t v)
// get the width of an expression if we can do so cheaply // get the width of an expression if we can do so cheaply
if (issymbol(v)) if (issymbol(v))
return u8_strwidth(symbol_name(v)); return u8_strwidth(symbol_name(v));
if (iscprim(v) && cp_class((cprim_t*)ptr(v)) == wchartype) if (iscprim(v) && cp_class((cprim_t *)ptr(v)) == wchartype)
return 4; return 4;
return -1; return -1;
} }
@ -247,7 +235,7 @@ static int indentevery(value_t v)
value_t c = car_(v); value_t c = car_(v);
if (c == LAMBDA || c == setqsym) if (c == LAMBDA || c == setqsym)
return 0; return 0;
if (c == IF) // TODO: others if (c == IF) // TODO: others
return !allsmallp(cdr_(v)); return !allsmallp(cdr_(v));
return 0; return 0;
} }
@ -266,12 +254,12 @@ static void print_pair(ios_t *f, value_t v)
value_t cd; value_t cd;
char *op = NULL; char *op = NULL;
if (iscons(cdr_(v)) && cdr_(cdr_(v)) == NIL && if (iscons(cdr_(v)) && cdr_(cdr_(v)) == NIL &&
!ptrhash_has(&printconses, (void*)cdr_(v)) && !ptrhash_has(&printconses, (void *)cdr_(v)) &&
(((car_(v) == QUOTE) && (op = "'")) || (((car_(v) == QUOTE) && (op = "'")) ||
((car_(v) == BACKQUOTE) && (op = "`")) || ((car_(v) == BACKQUOTE) && (op = "`")) ||
((car_(v) == COMMA) && (op = ",")) || ((car_(v) == COMMA) && (op = ",")) ||
((car_(v) == COMMAAT) && (op = ",@")) || ((car_(v) == COMMAAT) && (op = ",@")) ||
((car_(v) == COMMADOT) && (op = ",.")))) { ((car_(v) == COMMADOT) && (op = ",.")))) {
// special prefix syntax // special prefix syntax
unmark_cons(v); unmark_cons(v);
unmark_cons(cdr_(v)); unmark_cons(cdr_(v));
@ -281,23 +269,24 @@ static void print_pair(ios_t *f, value_t v)
} }
int startpos = HPOS; int startpos = HPOS;
outc('(', f); outc('(', f);
int newindent=HPOS, blk=blockindent(v); int newindent = HPOS, blk = blockindent(v);
int lastv, n=0, si, ind=0, est, always=0, nextsmall, thistiny; int lastv, n = 0, si, ind = 0, est, always = 0, nextsmall, thistiny;
if (!blk) always = indentevery(v); if (!blk)
always = indentevery(v);
value_t head = car_(v); value_t head = car_(v);
int after3 = indentafter3(head, v); int after3 = indentafter3(head, v);
int after2 = indentafter2(head, v); int after2 = indentafter2(head, v);
int n_unindented = 1; int n_unindented = 1;
while (1) { while (1) {
cd = cdr_(v); cd = cdr_(v);
if (print_length >= 0 && n >= print_length && cd!=NIL) { if (print_length >= 0 && n >= print_length && cd != NIL) {
outsn("...)", f, 4); outsn("...)", f, 4);
break; break;
} }
lastv = VPOS; lastv = VPOS;
unmark_cons(v); unmark_cons(v);
fl_print_child(f, car_(v)); fl_print_child(f, car_(v));
if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) { if (!iscons(cd) || ptrhash_has(&printconses, (void *)cd)) {
if (cd != NIL) { if (cd != NIL) {
outsn(" . ", f, 3); outsn(" . ", f, 3);
fl_print_child(f, cd); fl_print_child(f, cd);
@ -306,42 +295,38 @@ static void print_pair(ios_t *f, value_t v)
break; break;
} }
if (!print_pretty || if (!print_pretty || ((head == LAMBDA) && n == 0)) {
((head == LAMBDA) && n == 0)) {
// never break line before lambda-list // never break line before lambda-list
ind = 0; ind = 0;
} } else {
else {
est = lengthestimate(car_(cd)); est = lengthestimate(car_(cd));
nextsmall = smallp(car_(cd)); nextsmall = smallp(car_(cd));
thistiny = tinyp(car_(v)); thistiny = tinyp(car_(v));
ind = (((VPOS > lastv) || ind = (((VPOS > lastv) || (HPOS > SCR_WIDTH / 2 && !nextsmall &&
(HPOS>SCR_WIDTH/2 && !nextsmall && !thistiny && n>0)) || !thistiny && n > 0)) ||
(HPOS > SCR_WIDTH-4) || (HPOS > SCR_WIDTH - 4) ||
(est!=-1 && (HPOS+est > SCR_WIDTH-2)) || (est != -1 && (HPOS + est > SCR_WIDTH - 2)) ||
((head == LAMBDA) && !nextsmall) || ((head == LAMBDA) && !nextsmall) ||
(n > 0 && always) || (n > 0 && always) ||
(n == 2 && after3) || (n == 2 && after3) || (n == 1 && after2) ||
(n == 1 && after2) ||
(n_unindented >= 3 && !nextsmall) || (n_unindented >= 3 && !nextsmall) ||
(n == 0 && !smallp(head))); (n == 0 && !smallp(head)));
} }
if (ind) { if (ind) {
newindent = outindent(newindent, f); newindent = outindent(newindent, f);
n_unindented = 1; n_unindented = 1;
} } else {
else {
n_unindented++; n_unindented++;
outc(' ', f); outc(' ', f);
if (n==0) { if (n == 0) {
// set indent level after printing head // set indent level after printing head
si = specialindent(head); si = specialindent(head);
if (si != -1) if (si != -1)
@ -360,13 +345,13 @@ static void cvalue_print(ios_t *f, value_t v);
static int print_circle_prefix(ios_t *f, value_t v) static int print_circle_prefix(ios_t *f, value_t v)
{ {
value_t label; value_t label;
if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) != if ((label = (value_t)ptrhash_get(&printconses, (void *)v)) !=
(value_t)HT_NOTFOUND) { (value_t)HT_NOTFOUND) {
if (!ismarked(v)) { if (!ismarked(v)) {
HPOS+=ios_printf(f, "#%ld#", numval(label)); HPOS += ios_printf(f, "#%ld#", numval(label));
return 1; return 1;
} }
HPOS+=ios_printf(f, "#%ld=", numval(label)); HPOS += ios_printf(f, "#%ld=", numval(label));
} }
if (ismanaged(v)) if (ismanaged(v))
unmark_cons(v); unmark_cons(v);
@ -384,8 +369,10 @@ void fl_print_child(ios_t *f, value_t v)
P_LEVEL++; P_LEVEL++;
switch (tag(v)) { switch (tag(v)) {
case TAG_NUM : case TAG_NUM:
case TAG_NUM1: HPOS+=ios_printf(f, "%ld", numval(v)); break; case TAG_NUM1:
HPOS += ios_printf(f, "%ld", numval(v));
break;
case TAG_SYM: case TAG_SYM:
name = symbol_name(v); name = symbol_name(v);
if (print_princ) if (print_princ)
@ -393,39 +380,36 @@ void fl_print_child(ios_t *f, value_t v)
else if (ismanaged(v)) { else if (ismanaged(v)) {
outsn("#:", f, 2); outsn("#:", f, 2);
outs(name, f); outs(name, f);
} } else
else
print_symbol_name(f, name); print_symbol_name(f, name);
break; break;
case TAG_FUNCTION: case TAG_FUNCTION:
if (v == FL_T) { if (v == FL_T) {
outsn("#t", f, 2); outsn("#t", f, 2);
} } else if (v == FL_F) {
else if (v == FL_F) {
outsn("#f", f, 2); outsn("#f", f, 2);
} } else if (v == FL_NIL) {
else if (v == FL_NIL) {
outsn("()", f, 2); outsn("()", f, 2);
} } else if (v == FL_EOF) {
else if (v == FL_EOF) {
outsn("#<eof>", f, 6); outsn("#<eof>", f, 6);
} } else if (isbuiltin(v)) {
else if (isbuiltin(v)) {
if (!print_princ) if (!print_princ)
outsn("#.", f, 2); outsn("#.", f, 2);
outs(builtin_names[uintval(v)], f); outs(builtin_names[uintval(v)], f);
} } else {
else {
assert(isclosure(v)); assert(isclosure(v));
if (!print_princ) { if (!print_princ) {
if (print_circle_prefix(f, v)) break; if (print_circle_prefix(f, v))
function_t *fn = (function_t*)ptr(v); break;
function_t *fn = (function_t *)ptr(v);
outs("#fn(", f); outs("#fn(", f);
char *data = cvalue_data(fn->bcode); char *data = cvalue_data(fn->bcode);
size_t i, sz = cvalue_len(fn->bcode); size_t i, sz = cvalue_len(fn->bcode);
for(i=0; i < sz; i++) data[i] += 48; for (i = 0; i < sz; i++)
data[i] += 48;
fl_print_child(f, fn->bcode); fl_print_child(f, fn->bcode);
for(i=0; i < sz; i++) data[i] -= 48; for (i = 0; i < sz; i++)
data[i] -= 48;
outc(' ', f); outc(' ', f);
fl_print_child(f, fn->vals); fl_print_child(f, fn->vals);
if (fn->env != NIL) { if (fn->env != NIL) {
@ -437,8 +421,7 @@ void fl_print_child(ios_t *f, value_t v)
fl_print_child(f, fn->name); fl_print_child(f, fn->name);
} }
outc(')', f); outc(')', f);
} } else {
else {
outs("#<function>", f); outs("#<function>", f);
} }
} }
@ -452,28 +435,28 @@ void fl_print_child(ios_t *f, value_t v)
case TAG_CVALUE: case TAG_CVALUE:
case TAG_VECTOR: case TAG_VECTOR:
case TAG_CONS: case TAG_CONS:
if (!print_princ && print_circle_prefix(f, v)) break; if (!print_princ && print_circle_prefix(f, v))
break;
if (isvector(v)) { if (isvector(v)) {
outc('[', f); outc('[', f);
int newindent = HPOS, est; int newindent = HPOS, est;
int i, sz = vector_size(v); int i, sz = vector_size(v);
for(i=0; i < sz; i++) { for (i = 0; i < sz; i++) {
if (print_length >= 0 && i >= print_length && i < sz-1) { if (print_length >= 0 && i >= print_length && i < sz - 1) {
outsn("...", f, 3); outsn("...", f, 3);
break; break;
} }
fl_print_child(f, vector_elt(v,i)); fl_print_child(f, vector_elt(v, i));
if (i < sz-1) { if (i < sz - 1) {
if (!print_pretty) { if (!print_pretty) {
outc(' ', f); outc(' ', f);
} } else {
else { est = lengthestimate(vector_elt(v, i + 1));
est = lengthestimate(vector_elt(v,i+1)); if (HPOS > SCR_WIDTH - 4 ||
if (HPOS > SCR_WIDTH-4 || (est != -1 && (HPOS + est > SCR_WIDTH - 2)) ||
(est!=-1 && (HPOS+est > SCR_WIDTH-2)) || (HPOS > SCR_WIDTH / 2 &&
(HPOS > SCR_WIDTH/2 && !smallp(vector_elt(v, i + 1)) &&
!smallp(vector_elt(v,i+1)) && !tinyp(vector_elt(v, i))))
!tinyp(vector_elt(v,i))))
newindent = outindent(newindent, f); newindent = outindent(newindent, f);
else else
outc(' ', f); outc(' ', f);
@ -502,7 +485,7 @@ static void print_string(ios_t *f, char *str, size_t sz)
outc('"', f); outc('"', f);
if (!u8_isvalid(str, sz)) { if (!u8_isvalid(str, sz)) {
// alternate print algorithm that preserves data if it's not UTF-8 // alternate print algorithm that preserves data if it's not UTF-8
for(i=0; i < sz; i++) { for (i = 0; i < sz; i++) {
c = str[i]; c = str[i];
if (c == '\\') if (c == '\\')
outsn("\\\\", f, 2); outsn("\\\\", f, 2);
@ -512,15 +495,14 @@ static void print_string(ios_t *f, char *str, size_t sz)
outc(c, f); outc(c, f);
else { else {
outsn("\\x", f, 2); outsn("\\x", f, 2);
outc(hexdig[c>>4], f); outc(hexdig[c >> 4], f);
outc(hexdig[c&0xf], f); outc(hexdig[c & 0xf], f);
} }
} }
} } else {
else {
while (i < sz) { while (i < sz) {
size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0); size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);
outsn(buf, f, n-1); outsn(buf, f, n - 1);
} }
} }
outc('"', f); outc('"', f);
@ -535,8 +517,8 @@ int double_exponent(double d)
} }
void snprint_real(char *s, size_t cnt, double r, void snprint_real(char *s, size_t cnt, double r,
int width, // printf field width, or 0 int width, // printf field width, or 0
int dec, // # decimal digits desired, recommend 16 int dec, // # decimal digits desired, recommend 16
// # of zeros in .00...0x before using scientific notation // # of zeros in .00...0x before using scientific notation
// recommend 3-4 or so // recommend 3-4 or so
int max_digs_rt, int max_digs_rt,
@ -548,12 +530,12 @@ void snprint_real(char *s, size_t cnt, double r,
double fpart, temp; double fpart, temp;
char format[8]; char format[8];
char num_format[3]; char num_format[3];
int sz, keepz=0; int sz, keepz = 0;
s[0] = '\0'; s[0] = '\0';
if (width == -1) { if (width == -1) {
width = 0; width = 0;
keepz=1; keepz = 1;
} }
if (isnan(r)) { if (isnan(r)) {
if (sign_bit(r)) if (sign_bit(r))
@ -572,15 +554,14 @@ void snprint_real(char *s, size_t cnt, double r,
mag = double_exponent(r); mag = double_exponent(r);
mag = (int)(((double)mag)/LOG2_10 + 0.5); mag = (int)(((double)mag) / LOG2_10 + 0.5);
if (r == 0) if (r == 0)
mag = 0; mag = 0;
if ((mag > max_digs_lf-1) || (mag < -max_digs_rt)) { if ((mag > max_digs_lf - 1) || (mag < -max_digs_rt)) {
num_format[1] = 'e'; num_format[1] = 'e';
temp = r/pow(10, mag); /* see if number will have a decimal */ temp = r / pow(10, mag); /* see if number will have a decimal */
fpart = temp - floor(temp); /* when written in scientific notation */ fpart = temp - floor(temp); /* when written in scientific notation */
} } else {
else {
num_format[1] = 'f'; num_format[1] = 'f';
fpart = r - floor(r); fpart = r - floor(r);
} }
@ -588,8 +569,7 @@ void snprint_real(char *s, size_t cnt, double r,
dec = 0; dec = 0;
if (width == 0) { if (width == 0) {
snprintf(format, 8, "%%.%d%s", dec, num_format); snprintf(format, 8, "%%.%d%s", dec, num_format);
} } else {
else {
snprintf(format, 8, "%%%d.%d%s", width, dec, num_format); snprintf(format, 8, "%%%d.%d%s", width, dec, num_format);
} }
sz = snprintf(s, cnt, format, r); sz = snprintf(s, cnt, format, r);
@ -597,14 +577,14 @@ void snprint_real(char *s, size_t cnt, double r,
notation, since we might have e.g. 1.2000e+100. also not when we notation, since we might have e.g. 1.2000e+100. also not when we
need a specific output width */ need a specific output width */
if (width == 0 && !keepz) { if (width == 0 && !keepz) {
if (sz > 2 && fpart && num_format[1]!='e') { if (sz > 2 && fpart && num_format[1] != 'e') {
while (s[sz-1] == '0') { while (s[sz - 1] == '0') {
s[sz-1]='\0'; s[sz - 1] = '\0';
sz--; sz--;
} }
// don't need trailing . // don't need trailing .
if (s[sz-1] == '.') { if (s[sz - 1] == '.') {
s[sz-1] = '\0'; s[sz - 1] = '\0';
sz--; sz--;
} }
} }
@ -623,16 +603,15 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
int weak) int weak)
{ {
if (type == bytesym) { if (type == bytesym) {
unsigned char ch = *(unsigned char*)data; unsigned char ch = *(unsigned char *)data;
if (print_princ) if (print_princ)
outc(ch, f); outc(ch, f);
else if (weak) else if (weak)
HPOS+=ios_printf(f, "0x%hhx", ch); HPOS += ios_printf(f, "0x%hhx", ch);
else else
HPOS+=ios_printf(f, "#byte(0x%hhx)", ch); HPOS += ios_printf(f, "#byte(0x%hhx)", ch);
} } else if (type == wcharsym) {
else if (type == wcharsym) { uint32_t wc = *(uint32_t *)data;
uint32_t wc = *(uint32_t*)data;
char seq[8]; char seq[8];
size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1); size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
seq[nb] = '\0'; seq[nb] = '\0';
@ -642,31 +621,46 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
ios_putc(0, f); ios_putc(0, f);
else else
outs(seq, f); outs(seq, f);
} } else {
else {
outsn("#\\", f, 2); outsn("#\\", f, 2);
if (wc == 0x00) outsn("nul", f, 3); if (wc == 0x00)
else if (wc == 0x07) outsn("alarm", f, 5); outsn("nul", f, 3);
else if (wc == 0x08) outsn("backspace", f, 9); else if (wc == 0x07)
else if (wc == 0x09) outsn("tab", f, 3); outsn("alarm", f, 5);
//else if (wc == 0x0A) outsn("linefeed", f, 8); else if (wc == 0x08)
else if (wc == 0x0A) outsn("newline", f, 7); outsn("backspace", f, 9);
else if (wc == 0x0B) outsn("vtab", f, 4); else if (wc == 0x09)
else if (wc == 0x0C) outsn("page", f, 4); outsn("tab", f, 3);
else if (wc == 0x0D) outsn("return", f, 6); // else if (wc == 0x0A) outsn("linefeed", f, 8);
else if (wc == 0x1B) outsn("esc", f, 3); else if (wc == 0x0A)
//else if (wc == 0x20) outsn("space", f, 5); outsn("newline", f, 7);
else if (wc == 0x7F) outsn("delete", f, 6); else if (wc == 0x0B)
else if (iswprint(wc)) outs(seq, f); outsn("vtab", f, 4);
else HPOS+=ios_printf(f, "x%04x", (int)wc); else if (wc == 0x0C)
outsn("page", f, 4);
else if (wc == 0x0D)
outsn("return", f, 6);
else if (wc == 0x1B)
outsn("esc", f, 3);
// else if (wc == 0x20) outsn("space", f, 5);
else if (wc == 0x7F)
outsn("delete", f, 6);
else if (iswprint(wc))
outs(seq, f);
else
HPOS += ios_printf(f, "x%04x", (int)wc);
} }
} } else if (type == floatsym || type == doublesym) {
else if (type == floatsym || type == doublesym) {
char buf[64]; char buf[64];
double d; double d;
int ndec; int ndec;
if (type == floatsym) { d = (double)*(float*)data; ndec = 8; } if (type == floatsym) {
else { d = *(double*)data; ndec = 16; } d = (double)*(float *)data;
ndec = 8;
} else {
d = *(double *)data;
ndec = 16;
}
if (!DFINITE(d)) { if (!DFINITE(d)) {
char *rep; char *rep;
if (isnan(d)) if (isnan(d))
@ -674,66 +668,60 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
else else
rep = sign_bit(d) ? "-inf.0" : "+inf.0"; rep = sign_bit(d) ? "-inf.0" : "+inf.0";
if (type == floatsym && !print_princ && !weak) if (type == floatsym && !print_princ && !weak)
HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep); HPOS += ios_printf(f, "#%s(%s)", symbol_name(type), rep);
else else
outs(rep, f); outs(rep, f);
} } else if (d == 0) {
else if (d == 0) { if (1 / d < 0)
if (1/d < 0)
outsn("-0.0", f, 4); outsn("-0.0", f, 4);
else else
outsn("0.0", f, 3); outsn("0.0", f, 3);
if (type == floatsym && !print_princ && !weak) if (type == floatsym && !print_princ && !weak)
outc('f', f); outc('f', f);
} } else {
else {
snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10); snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
int hasdec = (strpbrk(buf, ".eE") != NULL); int hasdec = (strpbrk(buf, ".eE") != NULL);
outs(buf, f); outs(buf, f);
if (!hasdec) outsn(".0", f, 2); if (!hasdec)
outsn(".0", f, 2);
if (type == floatsym && !print_princ && !weak) if (type == floatsym && !print_princ && !weak)
outc('f', f); outc('f', f);
} }
} } else if (type == uint64sym
else if (type == uint64sym
#ifdef BITS64 #ifdef BITS64
|| type == ulongsym || type == ulongsym
#endif #endif
) { ) {
uint64_t ui64 = *(uint64_t*)data; uint64_t ui64 = *(uint64_t *)data;
if (weak || print_princ) if (weak || print_princ)
HPOS += ios_printf(f, "%llu", ui64); HPOS += ios_printf(f, "%llu", ui64);
else else
HPOS += ios_printf(f, "#%s(%llu)", symbol_name(type), ui64); HPOS += ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
} } else if (issymbol(type)) {
else if (issymbol(type)) {
// handle other integer prims. we know it's smaller than uint64 // handle other integer prims. we know it's smaller than uint64
// at this point, so int64 is big enough to capture everything. // at this point, so int64 is big enough to capture everything.
numerictype_t nt = sym_to_numtype(type); numerictype_t nt = sym_to_numtype(type);
if (nt == N_NUMTYPES) { if (nt == N_NUMTYPES) {
HPOS += ios_printf(f, "#<%s>", symbol_name(type)); HPOS += ios_printf(f, "#<%s>", symbol_name(type));
} } else {
else {
int64_t i64 = conv_to_int64(data, nt); int64_t i64 = conv_to_int64(data, nt);
if (weak || print_princ) if (weak || print_princ)
HPOS += ios_printf(f, "%lld", i64); HPOS += ios_printf(f, "%lld", i64);
else else
HPOS += ios_printf(f, "#%s(%lld)", symbol_name(type), i64); HPOS += ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
} }
} } else if (iscons(type)) {
else if (iscons(type)) {
if (car_(type) == arraysym) { if (car_(type) == arraysym) {
value_t eltype = car(cdr_(type)); value_t eltype = car(cdr_(type));
size_t cnt, elsize; size_t cnt, elsize;
if (iscons(cdr_(cdr_(type)))) { if (iscons(cdr_(cdr_(type)))) {
cnt = toulong(car_(cdr_(cdr_(type))), "length"); cnt = toulong(car_(cdr_(cdr_(type))), "length");
elsize = cnt ? len/cnt : 0; elsize = cnt ? len / cnt : 0;
} } else {
else {
// incomplete array type // incomplete array type
int junk; int junk;
elsize = ctype_sizeof(eltype, &junk); elsize = ctype_sizeof(eltype, &junk);
cnt = elsize ? len/elsize : 0; cnt = elsize ? len / elsize : 0;
} }
if (eltype == bytesym) { if (eltype == bytesym) {
if (print_princ) { if (print_princ) {
@ -745,45 +733,39 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
else else
HPOS += u8_strwidth(data); HPOS += u8_strwidth(data);
*/ */
} } else {
else { print_string(f, (char *)data, len);
print_string(f, (char*)data, len);
} }
return; return;
} } else if (eltype == wcharsym) {
else if (eltype == wcharsym) {
// TODO wchar // TODO wchar
} } else {
else {
} }
size_t i; size_t i;
if (!weak) { if (!weak) {
if (eltype == uint8sym) { if (eltype == uint8sym) {
outsn("#vu8(", f, 5); outsn("#vu8(", f, 5);
} } else {
else {
outsn("#array(", f, 7); outsn("#array(", f, 7);
fl_print_child(f, eltype); fl_print_child(f, eltype);
if (cnt > 0) if (cnt > 0)
outc(' ', f); outc(' ', f);
} }
} } else {
else {
outc('[', f); outc('[', f);
} }
for(i=0; i < cnt; i++) { for (i = 0; i < cnt; i++) {
if (i > 0) if (i > 0)
outc(' ', f); outc(' ', f);
cvalue_printdata(f, data, elsize, eltype, 1); cvalue_printdata(f, data, elsize, eltype, 1);
data = (char*)data + elsize; data = (char *)data + elsize;
} }
if (!weak) if (!weak)
outc(')', f); outc(')', f);
else else
outc(']', f); outc(']', f);
} } else if (car_(type) == enumsym) {
else if (car_(type) == enumsym) { int n = *(int *)data;
int n = *(int*)data;
value_t syms = car(cdr_(type)); value_t syms = car(cdr_(type));
assert(isvector(syms)); assert(isvector(syms));
if (!weak) { if (!weak) {
@ -793,8 +775,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
} }
if (n >= (int)vector_size(syms)) { if (n >= (int)vector_size(syms)) {
cvalue_printdata(f, data, len, int32sym, 1); cvalue_printdata(f, data, len, int32sym, 1);
} } else {
else {
fl_print_child(f, vector_elt(syms, n)); fl_print_child(f, vector_elt(syms, n));
} }
if (!weak) if (!weak)
@ -805,33 +786,29 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
static void cvalue_print(ios_t *f, value_t v) static void cvalue_print(ios_t *f, value_t v)
{ {
cvalue_t *cv = (cvalue_t*)ptr(v); cvalue_t *cv = (cvalue_t *)ptr(v);
void *data = cptr(v); void *data = cptr(v);
value_t label; value_t label;
if (cv_class(cv) == builtintype) { if (cv_class(cv) == builtintype) {
void *fptr = *(void**)data; void *fptr = *(void **)data;
label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv); label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
if (label == (value_t)HT_NOTFOUND) { if (label == (value_t)HT_NOTFOUND) {
HPOS += ios_printf(f, "#<builtin @0x%08zx>", HPOS +=
(size_t)(builtin_t)fptr); ios_printf(f, "#<builtin @0x%08zx>", (size_t)(builtin_t)fptr);
} } else {
else {
if (print_princ) { if (print_princ) {
outs(symbol_name(label), f); outs(symbol_name(label), f);
} } else {
else {
outsn("#fn(", f, 4); outsn("#fn(", f, 4);
outs(symbol_name(label), f); outs(symbol_name(label), f);
outc(')', f); outc(')', f);
} }
} }
} } else if (cv_class(cv)->vtable != NULL &&
else if (cv_class(cv)->vtable != NULL && cv_class(cv)->vtable->print != NULL) {
cv_class(cv)->vtable->print != NULL) {
cv_class(cv)->vtable->print(v, f); cv_class(cv)->vtable->print(v, f);
} } else {
else {
value_t type = cv_type(cv); value_t type = cv_type(cv);
size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv); size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
cvalue_printdata(f, data, len, type, 0); cvalue_printdata(f, data, len, type, 0);
@ -841,7 +818,8 @@ static void cvalue_print(ios_t *f, value_t v)
static void set_print_width(void) static void set_print_width(void)
{ {
value_t pw = symbol_value(printwidthsym); value_t pw = symbol_value(printwidthsym);
if (!isfixnum(pw)) return; if (!isfixnum(pw))
return;
SCR_WIDTH = numval(pw); SCR_WIDTH = numval(pw);
} }
@ -853,25 +831,30 @@ void fl_print(ios_t *f, value_t v)
print_princ = (symbol_value(printreadablysym) == FL_F); print_princ = (symbol_value(printreadablysym) == FL_F);
value_t pl = symbol_value(printlengthsym); value_t pl = symbol_value(printlengthsym);
if (isfixnum(pl)) print_length = numval(pl); if (isfixnum(pl))
else print_length = -1; print_length = numval(pl);
else
print_length = -1;
pl = symbol_value(printlevelsym); pl = symbol_value(printlevelsym);
if (isfixnum(pl)) print_level = numval(pl); if (isfixnum(pl))
else print_level = -1; print_level = numval(pl);
else
print_level = -1;
P_LEVEL = 0; P_LEVEL = 0;
printlabel = 0; printlabel = 0;
if (!print_princ) print_traverse(v); if (!print_princ)
print_traverse(v);
HPOS = VPOS = 0; HPOS = VPOS = 0;
fl_print_child(f, v); fl_print_child(f, v);
if (print_level >= 0 || print_length >= 0) { if (print_level >= 0 || print_length >= 0) {
memset(consflags, 0, 4*bitvector_nwords(heapsize/sizeof(cons_t))); memset(consflags, 0, 4 * bitvector_nwords(heapsize / sizeof(cons_t)));
} }
if ((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) && if ((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) &&
!fl_isstring(v) && v!=FL_T && v!=FL_F && v!=FL_NIL) { !fl_isstring(v) && v != FL_T && v != FL_F && v != FL_NIL) {
htable_reset(&printconses, 32); htable_reset(&printconses, 32);
} }
} }

345
read.c
View File

@ -1,11 +1,28 @@
enum { enum {
TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM, TOK_NONE,
TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT, TOK_OPEN,
TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN, TOK_CLOSE,
TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE TOK_DOT,
TOK_QUOTE,
TOK_SYM,
TOK_NUM,
TOK_BQ,
TOK_COMMA,
TOK_COMMAAT,
TOK_COMMADOT,
TOK_SHARPDOT,
TOK_LABEL,
TOK_BACKREF,
TOK_SHARPQUOTE,
TOK_SHARPOPEN,
TOK_OPENB,
TOK_CLOSEB,
TOK_SHARPSYM,
TOK_GENSYM,
TOK_DOUBLEQUOTE
}; };
#define F value2c(ios_t*,readstate->source) #define F value2c(ios_t *, readstate->source)
// defines which characters are ordinary symbol characters. // defines which characters are ordinary symbol characters.
// exceptions are '.', which is an ordinary symbol character // exceptions are '.', which is an ordinary symbol character
@ -25,53 +42,59 @@ int isnumtok_base(char *tok, value_t *pval, int base)
double d; double d;
if (*tok == '\0') if (*tok == '\0')
return 0; return 0;
if (!((tok[0]=='0' && tok[1]=='x') || (base >= 15)) && if (!((tok[0] == '0' && tok[1] == 'x') || (base >= 15)) &&
strpbrk(tok, ".eEpP")) { strpbrk(tok, ".eEpP")) {
d = strtod(tok, &end); d = strtod(tok, &end);
if (*end == '\0') { if (*end == '\0') {
if (pval) *pval = mk_double(d); if (pval)
*pval = mk_double(d);
return 1; return 1;
} }
// floats can end in f or f0 // floats can end in f or f0
if (end > tok && end[0] == 'f' && if (end > tok && end[0] == 'f' &&
(end[1] == '\0' || (end[1] == '\0' || (end[1] == '0' && end[2] == '\0'))) {
(end[1] == '0' && end[2] == '\0'))) { if (pval)
if (pval) *pval = mk_float((float)d); *pval = mk_float((float)d);
return 1; return 1;
} }
} }
if (tok[0] == '+') { if (tok[0] == '+') {
if (!strcmp(tok,"+NaN") || !strcasecmp(tok,"+nan.0")) { if (!strcmp(tok, "+NaN") || !strcasecmp(tok, "+nan.0")) {
if (pval) *pval = mk_double(D_PNAN); if (pval)
*pval = mk_double(D_PNAN);
return 1; return 1;
} }
if (!strcmp(tok,"+Inf") || !strcasecmp(tok,"+inf.0")) { if (!strcmp(tok, "+Inf") || !strcasecmp(tok, "+inf.0")) {
if (pval) *pval = mk_double(D_PINF); if (pval)
*pval = mk_double(D_PINF);
return 1; return 1;
} }
} } else if (tok[0] == '-') {
else if (tok[0] == '-') { if (!strcmp(tok, "-NaN") || !strcasecmp(tok, "-nan.0")) {
if (!strcmp(tok,"-NaN") || !strcasecmp(tok,"-nan.0")) { if (pval)
if (pval) *pval = mk_double(D_NNAN); *pval = mk_double(D_NNAN);
return 1; return 1;
} }
if (!strcmp(tok,"-Inf") || !strcasecmp(tok,"-inf.0")) { if (!strcmp(tok, "-Inf") || !strcasecmp(tok, "-inf.0")) {
if (pval) *pval = mk_double(D_NINF); if (pval)
*pval = mk_double(D_NINF);
return 1; return 1;
} }
errno = 0; errno = 0;
i64 = strtoll(tok, &end, base); i64 = strtoll(tok, &end, base);
if (errno) if (errno)
return 0; return 0;
if (pval) *pval = return_from_int64(i64); if (pval)
*pval = return_from_int64(i64);
return (*end == '\0'); return (*end == '\0');
} }
errno = 0; errno = 0;
ui64 = strtoull(tok, &end, base); ui64 = strtoull(tok, &end, base);
if (errno) if (errno)
return 0; return 0;
if (pval) *pval = return_from_uint64(ui64); if (pval)
*pval = return_from_uint64(ui64);
return (*end == '\0'); return (*end == '\0');
} }
@ -103,8 +126,7 @@ static char nextchar(void)
do { do {
if (f->bpos < f->size) { if (f->bpos < f->size) {
ch = f->buf[f->bpos++]; ch = f->buf[f->bpos++];
} } else {
else {
ch = ios_getc(f); ch = ios_getc(f);
if (ch == IOS_EOF) if (ch == IOS_EOF)
return 0; return 0;
@ -119,26 +141,23 @@ static char nextchar(void)
} while ((char)ch != '\n'); } while ((char)ch != '\n');
c = (char)ch; c = (char)ch;
} }
} while (c==' ' || isspace(c)); } while (c == ' ' || isspace(c));
return c; return c;
} }
static void take(void) static void take(void) { toktype = TOK_NONE; }
{
toktype = TOK_NONE;
}
static void accumchar(char c, int *pi) static void accumchar(char c, int *pi)
{ {
buf[(*pi)++] = c; buf[(*pi)++] = c;
if (*pi >= (int)(sizeof(buf)-1)) if (*pi >= (int)(sizeof(buf) - 1))
lerror(ParseError, "read: token too long"); lerror(ParseError, "read: token too long");
} }
// return: 1 if escaped (forced to be symbol) // return: 1 if escaped (forced to be symbol)
static int read_token(char c, int digits) static int read_token(char c, int digits)
{ {
int i=0, ch, escaped=0, issym=0, first=1; int i = 0, ch, escaped = 0, issym = 0, first = 1;
while (1) { while (1) {
if (!first) { if (!first) {
@ -151,23 +170,20 @@ static int read_token(char c, int digits)
if (c == '|') { if (c == '|') {
issym = 1; issym = 1;
escaped = !escaped; escaped = !escaped;
} } else if (c == '\\') {
else if (c == '\\') {
issym = 1; issym = 1;
ch = ios_getc(F); ch = ios_getc(F);
if (ch == IOS_EOF) if (ch == IOS_EOF)
goto terminate; goto terminate;
accumchar((char)ch, &i); accumchar((char)ch, &i);
} } else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) {
else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) {
break; break;
} } else {
else {
accumchar(c, &i); accumchar(c, &i);
} }
} }
ios_ungetc(c, F); ios_ungetc(c, F);
terminate: terminate:
buf[i++] = '\0'; buf[i++] = '\0';
return issym; return issym;
} }
@ -183,42 +199,36 @@ static u_int32_t peek(void)
if (toktype != TOK_NONE) if (toktype != TOK_NONE)
return toktype; return toktype;
c = nextchar(); c = nextchar();
if (ios_eof(F)) return TOK_NONE; if (ios_eof(F))
return TOK_NONE;
if (c == '(') { if (c == '(') {
toktype = TOK_OPEN; toktype = TOK_OPEN;
} } else if (c == ')') {
else if (c == ')') {
toktype = TOK_CLOSE; toktype = TOK_CLOSE;
} } else if (c == '[') {
else if (c == '[') {
toktype = TOK_OPENB; toktype = TOK_OPENB;
} } else if (c == ']') {
else if (c == ']') {
toktype = TOK_CLOSEB; toktype = TOK_CLOSEB;
} } else if (c == '\'') {
else if (c == '\'') {
toktype = TOK_QUOTE; toktype = TOK_QUOTE;
} } else if (c == '`') {
else if (c == '`') {
toktype = TOK_BQ; toktype = TOK_BQ;
} } else if (c == '"') {
else if (c == '"') {
toktype = TOK_DOUBLEQUOTE; toktype = TOK_DOUBLEQUOTE;
} } else if (c == '#') {
else if (c == '#') { ch = ios_getc(F);
ch = ios_getc(F); c = (char)ch; c = (char)ch;
if (ch == IOS_EOF) if (ch == IOS_EOF)
lerror(ParseError, "read: invalid read macro"); lerror(ParseError, "read: invalid read macro");
if (c == '.') { if (c == '.') {
toktype = TOK_SHARPDOT; toktype = TOK_SHARPDOT;
} } else if (c == '\'') {
else if (c == '\'') {
toktype = TOK_SHARPQUOTE; toktype = TOK_SHARPQUOTE;
} } else if (c == '\\') {
else if (c == '\\') {
uint32_t cval; uint32_t cval;
if (ios_getutf8(F, &cval) == IOS_EOF) if (ios_getutf8(F, &cval) == IOS_EOF)
lerror(ParseError, "read: end of input in character constant"); lerror(ParseError,
"read: end of input in character constant");
if (cval == (uint32_t)'u' || cval == (uint32_t)'U' || if (cval == (uint32_t)'u' || cval == (uint32_t)'U' ||
cval == (uint32_t)'x') { cval == (uint32_t)'x') {
read_token('u', 0); read_token('u', 0);
@ -228,36 +238,45 @@ static u_int32_t peek(void)
"read: invalid hex character constant"); "read: invalid hex character constant");
cval = numval(tokval); cval = numval(tokval);
} }
} } else if (cval >= 'a' && cval <= 'z') {
else if (cval >= 'a' && cval <= 'z') {
read_token((char)cval, 0); read_token((char)cval, 0);
tokval = symbol(buf); tokval = symbol(buf);
if (buf[1] == '\0') /* one character */; if (buf[1] == '\0') /* one character */
else if (tokval == nulsym) cval = 0x00; ;
else if (tokval == alarmsym) cval = 0x07; else if (tokval == nulsym)
else if (tokval == backspacesym) cval = 0x08; cval = 0x00;
else if (tokval == tabsym) cval = 0x09; else if (tokval == alarmsym)
else if (tokval == linefeedsym) cval = 0x0A; cval = 0x07;
else if (tokval == newlinesym) cval = 0x0A; else if (tokval == backspacesym)
else if (tokval == vtabsym) cval = 0x0B; cval = 0x08;
else if (tokval == pagesym) cval = 0x0C; else if (tokval == tabsym)
else if (tokval == returnsym) cval = 0x0D; cval = 0x09;
else if (tokval == escsym) cval = 0x1B; else if (tokval == linefeedsym)
else if (tokval == spacesym) cval = 0x20; cval = 0x0A;
else if (tokval == deletesym) cval = 0x7F; else if (tokval == newlinesym)
cval = 0x0A;
else if (tokval == vtabsym)
cval = 0x0B;
else if (tokval == pagesym)
cval = 0x0C;
else if (tokval == returnsym)
cval = 0x0D;
else if (tokval == escsym)
cval = 0x1B;
else if (tokval == spacesym)
cval = 0x20;
else if (tokval == deletesym)
cval = 0x7F;
else else
lerrorf(ParseError, "read: unknown character #\\%s", buf); lerrorf(ParseError, "read: unknown character #\\%s", buf);
} }
toktype = TOK_NUM; toktype = TOK_NUM;
tokval = mk_wchar(cval); tokval = mk_wchar(cval);
} } else if (c == '(') {
else if (c == '(') {
toktype = TOK_SHARPOPEN; toktype = TOK_SHARPOPEN;
} } else if (c == '<') {
else if (c == '<') {
lerror(ParseError, "read: unreadable object"); lerror(ParseError, "read: unreadable object");
} } else if (isdigit(c)) {
else if (isdigit(c)) {
read_token(c, 1); read_token(c, 1);
c = (char)ios_getc(F); c = (char)ios_getc(F);
if (c == '#') if (c == '#')
@ -271,17 +290,15 @@ static u_int32_t peek(void)
if (*end != '\0' || errno) if (*end != '\0' || errno)
lerror(ParseError, "read: invalid label"); lerror(ParseError, "read: invalid label");
tokval = fixnum(x); tokval = fixnum(x);
} } else if (c == '!') {
else if (c == '!') {
// #! single line comment for shbang script support // #! single line comment for shbang script support
do { do {
ch = ios_getc(F); ch = ios_getc(F);
} while (ch != IOS_EOF && (char)ch != '\n'); } while (ch != IOS_EOF && (char)ch != '\n');
return peek(); return peek();
} } else if (c == '|') {
else if (c == '|') {
// multiline comment // multiline comment
int commentlevel=1; int commentlevel = 1;
while (1) { while (1) {
ch = ios_getc(F); ch = ios_getc(F);
hashpipe_gotc: hashpipe_gotc:
@ -297,8 +314,7 @@ static u_int32_t peek(void)
continue; continue;
} }
goto hashpipe_gotc; goto hashpipe_gotc;
} } else if ((char)ch == '#') {
else if ((char)ch == '#') {
ch = ios_getc(F); ch = ios_getc(F);
if ((char)ch == '|') if ((char)ch == '|')
commentlevel++; commentlevel++;
@ -308,13 +324,11 @@ static u_int32_t peek(void)
} }
// this was whitespace, so keep peeking // this was whitespace, so keep peeking
return peek(); return peek();
} } else if (c == ';') {
else if (c == ';') {
// datum comment // datum comment
(void)do_read_sexpr(UNBOUND); // skip (void)do_read_sexpr(UNBOUND); // skip
return peek(); return peek();
} } else if (c == ':') {
else if (c == ':') {
// gensym // gensym
ch = ios_getc(F); ch = ios_getc(F);
if ((char)ch == 'g') if ((char)ch == 'g')
@ -326,29 +340,24 @@ static u_int32_t peek(void)
lerror(ParseError, "read: invalid gensym label"); lerror(ParseError, "read: invalid gensym label");
toktype = TOK_GENSYM; toktype = TOK_GENSYM;
tokval = fixnum(x); tokval = fixnum(x);
} } else if (symchar(c)) {
else if (symchar(c)) {
read_token(ch, 0); read_token(ch, 0);
if (((c == 'b' && (base= 2)) || if (((c == 'b' && (base = 2)) || (c == 'o' && (base = 8)) ||
(c == 'o' && (base= 8)) || (c == 'd' && (base = 10)) || (c == 'x' && (base = 16))) &&
(c == 'd' && (base=10)) || (isdigit_base(buf[1], base) || buf[1] == '-')) {
(c == 'x' && (base=16))) &&
(isdigit_base(buf[1],base) ||
buf[1]=='-')) {
if (!read_numtok(&buf[1], &tokval, base)) if (!read_numtok(&buf[1], &tokval, base))
lerrorf(ParseError, "read: invalid base %d constant", base); lerrorf(ParseError, "read: invalid base %d constant",
return (toktype=TOK_NUM); base);
return (toktype = TOK_NUM);
} }
toktype = TOK_SHARPSYM; toktype = TOK_SHARPSYM;
tokval = symbol(buf); tokval = symbol(buf);
} } else {
else {
lerror(ParseError, "read: unknown read macro"); lerror(ParseError, "read: unknown read macro");
} }
} } else if (c == ',') {
else if (c == ',') {
toktype = TOK_COMMA; toktype = TOK_COMMA;
ch = ios_getc(F); ch = ios_getc(F);
if (ch == IOS_EOF) if (ch == IOS_EOF)
@ -359,15 +368,13 @@ static u_int32_t peek(void)
toktype = TOK_COMMADOT; toktype = TOK_COMMADOT;
else else
ios_ungetc((char)ch, F); ios_ungetc((char)ch, F);
} } else {
else {
if (!read_token(c, 0)) { if (!read_token(c, 0)) {
if (buf[0]=='.' && buf[1]=='\0') { if (buf[0] == '.' && buf[1] == '\0') {
return (toktype=TOK_DOT); return (toktype = TOK_DOT);
} } else {
else {
if (read_numtok(buf, &tokval, 0)) if (read_numtok(buf, &tokval, 0))
return (toktype=TOK_NUM); return (toktype = TOK_NUM);
} }
} }
toktype = TOK_SYM; toktype = TOK_SYM;
@ -383,15 +390,15 @@ static value_t vector_grow(value_t v)
size_t i, s = vector_size(v); size_t i, s = vector_size(v);
size_t d = vector_grow_amt(s); size_t d = vector_grow_amt(s);
PUSH(v); PUSH(v);
assert(s+d > s); assert(s + d > s);
value_t newv = alloc_vector(s+d, 1); value_t newv = alloc_vector(s + d, 1);
v = Stack[SP-1]; v = Stack[SP - 1];
for(i=0; i < s; i++) for (i = 0; i < s; i++)
vector_elt(newv, i) = vector_elt(v, i); vector_elt(newv, i) = vector_elt(v, i);
// use gc to rewrite references from the old vector to the new // use gc to rewrite references from the old vector to the new
Stack[SP-1] = newv; Stack[SP - 1] = newv;
if (s > 0) { if (s > 0) {
((size_t*)ptr(v))[0] |= 0x1; ((size_t *)ptr(v))[0] |= 0x1;
vector_elt(v, 0) = newv; vector_elt(v, 0) = newv;
gc(0); gc(0);
} }
@ -400,23 +407,23 @@ static value_t vector_grow(value_t v)
static value_t read_vector(value_t label, u_int32_t closer) static value_t read_vector(value_t label, u_int32_t closer)
{ {
value_t v=the_empty_vector, elt; value_t v = the_empty_vector, elt;
u_int32_t i=0; u_int32_t i = 0;
PUSH(v); PUSH(v);
if (label != UNBOUND) if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v); ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
while (peek() != closer) { while (peek() != closer) {
if (ios_eof(F)) if (ios_eof(F))
lerror(ParseError, "read: unexpected end of input"); lerror(ParseError, "read: unexpected end of input");
if (i >= vector_size(v)) { if (i >= vector_size(v)) {
v = Stack[SP-1] = vector_grow(v); v = Stack[SP - 1] = vector_grow(v);
if (label != UNBOUND) if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v); ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
} }
elt = do_read_sexpr(UNBOUND); elt = do_read_sexpr(UNBOUND);
v = Stack[SP-1]; v = Stack[SP - 1];
assert(i < vector_size(v)); assert(i < vector_size(v));
vector_elt(v,i) = elt; vector_elt(v, i) = elt;
i++; i++;
} }
take(); take();
@ -429,14 +436,14 @@ static value_t read_string(void)
{ {
char *buf, *temp; char *buf, *temp;
char eseq[10]; char eseq[10];
size_t i=0, j, sz = 64, ndig; size_t i = 0, j, sz = 64, ndig;
int c; int c;
value_t s; value_t s;
u_int32_t wc=0; u_int32_t wc = 0;
buf = malloc(sz); buf = malloc(sz);
while (1) { while (1) {
if (i >= sz-4) { // -4: leaves room for longest utf8 sequence if (i >= sz - 4) { // -4: leaves room for longest utf8 sequence
sz *= 2; sz *= 2;
temp = realloc(buf, sz); temp = realloc(buf, sz);
if (temp == NULL) { if (temp == NULL) {
@ -458,29 +465,30 @@ static value_t read_string(void)
free(buf); free(buf);
lerror(ParseError, "read: end of input in escape sequence"); lerror(ParseError, "read: end of input in escape sequence");
} }
j=0; j = 0;
if (octal_digit(c)) { if (octal_digit(c)) {
do { do {
eseq[j++] = c; eseq[j++] = c;
c = ios_getc(F); c = ios_getc(F);
} while (octal_digit(c) && j<3 && (c!=IOS_EOF)); } while (octal_digit(c) && j < 3 && (c != IOS_EOF));
if (c!=IOS_EOF) ios_ungetc(c, F); if (c != IOS_EOF)
ios_ungetc(c, F);
eseq[j] = '\0'; eseq[j] = '\0';
wc = strtol(eseq, NULL, 8); wc = strtol(eseq, NULL, 8);
// \DDD and \xXX read bytes, not characters // \DDD and \xXX read bytes, not characters
buf[i++] = ((char)wc); buf[i++] = ((char)wc);
} } else if ((c == 'x' && (ndig = 2)) || (c == 'u' && (ndig = 4)) ||
else if ((c=='x' && (ndig=2)) || (c == 'U' && (ndig = 8))) {
(c=='u' && (ndig=4)) ||
(c=='U' && (ndig=8))) {
c = ios_getc(F); c = ios_getc(F);
while (hex_digit(c) && j<ndig && (c!=IOS_EOF)) { while (hex_digit(c) && j < ndig && (c != IOS_EOF)) {
eseq[j++] = c; eseq[j++] = c;
c = ios_getc(F); c = ios_getc(F);
} }
if (c!=IOS_EOF) ios_ungetc(c, F); if (c != IOS_EOF)
ios_ungetc(c, F);
eseq[j] = '\0'; eseq[j] = '\0';
if (j) wc = strtol(eseq, NULL, 16); if (j)
wc = strtol(eseq, NULL, 16);
if (!j || wc > 0x10ffff) { if (!j || wc > 0x10ffff) {
free(buf); free(buf);
lerror(ParseError, "read: invalid escape sequence"); lerror(ParseError, "read: invalid escape sequence");
@ -489,12 +497,10 @@ static value_t read_string(void)
buf[i++] = ((char)wc); buf[i++] = ((char)wc);
else else
i += u8_wc_toutf8(&buf[i], wc); i += u8_wc_toutf8(&buf[i], wc);
} } else {
else {
buf[i++] = read_escape_control_char((char)c); buf[i++] = read_escape_control_char((char)c);
} }
} } else {
else {
buf[i++] = c; buf[i++] = c;
} }
} }
@ -513,23 +519,23 @@ static void read_list(value_t *pval, value_t label)
u_int32_t t; u_int32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP - 1]; // to keep track of current cons cell
t = peek(); t = peek();
while (t != TOK_CLOSE) { while (t != TOK_CLOSE) {
if (ios_eof(F)) if (ios_eof(F))
lerror(ParseError, "read: unexpected end of input"); lerror(ParseError, "read: unexpected end of input");
c = mk_cons(); car_(c) = cdr_(c) = NIL; c = mk_cons();
car_(c) = cdr_(c) = NIL;
if (iscons(*pc)) { if (iscons(*pc)) {
cdr_(*pc) = c; cdr_(*pc) = c;
} } else {
else {
*pval = c; *pval = c;
if (label != UNBOUND) if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)c); ptrhash_put(&readstate->backrefs, (void *)label, (void *)c);
} }
*pc = c; *pc = c;
c = do_read_sexpr(UNBOUND); // must be on separate lines due to c = do_read_sexpr(UNBOUND); // must be on separate lines due to
car_(*pc) = c; // undefined evaluation order car_(*pc) = c; // undefined evaluation order
t = peek(); t = peek();
if (t == TOK_DOT) { if (t == TOK_DOT) {
@ -570,32 +576,36 @@ static value_t do_read_sexpr(value_t label)
case TOK_NUM: case TOK_NUM:
return tokval; return tokval;
case TOK_COMMA: case TOK_COMMA:
head = &COMMA; goto listwith; head = &COMMA;
goto listwith;
case TOK_COMMAAT: case TOK_COMMAAT:
head = &COMMAAT; goto listwith; head = &COMMAAT;
goto listwith;
case TOK_COMMADOT: case TOK_COMMADOT:
head = &COMMADOT; goto listwith; head = &COMMADOT;
goto listwith;
case TOK_BQ: case TOK_BQ:
head = &BACKQUOTE; goto listwith; head = &BACKQUOTE;
goto listwith;
case TOK_QUOTE: case TOK_QUOTE:
head = &QUOTE; head = &QUOTE;
listwith: listwith:
v = cons_reserve(2); v = cons_reserve(2);
car_(v) = *head; car_(v) = *head;
cdr_(v) = tagptr(((cons_t*)ptr(v))+1, TAG_CONS); cdr_(v) = tagptr(((cons_t *)ptr(v)) + 1, TAG_CONS);
car_(cdr_(v)) = cdr_(cdr_(v)) = NIL; car_(cdr_(v)) = cdr_(cdr_(v)) = NIL;
PUSH(v); PUSH(v);
if (label != UNBOUND) if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v); ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
v = do_read_sexpr(UNBOUND); v = do_read_sexpr(UNBOUND);
car_(cdr_(Stack[SP-1])) = v; car_(cdr_(Stack[SP - 1])) = v;
return POP(); return POP();
case TOK_SHARPQUOTE: case TOK_SHARPQUOTE:
// femtoLisp doesn't need symbol-function, so #' does nothing // femtoLisp doesn't need symbol-function, so #' does nothing
return do_read_sexpr(label); return do_read_sexpr(label);
case TOK_OPEN: case TOK_OPEN:
PUSH(NIL); PUSH(NIL);
read_list(&Stack[SP-1], label); read_list(&Stack[SP - 1], label);
return POP(); return POP();
case TOK_SHARPSYM: case TOK_SHARPSYM:
sym = tokval; sym = tokval;
@ -611,12 +621,11 @@ static value_t do_read_sexpr(value_t label)
symbol_name(tokval)); symbol_name(tokval));
} }
PUSH(NIL); PUSH(NIL);
read_list(&Stack[SP-1], UNBOUND); read_list(&Stack[SP - 1], UNBOUND);
if (sym == vu8sym) { if (sym == vu8sym) {
sym = arraysym; sym = arraysym;
Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]); Stack[SP - 1] = fl_cons(uint8sym, Stack[SP - 1]);
} } else if (sym == fnsym) {
else if (sym == fnsym) {
sym = FUNCTION; sym = FUNCTION;
} }
v = symbol_value(sym); v = symbol_value(sym);
@ -629,8 +638,8 @@ static value_t do_read_sexpr(value_t label)
return read_vector(label, TOK_CLOSE); return read_vector(label, TOK_CLOSE);
case TOK_SHARPDOT: case TOK_SHARPDOT:
// eval-when-read // eval-when-read
// evaluated expressions can refer to existing backreferences, but they // evaluated expressions can refer to existing backreferences, but
// cannot see pending labels. in other words: // they cannot see pending labels. in other words:
// (... #2=#.#0# ... ) OK // (... #2=#.#0# ... ) OK
// (... #2=#.(#2#) ... ) DO NOT WANT // (... #2=#.(#2#) ... ) DO NOT WANT
sym = do_read_sexpr(UNBOUND); sym = do_read_sexpr(UNBOUND);
@ -643,20 +652,20 @@ static value_t do_read_sexpr(value_t label)
return fl_toplevel_eval(sym); return fl_toplevel_eval(sym);
case TOK_LABEL: case TOK_LABEL:
// create backreference label // create backreference label
if (ptrhash_has(&readstate->backrefs, (void*)tokval)) if (ptrhash_has(&readstate->backrefs, (void *)tokval))
lerrorf(ParseError, "read: label %ld redefined", numval(tokval)); lerrorf(ParseError, "read: label %ld redefined", numval(tokval));
oldtokval = tokval; oldtokval = tokval;
v = do_read_sexpr(tokval); v = do_read_sexpr(tokval);
ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v); ptrhash_put(&readstate->backrefs, (void *)oldtokval, (void *)v);
return v; return v;
case TOK_BACKREF: case TOK_BACKREF:
// look up backreference // look up backreference
v = (value_t)ptrhash_get(&readstate->backrefs, (void*)tokval); v = (value_t)ptrhash_get(&readstate->backrefs, (void *)tokval);
if (v == (value_t)HT_NOTFOUND) if (v == (value_t)HT_NOTFOUND)
lerrorf(ParseError, "read: undefined label %ld", numval(tokval)); lerrorf(ParseError, "read: undefined label %ld", numval(tokval));
return v; return v;
case TOK_GENSYM: case TOK_GENSYM:
pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval); pv = (value_t *)ptrhash_bp(&readstate->gensyms, (void *)tokval);
if (*pv == (value_t)HT_NOTFOUND) if (*pv == (value_t)HT_NOTFOUND)
*pv = fl_gensym(NULL, 0); *pv = fl_gensym(NULL, 0);
return *pv; return *pv;

143
string.c
View File

@ -29,7 +29,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((cvalue_t *)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");
@ -44,16 +44,16 @@ value_t fl_string_count(value_t *args, u_int32_t nargs)
} }
} }
char *str = cvalue_data(args[0]); char *str = cvalue_data(args[0]);
return size_wrap(u8_charnum(str+start, stop-start)); return size_wrap(u8_charnum(str + start, stop - start));
} }
value_t fl_string_width(value_t *args, u_int32_t nargs) value_t fl_string_width(value_t *args, u_int32_t nargs)
{ {
argcount("string.width", nargs, 1); argcount("string.width", nargs, 1);
if (iscprim(args[0])) { if (iscprim(args[0])) {
cprim_t *cp = (cprim_t*)ptr(args[0]); cprim_t *cp = (cprim_t *)ptr(args[0]);
if (cp_class(cp) == wchartype) { if (cp_class(cp) == wchartype) {
int w = wcwidth(*(uint32_t*)cp_data(cp)); int w = wcwidth(*(uint32_t *)cp_data(cp));
if (w < 0) if (w < 0)
return FL_F; return FL_F;
return fixnum(w); return fixnum(w);
@ -68,7 +68,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((cvalue_t *)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;
@ -78,14 +78,14 @@ 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]); cvalue_t *cv = (cvalue_t *)ptr(args[0]);
fltype_t *t = cv_class(cv); fltype_t *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((cvalue_t *)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;
} }
@ -95,26 +95,27 @@ value_t fl_string_encode(value_t *args, u_int32_t nargs)
value_t fl_string_decode(value_t *args, u_int32_t nargs) value_t fl_string_decode(value_t *args, u_int32_t nargs)
{ {
int term=0; int term = 0;
if (nargs == 2) { if (nargs == 2) {
term = (args[1] != FL_F); term = (args[1] != FL_F);
} } else {
else {
argcount("string.decode", nargs, 1); argcount("string.decode", nargs, 1);
} }
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]); cvalue_t *cv = (cvalue_t *)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);
size_t newsz = nc*sizeof(uint32_t); size_t newsz = nc * sizeof(uint32_t);
if (term) newsz += sizeof(uint32_t); if (term)
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((cvalue_t *)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) pwc[nc] = 0; if (term)
pwc[nc] = 0;
return wcstr; return wcstr;
} }
@ -127,15 +128,13 @@ value_t fl_string(value_t *args, u_int32_t nargs)
return args[0]; return args[0];
value_t arg, buf = fl_buffer(NULL, 0); value_t arg, buf = fl_buffer(NULL, 0);
fl_gc_handle(&buf); fl_gc_handle(&buf);
ios_t *s = value2c(ios_t*,buf); ios_t *s = value2c(ios_t *, buf);
uint32_t i; uint32_t i;
value_t oldpr = symbol_value(printreadablysym); value_t oldpr = symbol_value(printreadablysym);
value_t oldpp = symbol_value(printprettysym); value_t oldpp = symbol_value(printprettysym);
set(printreadablysym, FL_F); set(printreadablysym, FL_F);
set(printprettysym, FL_F); set(printprettysym, FL_F);
FOR_ARGS(i,0,arg,args) { FOR_ARGS(i, 0, arg, args) { fl_print(s, args[i]); }
fl_print(s, args[i]);
}
set(printreadablysym, oldpr); set(printreadablysym, oldpr);
set(printprettysym, oldpp); set(printprettysym, oldpp);
value_t outp = stream_to_string(&buf); value_t outp = stream_to_string(&buf);
@ -148,10 +147,10 @@ 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((cvalue_t *)ptr(args[0]));
size_t dlen = cv_len((cvalue_t*)ptr(args[1])); size_t dlen = cv_len((cvalue_t *)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;
fl_gc_handle(&first); fl_gc_handle(&first);
fl_gc_handle(&last); fl_gc_handle(&last);
@ -167,21 +166,22 @@ 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((cvalue_t *)ptr(args[0]));
delim = cv_data((cvalue_t*)ptr(args[1])); delim = cv_data((cvalue_t *)ptr(args[1]));
if (ssz) memcpy(cv_data((cvalue_t*)ptr(car_(c))), &s[tokstart], ssz); if (ssz)
memcpy(cv_data((cvalue_t *)ptr(car_(c))), &s[tokstart], ssz);
// link new cell // link new cell
if (last == FL_NIL) if (last == FL_NIL)
first = c; // first time, save first cons first = c; // first time, save first cons
else else
((cons_t*)ptr(last))->cdr = c; ((cons_t *)ptr(last))->cdr = c;
// note this tricky condition: if the string ends with a // note this tricky condition: if the string ends with a
// delimiter, we need to go around one more time to add an // delimiter, we need to go around one more time to add an
// empty string. this happens when (i==len && tokend<i) // empty string. this happens when (i==len && tokend<i)
} while (i < len || (i==len && (tokend!=i))); } while (i < len || (i == len && (tokend != i)));
fl_free_gc_handles(2); fl_free_gc_handles(2);
return first; return first;
} }
@ -191,7 +191,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((cvalue_t *)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)
@ -200,14 +200,13 @@ value_t fl_string_sub(value_t *args, u_int32_t nargs)
i2 = toulong(args[2], "string.sub"); i2 = toulong(args[2], "string.sub");
if (i2 > len) if (i2 > len)
bounds_error("string.sub", args[0], args[2]); bounds_error("string.sub", args[0], args[2]);
} } else {
else {
i2 = len; i2 = len;
} }
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((cvalue_t *)ptr(ns)), &s[i1], i2 - i1);
return ns; return ns;
} }
@ -215,12 +214,12 @@ 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((cvalue_t *)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]);
size_t sl = u8_seqlen(&s[i]); size_t sl = u8_seqlen(&s[i]);
if (sl > len || i > len-sl) if (sl > len || i > len - sl)
bounds_error("string.char", args[0], args[1]); bounds_error("string.char", args[0], args[1]);
return mk_wchar(u8_nextchar(s, &i)); return mk_wchar(u8_nextchar(s, &i));
} }
@ -228,32 +227,32 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
value_t fl_char_upcase(value_t *args, u_int32_t nargs) value_t fl_char_upcase(value_t *args, u_int32_t nargs)
{ {
argcount("char.upcase", nargs, 1); argcount("char.upcase", nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]); cprim_t *cp = (cprim_t *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype) if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.upcase", "wchar", args[0]); type_error("char.upcase", "wchar", args[0]);
return mk_wchar(towupper(*(int32_t*)cp_data(cp))); return mk_wchar(towupper(*(int32_t *)cp_data(cp)));
} }
value_t fl_char_downcase(value_t *args, u_int32_t nargs) value_t fl_char_downcase(value_t *args, u_int32_t nargs)
{ {
argcount("char.downcase", nargs, 1); argcount("char.downcase", nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]); cprim_t *cp = (cprim_t *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype) if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.downcase", "wchar", args[0]); type_error("char.downcase", "wchar", args[0]);
return mk_wchar(towlower(*(int32_t*)cp_data(cp))); return mk_wchar(towlower(*(int32_t *)cp_data(cp)));
} }
value_t fl_char_alpha(value_t *args, u_int32_t nargs) value_t fl_char_alpha(value_t *args, u_int32_t nargs)
{ {
argcount("char-alphabetic?", nargs, 1); argcount("char-alphabetic?", nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]); cprim_t *cp = (cprim_t *)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype) if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char-alphabetic?", "wchar", args[0]); type_error("char-alphabetic?", "wchar", args[0]);
return iswalpha(*(int32_t*)cp_data(cp)) ? FL_T : FL_F; return iswalpha(*(int32_t *)cp_data(cp)) ? FL_T : FL_F;
} }
static value_t mem_find_byte(char *s, char c, size_t start, size_t len) static value_t mem_find_byte(char *s, char c, size_t start, size_t len)
{ {
char *p = memchr(s+start, c, len-start); char *p = memchr(s + start, c, len - start);
if (p == NULL) if (p == NULL)
return FL_F; return FL_F;
return size_wrap((size_t)(p - s)); return size_wrap((size_t)(p - s));
@ -268,41 +267,39 @@ 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((cvalue_t *)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; size_t needlesz; char *needle;
size_t needlesz;
value_t v = args[1]; value_t v = args[1];
cprim_t *cp = (cprim_t*)ptr(v); cprim_t *cp = (cprim_t *)ptr(v);
if (iscprim(v) && cp_class(cp) == wchartype) { if (iscprim(v) && cp_class(cp) == wchartype) {
uint32_t c = *(uint32_t*)cp_data(cp); uint32_t c = *(uint32_t *)cp_data(cp);
if (c <= 0x7f) if (c <= 0x7f)
return mem_find_byte(s, (char)c, start, len); return mem_find_byte(s, (char)c, start, len);
needlesz = u8_toutf8(cbuf, sizeof(cbuf), &c, 1); needlesz = u8_toutf8(cbuf, sizeof(cbuf), &c, 1);
needle = cbuf; needle = cbuf;
} } 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)) {
} cvalue_t *cv = (cvalue_t *)ptr(v);
else if (fl_isstring(v)) {
cvalue_t *cv = (cvalue_t*)ptr(v);
needlesz = cv_len(cv); needlesz = cv_len(cv);
needle = (char*)cv_data(cv); needle = (char *)cv_data(cv);
} } else {
else {
type_error("string.find", "string", args[1]); type_error("string.find", "string", args[1]);
} }
if (needlesz > len-start) if (needlesz > len - start)
return FL_F; return FL_F;
else if (needlesz == 1) else if (needlesz == 1)
return mem_find_byte(s, needle[0], start, len); return mem_find_byte(s, needle[0], start, len);
else if (needlesz == 0) else if (needlesz == 0)
return size_wrap(start); return size_wrap(start);
size_t i; size_t i;
for(i=start; i < len-needlesz+1; i++) { for (i = start; i < len - needlesz + 1; i++) {
if (s[i] == needle[0]) { if (s[i] == needle[0]) {
if (!memcmp(&s[i+1], needle+1, needlesz-1)) if (!memcmp(&s[i + 1], needle + 1, needlesz - 1))
return size_wrap(i); return size_wrap(i);
} }
} }
@ -314,7 +311,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((cvalue_t *)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)
@ -332,7 +329,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((cvalue_t *)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)
@ -363,11 +360,14 @@ value_t fl_numbertostring(value_t *args, u_int32_t nargs)
value_t n = args[0]; value_t n = args[0];
int neg = 0; int neg = 0;
uint64_t num; uint64_t num;
if (isfixnum(n)) num = numval(n); if (isfixnum(n))
else if (!iscprim(n)) type_error("number->string", "integer", n); num = numval(n);
else num = conv_to_uint64(cp_data((cprim_t*)ptr(n)), else if (!iscprim(n))
cp_numtype((cprim_t*)ptr(n))); type_error("number->string", "integer", n);
if (numval(fl_compare(args[0],fixnum(0))) < 0) { else
num = conv_to_uint64(cp_data((cprim_t *)ptr(n)),
cp_numtype((cprim_t *)ptr(n)));
if (numval(fl_compare(args[0], fixnum(0))) < 0) {
num = -num; num = -num;
neg = 1; neg = 1;
} }
@ -399,7 +399,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((cvalue_t *)ptr(args[0]));
return u8_isvalid(s, len) ? FL_T : FL_F; return u8_isvalid(s, len) ? FL_T : FL_F;
} }
@ -429,7 +429,4 @@ static builtinspec_t stringfunc_info[] = {
{ NULL, NULL } { NULL, NULL }
}; };
void stringfuncs_init(void) void stringfuncs_init(void) { assign_global_builtins(stringfunc_info); }
{
assign_global_builtins(stringfunc_info);
}

101
table.c
View File

@ -14,16 +14,17 @@ static fltype_t *tabletype;
void print_htable(value_t v, ios_t *f) void print_htable(value_t v, ios_t *f)
{ {
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v)); htable_t *h = (htable_t *)cv_data((cvalue_t *)ptr(v));
size_t i; size_t i;
int first=1; int first = 1;
fl_print_str("#table(", f); fl_print_str("#table(", f);
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) {
if (!first) fl_print_str(" ", f); if (!first)
fl_print_str(" ", f);
fl_print_child(f, (value_t)h->table[i]); fl_print_child(f, (value_t)h->table[i]);
fl_print_chr(' ', f); fl_print_chr(' ', f);
fl_print_child(f, (value_t)h->table[i+1]); fl_print_child(f, (value_t)h->table[i + 1]);
first = 0; first = 0;
} }
} }
@ -32,32 +33,32 @@ void print_htable(value_t v, ios_t *f)
void print_traverse_htable(value_t self) void print_traverse_htable(value_t self)
{ {
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self)); htable_t *h = (htable_t *)cv_data((cvalue_t *)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) {
print_traverse((value_t)h->table[i]); print_traverse((value_t)h->table[i]);
print_traverse((value_t)h->table[i+1]); print_traverse((value_t)h->table[i + 1]);
} }
} }
} }
void free_htable(value_t self) void free_htable(value_t self)
{ {
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self)); htable_t *h = (htable_t *)cv_data((cvalue_t *)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)
{ {
htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv)); htable_t *oldh = (htable_t *)cv_data((cvalue_t *)ptr(oldv));
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv)); htable_t *h = (htable_t *)cv_data((cvalue_t *)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;
for(i=0; i < h->size; i++) { for (i = 0; i < h->size; i++) {
if (h->table[i] != HT_NOTFOUND) if (h->table[i] != HT_NOTFOUND)
h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]); h->table[i] = (void *)relocate_lispvalue((value_t)h->table[i]);
} }
} }
@ -66,7 +67,7 @@ cvtable_t 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((cvalue_t *)ptr(v)) == tabletype;
} }
value_t fl_tablep(value_t *args, uint32_t nargs) value_t fl_tablep(value_t *args, uint32_t nargs)
@ -79,7 +80,7 @@ static htable_t *totable(value_t v, char *fname)
{ {
if (!ishashtable(v)) if (!ishashtable(v))
type_error(fname, "table", v); type_error(fname, "table", v);
return (htable_t*)cv_data((cvalue_t*)ptr(v)); return (htable_t *)cv_data((cvalue_t *)ptr(v));
} }
value_t fl_table(value_t *args, uint32_t nargs) value_t fl_table(value_t *args, uint32_t nargs)
@ -93,17 +94,17 @@ value_t fl_table(value_t *args, uint32_t nargs)
tabletype->vtable->finalize = NULL; tabletype->vtable->finalize = NULL;
nt = cvalue(tabletype, sizeof(htable_t)); nt = cvalue(tabletype, sizeof(htable_t));
tabletype->vtable->finalize = free_htable; tabletype->vtable->finalize = free_htable;
} else {
nt = cvalue(tabletype, 2 * sizeof(void *));
} }
else { htable_t *h = (htable_t *)cv_data((cvalue_t *)ptr(nt));
nt = cvalue(tabletype, 2*sizeof(void*)); htable_new(h, cnt / 2);
}
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
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;
FOR_ARGS(i,0,arg,args) { FOR_ARGS(i, 0, arg, args)
if (i&1) {
equalhash_put(h, (void*)k, (void*)arg); if (i & 1)
equalhash_put(h, (void *)k, (void *)arg);
else else
k = arg; k = arg;
} }
@ -116,12 +117,12 @@ value_t fl_table_put(value_t *args, uint32_t nargs)
argcount("put!", nargs, 3); argcount("put!", nargs, 3);
htable_t *h = totable(args[0], "put!"); htable_t *h = totable(args[0], "put!");
void **table0 = h->table; void **table0 = h->table;
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]); cvalue_t *cv = (cvalue_t *)ptr(args[0]);
add_finalizer(cv); add_finalizer(cv);
cv->len = 2*sizeof(void*); cv->len = 2 * sizeof(void *);
} }
return args[0]; return args[0];
} }
@ -137,7 +138,7 @@ value_t fl_table_get(value_t *args, uint32_t nargs)
if (nargs != 3) if (nargs != 3)
argcount("get", nargs, 2); argcount("get", nargs, 2);
htable_t *h = totable(args[0], "get"); htable_t *h = totable(args[0], "get");
value_t v = (value_t)equalhash_get(h, (void*)args[1]); value_t v = (value_t)equalhash_get(h, (void *)args[1]);
if (v == (value_t)HT_NOTFOUND) { if (v == (value_t)HT_NOTFOUND) {
if (nargs == 3) if (nargs == 3)
return args[2]; return args[2];
@ -151,7 +152,7 @@ value_t fl_table_has(value_t *args, uint32_t nargs)
{ {
argcount("has", nargs, 2); argcount("has", nargs, 2);
htable_t *h = totable(args[0], "has"); htable_t *h = totable(args[0], "has");
return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F; return equalhash_has(h, (void *)args[1]) ? FL_T : FL_F;
} }
// (del! table key) // (del! table key)
@ -159,7 +160,7 @@ value_t fl_table_del(value_t *args, uint32_t nargs)
{ {
argcount("del!", nargs, 2); argcount("del!", nargs, 2);
htable_t *h = totable(args[0], "del!"); htable_t *h = totable(args[0], "del!");
if (!equalhash_remove(h, (void*)args[1])) if (!equalhash_remove(h, (void *)args[1]))
key_error("del!", args[1]); key_error("del!", args[1]);
return args[0]; return args[0];
} }
@ -167,21 +168,19 @@ value_t fl_table_del(value_t *args, uint32_t nargs)
value_t fl_table_foldl(value_t *args, uint32_t nargs) value_t fl_table_foldl(value_t *args, uint32_t nargs)
{ {
argcount("table.foldl", nargs, 3); argcount("table.foldl", nargs, 3);
value_t f=args[0], zero=args[1], t=args[2]; value_t f = args[0], zero = args[1], t = args[2];
htable_t *h = totable(t, "table.foldl"); htable_t *h = totable(t, "table.foldl");
size_t i, n = h->size; size_t i, n = h->size;
void **table = h->table; void **table = h->table;
fl_gc_handle(&f); fl_gc_handle(&f);
fl_gc_handle(&zero); fl_gc_handle(&zero);
fl_gc_handle(&t); fl_gc_handle(&t);
for(i=0; i < n; i+=2) { for (i = 0; i < n; i += 2) {
if (table[i+1] != HT_NOTFOUND) { if (table[i + 1] != HT_NOTFOUND) {
zero = fl_applyn(3, f, zero =
(value_t)table[i], fl_applyn(3, f, (value_t)table[i], (value_t)table[i + 1], zero);
(value_t)table[i+1],
zero);
// reload pointer // reload pointer
h = (htable_t*)cv_data((cvalue_t*)ptr(t)); h = (htable_t *)cv_data((cvalue_t *)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;
@ -191,21 +190,19 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs)
return zero; return zero;
} }
static builtinspec_t tablefunc_info[] = { static builtinspec_t tablefunc_info[] = { { "table", fl_table },
{ "table", fl_table }, { "table?", fl_tablep },
{ "table?", fl_tablep }, { "put!", fl_table_put },
{ "put!", fl_table_put }, { "get", fl_table_get },
{ "get", fl_table_get }, { "has?", fl_table_has },
{ "has?", fl_table_has }, { "del!", fl_table_del },
{ "del!", fl_table_del }, { "table.foldl", fl_table_foldl },
{ "table.foldl", fl_table_foldl }, { NULL, NULL } };
{ NULL, NULL }
};
void table_init(void) void table_init(void)
{ {
tablesym = symbol("table"); tablesym = symbol("table");
tabletype = define_opaque_type(tablesym, sizeof(htable_t), tabletype =
&table_vtable, NULL); define_opaque_type(tablesym, sizeof(htable_t), &table_vtable, NULL);
assign_global_builtins(tablefunc_info); assign_global_builtins(tablefunc_info);
} }

62
tiny/flutils.c
View File

@ -1,29 +1,27 @@
u_int32_t *bitvector_resize(u_int32_t *b, size_t n) u_int32_t *bitvector_resize(u_int32_t *b, size_t n)
{ {
u_int32_t *p; u_int32_t *p;
size_t sz = ((n+31)>>5) * 4; size_t sz = ((n + 31) >> 5) * 4;
p = realloc(b, sz); p = realloc(b, sz);
if (p == NULL) return NULL; if (p == NULL)
return NULL;
memset(p, 0, sz); memset(p, 0, sz);
return p; return p;
} }
u_int32_t *mk_bitvector(size_t n) u_int32_t *mk_bitvector(size_t n) { return bitvector_resize(NULL, n); }
{
return bitvector_resize(NULL, n);
}
void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c) void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c)
{ {
if (c) if (c)
b[n>>5] |= (1<<(n&31)); b[n >> 5] |= (1 << (n & 31));
else else
b[n>>5] &= ~(1<<(n&31)); b[n >> 5] &= ~(1 << (n & 31));
} }
u_int32_t bitvector_get(u_int32_t *b, u_int32_t n) u_int32_t bitvector_get(u_int32_t *b, u_int32_t n)
{ {
return b[n>>5] & (1<<(n&31)); return b[n >> 5] & (1 << (n & 31));
} }
typedef struct { typedef struct {
@ -35,21 +33,19 @@ void ltable_init(ltable_t *t, size_t n)
{ {
t->n = 0; t->n = 0;
t->maxsize = n; t->maxsize = n;
t->items = (unsigned long*)malloc(n * sizeof(unsigned long)); t->items = (unsigned long *)malloc(n * sizeof(unsigned long));
} }
void ltable_clear(ltable_t *t) void ltable_clear(ltable_t *t) { t->n = 0; }
{
t->n = 0;
}
void ltable_insert(ltable_t *t, unsigned long item) void ltable_insert(ltable_t *t, unsigned long item)
{ {
unsigned long *p; unsigned long *p;
if (t->n == t->maxsize) { if (t->n == t->maxsize) {
p = realloc(t->items, (t->maxsize*2)*sizeof(unsigned long)); p = realloc(t->items, (t->maxsize * 2) * sizeof(unsigned long));
if (p == NULL) return; if (p == NULL)
return;
t->items = p; t->items = p;
t->maxsize *= 2; t->maxsize *= 2;
} }
@ -61,7 +57,7 @@ void ltable_insert(ltable_t *t, unsigned long item)
int ltable_lookup(ltable_t *t, unsigned long item) int ltable_lookup(ltable_t *t, unsigned long item)
{ {
int i; int i;
for(i=0; i < (int)t->n; i++) for (i = 0; i < (int)t->n; i++)
if (t->items[i] == item) if (t->items[i] == item)
return i; return i;
return NOTFOUND; return NOTFOUND;
@ -73,20 +69,22 @@ void ltable_adjoin(ltable_t *t, unsigned long item)
ltable_insert(t, item); ltable_insert(t, item);
} }
static const u_int32_t offsetsFromUTF8[6] = { static const u_int32_t offsetsFromUTF8[6] = { 0x00000000UL, 0x00003080UL,
0x00000000UL, 0x00003080UL, 0x000E2080UL, 0x000E2080UL, 0x03C82080UL,
0x03C82080UL, 0xFA082080UL, 0x82082080UL 0xFA082080UL, 0x82082080UL };
};
static const char trailingBytesForUTF8[256] = { static const char trailingBytesForUTF8[256] = {
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5
}; };
int u8_seqlen(const char c) int u8_seqlen(const char c)
@ -98,8 +96,8 @@ int u8_seqlen(const char c)
u_int32_t u8_fgetc(FILE *f) u_int32_t u8_fgetc(FILE *f)
{ {
int amt=0, sz, c; int amt = 0, sz, c;
u_int32_t ch=0; u_int32_t ch = 0;
c = fgetc(f); c = fgetc(f);
if (c == EOF) if (c == EOF)
@ -113,7 +111,7 @@ u_int32_t u8_fgetc(FILE *f)
return UEOF; return UEOF;
ch += (u_int32_t)c; ch += (u_int32_t)c;
} }
ch -= offsetsFromUTF8[sz-1]; ch -= offsetsFromUTF8[sz - 1];
return ch; return ch;
} }

445
tiny/lisp-nontail.c
View File

@ -42,55 +42,86 @@ typedef struct _symbol_t {
char name[1]; char name[1];
} symbol_t; } symbol_t;
#define TAG_NUM 0x0 #define TAG_NUM 0x0
#define TAG_BUILTIN 0x1 #define TAG_BUILTIN 0x1
#define TAG_SYM 0x2 #define TAG_SYM 0x2
#define TAG_CONS 0x3 #define TAG_CONS 0x3
#define UNBOUND ((value_t)TAG_SYM) // an invalid symbol pointer #define UNBOUND ((value_t)TAG_SYM) // an invalid symbol pointer
#define tag(x) ((x)&0x3) #define tag(x) ((x)&0x3)
#define ptr(x) ((void*)((x)&(~(value_t)0x3))) #define ptr(x) ((void *)((x) & (~(value_t)0x3)))
#define tagptr(p,t) (((value_t)(p)) | (t)) #define tagptr(p, t) (((value_t)(p)) | (t))
#define number(x) ((value_t)((x)<<2)) #define number(x) ((value_t)((x) << 2))
#define numval(x) (((number_t)(x))>>2) #define numval(x) (((number_t)(x)) >> 2)
#define intval(x) (((int)(x))>>2) #define intval(x) (((int)(x)) >> 2)
#define builtin(n) tagptr((((int)n)<<2), TAG_BUILTIN) #define builtin(n) tagptr((((int)n) << 2), TAG_BUILTIN)
#define iscons(x) (tag(x) == TAG_CONS) #define iscons(x) (tag(x) == TAG_CONS)
#define issymbol(x) (tag(x) == TAG_SYM) #define issymbol(x) (tag(x) == TAG_SYM)
#define isnumber(x) (tag(x) == TAG_NUM) #define isnumber(x) (tag(x) == TAG_NUM)
#define isbuiltin(x) (tag(x) == TAG_BUILTIN) #define isbuiltin(x) (tag(x) == TAG_BUILTIN)
// functions ending in _ are unsafe, faster versions // functions ending in _ are unsafe, faster versions
#define car_(v) (((cons_t*)ptr(v))->car) #define car_(v) (((cons_t *)ptr(v))->car)
#define cdr_(v) (((cons_t*)ptr(v))->cdr) #define cdr_(v) (((cons_t *)ptr(v))->cdr)
#define car(v) (tocons((v),"car")->car) #define car(v) (tocons((v), "car")->car)
#define cdr(v) (tocons((v),"cdr")->cdr) #define cdr(v) (tocons((v), "cdr")->cdr)
#define set(s, v) (((symbol_t*)ptr(s))->binding = (v)) #define set(s, v) (((symbol_t *)ptr(s))->binding = (v))
#define setc(s, v) (((symbol_t*)ptr(s))->constant = (v)) #define setc(s, v) (((symbol_t *)ptr(s))->constant = (v))
enum { enum {
// special forms // special forms
F_QUOTE=0, F_COND, F_IF, F_AND, F_OR, F_WHILE, F_LAMBDA, F_MACRO, F_LABEL, F_QUOTE = 0,
F_COND,
F_IF,
F_AND,
F_OR,
F_WHILE,
F_LAMBDA,
F_MACRO,
F_LABEL,
F_PROGN, F_PROGN,
// functions // functions
F_EQ, F_ATOM, F_CONS, F_CAR, F_CDR, F_READ, F_EVAL, F_PRINT, F_SET, F_NOT, F_EQ,
F_LOAD, F_SYMBOLP, F_NUMBERP, F_ADD, F_SUB, F_MUL, F_DIV, F_LT, F_PROG1, F_ATOM,
F_APPLY, F_RPLACA, F_RPLACD, F_BOUNDP, N_BUILTINS F_CONS,
F_CAR,
F_CDR,
F_READ,
F_EVAL,
F_PRINT,
F_SET,
F_NOT,
F_LOAD,
F_SYMBOLP,
F_NUMBERP,
F_ADD,
F_SUB,
F_MUL,
F_DIV,
F_LT,
F_PROG1,
F_APPLY,
F_RPLACA,
F_RPLACD,
F_BOUNDP,
N_BUILTINS
}; };
#define isspecial(v) (intval(v) <= (int)F_PROGN) #define isspecial(v) (intval(v) <= (int)F_PROGN)
static char *builtin_names[] = static char *builtin_names[] = {
{ "quote", "cond", "if", "and", "or", "while", "lambda", "macro", "label", "quote", "cond", "if", "and", "or", "while", "lambda",
"progn", "eq", "atom", "cons", "car", "cdr", "read", "eval", "print", "macro", "label", "progn", "eq", "atom", "cons", "car",
"set", "not", "load", "symbolp", "numberp", "+", "-", "*", "/", "<", "cdr", "read", "eval", "print", "set", "not", "load",
"prog1", "apply", "rplaca", "rplacd", "boundp" }; "symbolp", "numberp", "+", "-", "*", "/", "<",
"prog1", "apply", "rplaca", "rplacd", "boundp"
};
static char *stack_bottom; static char *stack_bottom;
#define PROCESS_STACK_SIZE (2*1024*1024) #define PROCESS_STACK_SIZE (2 * 1024 * 1024)
#define N_STACK 49152 #define N_STACK 49152
static value_t Stack[N_STACK]; static value_t Stack[N_STACK];
static u_int32_t SP = 0; static u_int32_t SP = 0;
#define PUSH(v) (Stack[SP++] = (v)) #define PUSH(v) (Stack[SP++] = (v))
#define POP() (Stack[--SP]) #define POP() (Stack[--SP])
#define POPN(n) (SP-=(n)) #define POPN(n) (SP -= (n))
value_t NIL, T, LAMBDA, MACRO, LABEL, QUOTE; value_t NIL, T, LAMBDA, MACRO, LABEL, QUOTE;
@ -99,7 +130,8 @@ void print(FILE *f, value_t v);
value_t eval_sexpr(value_t e, value_t *penv); value_t eval_sexpr(value_t e, value_t *penv);
value_t load_file(char *fname); value_t load_file(char *fname);
// error utilities ------------------------------------------------------------ // error utilities
// ------------------------------------------------------------
jmp_buf toplevel; jmp_buf toplevel;
@ -115,24 +147,27 @@ void lerror(char *format, ...)
void type_error(char *fname, char *expected, value_t got) void type_error(char *fname, char *expected, value_t got)
{ {
fprintf(stderr, "%s: error: expected %s, got ", fname, expected); fprintf(stderr, "%s: error: expected %s, got ", fname, expected);
print(stderr, got); lerror("\n"); print(stderr, got);
lerror("\n");
} }
// safe cast operators -------------------------------------------------------- // safe cast operators
// --------------------------------------------------------
#define SAFECAST_OP(type,ctype,cnvt) \ #define SAFECAST_OP(type, ctype, cnvt) \
ctype to##type(value_t v, char *fname) \ ctype to##type(value_t v, char *fname) \
{ \ { \
if (is##type(v)) \ if (is##type(v)) \
return (ctype)cnvt(v); \ return (ctype)cnvt(v); \
type_error(fname, #type, v); \ type_error(fname, #type, v); \
return (ctype)0; \ return (ctype)0; \
} }
SAFECAST_OP(cons, cons_t*, ptr) SAFECAST_OP(cons, cons_t *, ptr)
SAFECAST_OP(symbol,symbol_t*,ptr) SAFECAST_OP(symbol, symbol_t *, ptr)
SAFECAST_OP(number,number_t, numval) SAFECAST_OP(number, number_t, numval)
// symbol table --------------------------------------------------------------- // symbol table
// ---------------------------------------------------------------
static symbol_t *symtab = NULL; static symbol_t *symtab = NULL;
@ -140,7 +175,7 @@ static symbol_t *mk_symbol(char *str)
{ {
symbol_t *sym; symbol_t *sym;
sym = (symbol_t*)malloc(sizeof(symbol_t) + strlen(str)); sym = (symbol_t *)malloc(sizeof(symbol_t) + strlen(str));
sym->left = sym->right = NULL; sym->left = sym->right = NULL;
sym->constant = sym->binding = UNBOUND; sym->constant = sym->binding = UNBOUND;
strcpy(&sym->name[0], str); strcpy(&sym->name[0], str);
@ -151,7 +186,7 @@ static symbol_t **symtab_lookup(symbol_t **ptree, char *str)
{ {
int x; int x;
while(*ptree != NULL) { while (*ptree != NULL) {
x = strcmp(str, (*ptree)->name); x = strcmp(str, (*ptree)->name);
if (x == 0) if (x == 0)
return ptree; return ptree;
@ -173,35 +208,39 @@ value_t symbol(char *str)
return tagptr(*pnode, TAG_SYM); return tagptr(*pnode, TAG_SYM);
} }
// initialization ------------------------------------------------------------- // initialization
// -------------------------------------------------------------
static unsigned char *fromspace; static unsigned char *fromspace;
static unsigned char *tospace; static unsigned char *tospace;
static unsigned char *curheap; static unsigned char *curheap;
static unsigned char *lim; static unsigned char *lim;
static u_int32_t heapsize = 64*1024;//bytes static u_int32_t heapsize = 64 * 1024; // bytes
void lisp_init(void) void lisp_init(void)
{ {
int i; int i;
fromspace = malloc(heapsize); fromspace = malloc(heapsize);
tospace = malloc(heapsize); tospace = malloc(heapsize);
curheap = fromspace; curheap = fromspace;
lim = curheap+heapsize-sizeof(cons_t); lim = curheap + heapsize - sizeof(cons_t);
NIL = symbol("nil"); setc(NIL, NIL); NIL = symbol("nil");
T = symbol("t"); setc(T, T); setc(NIL, NIL);
T = symbol("t");
setc(T, T);
LAMBDA = symbol("lambda"); LAMBDA = symbol("lambda");
MACRO = symbol("macro"); MACRO = symbol("macro");
LABEL = symbol("label"); LABEL = symbol("label");
QUOTE = symbol("quote"); QUOTE = symbol("quote");
for (i=0; i < (int)N_BUILTINS; i++) for (i = 0; i < (int)N_BUILTINS; i++)
setc(symbol(builtin_names[i]), builtin(i)); setc(symbol(builtin_names[i]), builtin(i));
setc(symbol("princ"), builtin(F_PRINT)); setc(symbol("princ"), builtin(F_PRINT));
} }
// conses --------------------------------------------------------------------- // conses
// ---------------------------------------------------------------------
void gc(void); void gc(void);
@ -211,7 +250,7 @@ static value_t mk_cons(void)
if (curheap > lim) if (curheap > lim)
gc(); gc();
c = (cons_t*)curheap; c = (cons_t *)curheap;
curheap += sizeof(cons_t); curheap += sizeof(cons_t);
return tagptr(c, TAG_CONS); return tagptr(c, TAG_CONS);
} }
@ -219,19 +258,22 @@ static value_t mk_cons(void)
static value_t cons_(value_t *pcar, value_t *pcdr) static value_t cons_(value_t *pcar, value_t *pcdr)
{ {
value_t c = mk_cons(); value_t c = mk_cons();
car_(c) = *pcar; cdr_(c) = *pcdr; car_(c) = *pcar;
cdr_(c) = *pcdr;
return c; return c;
} }
value_t *cons(value_t *pcar, value_t *pcdr) value_t *cons(value_t *pcar, value_t *pcdr)
{ {
value_t c = mk_cons(); value_t c = mk_cons();
car_(c) = *pcar; cdr_(c) = *pcdr; car_(c) = *pcar;
cdr_(c) = *pcdr;
PUSH(c); PUSH(c);
return &Stack[SP-1]; return &Stack[SP - 1];
} }
// collector ------------------------------------------------------------------ // collector
// ------------------------------------------------------------------
static value_t relocate(value_t v) static value_t relocate(value_t v)
{ {
@ -242,8 +284,10 @@ static value_t relocate(value_t v)
if (car_(v) == UNBOUND) if (car_(v) == UNBOUND)
return cdr_(v); return cdr_(v);
nc = mk_cons(); nc = mk_cons();
a = car_(v); d = cdr_(v); a = car_(v);
car_(v) = UNBOUND; cdr_(v) = nc; d = cdr_(v);
car_(v) = UNBOUND;
cdr_(v) = nc;
car_(nc) = relocate(a); car_(nc) = relocate(a);
cdr_(nc) = relocate(d); cdr_(nc) = relocate(d);
return nc; return nc;
@ -265,13 +309,14 @@ void gc(void)
u_int32_t i; u_int32_t i;
curheap = tospace; curheap = tospace;
lim = curheap+heapsize-sizeof(cons_t); lim = curheap + heapsize - sizeof(cons_t);
for (i=0; i < SP; i++) for (i = 0; i < SP; i++)
Stack[i] = relocate(Stack[i]); Stack[i] = relocate(Stack[i]);
trace_globals(symtab); trace_globals(symtab);
#ifdef VERBOSEGC #ifdef VERBOSEGC
printf("gc found %d/%d live conses\n", (curheap-tospace)/8, heapsize/8); printf("gc found %d/%d live conses\n", (curheap - tospace) / 8,
heapsize / 8);
#endif #endif
temp = tospace; temp = tospace;
tospace = fromspace; tospace = fromspace;
@ -280,24 +325,23 @@ void gc(void)
// if we're using > 80% of the space, resize tospace so we have // if we're using > 80% of the space, resize tospace so we have
// more space to fill next time. if we grew tospace last time, // more space to fill next time. if we grew tospace last time,
// grow the other half of the heap this time to catch up. // grow the other half of the heap this time to catch up.
if (grew || ((lim-curheap) < (int)(heapsize/5))) { if (grew || ((lim - curheap) < (int)(heapsize / 5))) {
temp = realloc(tospace, grew ? heapsize : heapsize*2); temp = realloc(tospace, grew ? heapsize : heapsize * 2);
if (temp == NULL) if (temp == NULL)
lerror("out of memory\n"); lerror("out of memory\n");
tospace = temp; tospace = temp;
if (!grew) if (!grew)
heapsize*=2; heapsize *= 2;
grew = !grew; grew = !grew;
} }
if (curheap > lim) // all data was live if (curheap > lim) // all data was live
gc(); gc();
} }
// read ----------------------------------------------------------------------- // read
// -----------------------------------------------------------------------
enum { enum { TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM };
TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM
};
static int symchar(char c) static int symchar(char c)
{ {
@ -332,21 +376,18 @@ static char nextchar(FILE *f)
return c; return c;
} }
static void take(void) static void take(void) { toktype = TOK_NONE; }
{
toktype = TOK_NONE;
}
static void accumchar(char c, int *pi) static void accumchar(char c, int *pi)
{ {
buf[(*pi)++] = c; buf[(*pi)++] = c;
if (*pi >= (int)(sizeof(buf)-1)) if (*pi >= (int)(sizeof(buf) - 1))
lerror("read: error: token too long\n"); lerror("read: error: token too long\n");
} }
static int read_token(FILE *f, char c) static int read_token(FILE *f, char c)
{ {
int i=0, ch, escaped=0; int i = 0, ch, escaped = 0;
ungetc(c, f); ungetc(c, f);
while (1) { while (1) {
@ -356,22 +397,19 @@ static int read_token(FILE *f, char c)
c = (char)ch; c = (char)ch;
if (c == '|') { if (c == '|') {
escaped = !escaped; escaped = !escaped;
} } else if (c == '\\') {
else if (c == '\\') {
ch = fgetc(f); ch = fgetc(f);
if (ch == EOF) if (ch == EOF)
goto terminate; goto terminate;
accumchar((char)ch, &i); accumchar((char)ch, &i);
} } else if (!escaped && !symchar(c)) {
else if (!escaped && !symchar(c)) {
break; break;
} } else {
else {
accumchar(c, &i); accumchar(c, &i);
} }
} }
ungetc(c, f); ungetc(c, f);
terminate: terminate:
buf[i++] = '\0'; buf[i++] = '\0';
return i; return i;
} }
@ -384,36 +422,31 @@ static u_int32_t peek(FILE *f)
if (toktype != TOK_NONE) if (toktype != TOK_NONE)
return toktype; return toktype;
c = nextchar(f); c = nextchar(f);
if (feof(f)) return TOK_NONE; if (feof(f))
return TOK_NONE;
if (c == '(') { if (c == '(') {
toktype = TOK_OPEN; toktype = TOK_OPEN;
} } else if (c == ')') {
else if (c == ')') {
toktype = TOK_CLOSE; toktype = TOK_CLOSE;
} } else if (c == '\'') {
else if (c == '\'') {
toktype = TOK_QUOTE; toktype = TOK_QUOTE;
} } else if (isdigit(c) || c == '-') {
else if (isdigit(c) || c=='-') {
read_token(f, c); read_token(f, c);
if (buf[0] == '-' && !isdigit(buf[1])) { if (buf[0] == '-' && !isdigit(buf[1])) {
toktype = TOK_SYM; toktype = TOK_SYM;
tokval = symbol(buf); tokval = symbol(buf);
} } else {
else {
x = strtol(buf, &end, 10); x = strtol(buf, &end, 10);
if (*end != '\0') if (*end != '\0')
lerror("read: error: invalid integer constant\n"); lerror("read: error: invalid integer constant\n");
toktype = TOK_NUM; toktype = TOK_NUM;
tokval = number(x); tokval = number(x);
} }
} } else {
else {
read_token(f, c); read_token(f, c);
if (!strcmp(buf, ".")) { if (!strcmp(buf, ".")) {
toktype = TOK_DOT; toktype = TOK_DOT;
} } else {
else {
toktype = TOK_SYM; toktype = TOK_SYM;
tokval = symbol(buf); tokval = symbol(buf);
} }
@ -430,12 +463,13 @@ static void read_list(FILE *f, value_t *pval)
u_int32_t t; u_int32_t t;
PUSH(NIL); PUSH(NIL);
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP - 1]; // to keep track of current cons cell
t = peek(f); t = peek(f);
while (t != TOK_CLOSE) { while (t != TOK_CLOSE) {
if (feof(f)) if (feof(f))
lerror("read: error: unexpected end of input\n"); lerror("read: error: unexpected end of input\n");
c = mk_cons(); car_(c) = cdr_(c) = NIL; c = mk_cons();
car_(c) = cdr_(c) = NIL;
if (iscons(*pc)) if (iscons(*pc))
cdr_(*pc) = c; cdr_(*pc) = c;
else else
@ -479,29 +513,35 @@ value_t read_sexpr(FILE *f)
take(); take();
v = read_sexpr(f); v = read_sexpr(f);
PUSH(v); PUSH(v);
v = cons_(&QUOTE, cons(&Stack[SP-1], &NIL)); v = cons_(&QUOTE, cons(&Stack[SP - 1], &NIL));
POPN(2); POPN(2);
return v; return v;
case TOK_OPEN: case TOK_OPEN:
take(); take();
PUSH(NIL); PUSH(NIL);
read_list(f, &Stack[SP-1]); read_list(f, &Stack[SP - 1]);
return POP(); return POP();
} }
return NIL; return NIL;
} }
// print ---------------------------------------------------------------------- // print
// ----------------------------------------------------------------------
void print(FILE *f, value_t v) void print(FILE *f, value_t v)
{ {
value_t cd; value_t cd;
switch (tag(v)) { switch (tag(v)) {
case TAG_NUM: fprintf(f, "%d", numval(v)); break; case TAG_NUM:
case TAG_SYM: fprintf(f, "%s", ((symbol_t*)ptr(v))->name); break; fprintf(f, "%d", numval(v));
case TAG_BUILTIN: fprintf(f, "#<builtin %s>", break;
builtin_names[intval(v)]); break; case TAG_SYM:
fprintf(f, "%s", ((symbol_t *)ptr(v))->name);
break;
case TAG_BUILTIN:
fprintf(f, "#<builtin %s>", builtin_names[intval(v)]);
break;
case TAG_CONS: case TAG_CONS:
fprintf(f, "("); fprintf(f, "(");
while (1) { while (1) {
@ -522,29 +562,32 @@ void print(FILE *f, value_t v)
} }
} }
// eval ----------------------------------------------------------------------- // eval
// -----------------------------------------------------------------------
static inline void argcount(char *fname, int nargs, int c) static inline void argcount(char *fname, int nargs, int c)
{ {
if (nargs != c) if (nargs != c)
lerror("%s: error: too %s arguments\n", fname, nargs<c ? "few":"many"); lerror("%s: error: too %s arguments\n", fname,
nargs < c ? "few" : "many");
} }
#define eval(e, env) ((tag(e)<0x2) ? (e) : eval_sexpr((e),env)) #define eval(e, env) ((tag(e) < 0x2) ? (e) : eval_sexpr((e), env))
value_t eval_sexpr(value_t e, value_t *penv) value_t eval_sexpr(value_t e, value_t *penv)
{ {
value_t f, v, bind, headsym, asym, labl=0, *pv, *argsyms, *body, *lenv; value_t f, v, bind, headsym, asym, labl = 0, *pv, *argsyms, *body, *lenv;
value_t *rest; value_t *rest;
cons_t *c; cons_t *c;
symbol_t *sym; symbol_t *sym;
u_int32_t saveSP; u_int32_t saveSP;
int i, nargs, noeval=0; int i, nargs, noeval = 0;
number_t s, n; number_t s, n;
if (issymbol(e)) { if (issymbol(e)) {
sym = (symbol_t*)ptr(e); sym = (symbol_t *)ptr(e);
if (sym->constant != UNBOUND) return sym->constant; if (sym->constant != UNBOUND)
return sym->constant;
v = *penv; v = *penv;
while (iscons(v)) { while (iscons(v)) {
bind = car_(v); bind = car_(v);
@ -556,7 +599,8 @@ value_t eval_sexpr(value_t e, value_t *penv)
lerror("eval: error: variable %s has no value\n", sym->name); lerror("eval: error: variable %s has no value\n", sym->name);
return v; return v;
} }
if ((unsigned)(char*)&nargs < (unsigned)stack_bottom || SP>=(N_STACK-100)) if ((unsigned)(char *)&nargs < (unsigned)stack_bottom ||
SP >= (N_STACK - 100))
lerror("eval: error: stack overflow\n"); lerror("eval: error: stack overflow\n");
saveSP = SP; saveSP = SP;
PUSH(e); PUSH(e);
@ -589,10 +633,10 @@ value_t eval_sexpr(value_t e, value_t *penv)
// build a closure (lambda args body . env) // build a closure (lambda args body . env)
v = cdr_(v); v = cdr_(v);
PUSH(car(v)); PUSH(car(v));
argsyms = &Stack[SP-1]; argsyms = &Stack[SP - 1];
PUSH(car(cdr_(v))); PUSH(car(cdr_(v)));
body = &Stack[SP-1]; body = &Stack[SP - 1];
v = cons_(intval(f)==F_LAMBDA ? &LAMBDA : &MACRO, v = cons_(intval(f) == F_LAMBDA ? &LAMBDA : &MACRO,
cons(argsyms, cons(body, penv))); cons(argsyms, cons(body, penv)));
} }
break; break;
@ -600,10 +644,10 @@ value_t eval_sexpr(value_t e, value_t *penv)
v = Stack[saveSP]; v = Stack[saveSP];
if (*penv != NIL) { if (*penv != NIL) {
v = cdr_(v); v = cdr_(v);
PUSH(car(v)); // name PUSH(car(v)); // name
pv = &Stack[SP-1]; pv = &Stack[SP - 1];
PUSH(car(cdr_(v))); // function PUSH(car(cdr_(v))); // function
body = &Stack[SP-1]; body = &Stack[SP - 1];
*body = eval(*body, penv); // evaluate lambda *body = eval(*body, penv); // evaluate lambda
v = cons_(&LABEL, cons(pv, cons(body, &NIL))); v = cons_(&LABEL, cons(pv, cons(body, &NIL)));
} }
@ -618,10 +662,11 @@ value_t eval_sexpr(value_t e, value_t *penv)
break; break;
case F_COND: case F_COND:
Stack[saveSP] = cdr_(Stack[saveSP]); Stack[saveSP] = cdr_(Stack[saveSP]);
pv = &Stack[saveSP]; v = NIL; pv = &Stack[saveSP];
v = NIL;
while (iscons(*pv)) { while (iscons(*pv)) {
c = tocons(car_(*pv), "cond"); c = tocons(car_(*pv), "cond");
if ((v=eval(c->car, penv)) != NIL) { if ((v = eval(c->car, penv)) != NIL) {
*pv = cdr_(car_(*pv)); *pv = cdr_(car_(*pv));
// evaluate body forms // evaluate body forms
while (iscons(*pv)) { while (iscons(*pv)) {
@ -635,28 +680,31 @@ value_t eval_sexpr(value_t e, value_t *penv)
break; break;
case F_AND: case F_AND:
Stack[saveSP] = cdr_(Stack[saveSP]); Stack[saveSP] = cdr_(Stack[saveSP]);
pv = &Stack[saveSP]; v = T; pv = &Stack[saveSP];
v = T;
while (iscons(*pv)) { while (iscons(*pv)) {
if ((v=eval(car_(*pv), penv)) == NIL) if ((v = eval(car_(*pv), penv)) == NIL)
break; break;
*pv = cdr_(*pv); *pv = cdr_(*pv);
} }
break; break;
case F_OR: case F_OR:
Stack[saveSP] = cdr_(Stack[saveSP]); Stack[saveSP] = cdr_(Stack[saveSP]);
pv = &Stack[saveSP]; v = NIL; pv = &Stack[saveSP];
v = NIL;
while (iscons(*pv)) { while (iscons(*pv)) {
if ((v=eval(car_(*pv), penv)) != NIL) if ((v = eval(car_(*pv), penv)) != NIL)
break; break;
*pv = cdr_(*pv); *pv = cdr_(*pv);
} }
break; break;
case F_WHILE: case F_WHILE:
PUSH(car(cdr(cdr_(Stack[saveSP])))); PUSH(car(cdr(cdr_(Stack[saveSP]))));
body = &Stack[SP-1]; body = &Stack[SP - 1];
Stack[saveSP] = car_(cdr_(Stack[saveSP])); Stack[saveSP] = car_(cdr_(Stack[saveSP]));
value_t *cond = &Stack[saveSP]; value_t *cond = &Stack[saveSP];
PUSH(NIL); pv = &Stack[SP-1]; PUSH(NIL);
pv = &Stack[SP - 1];
while (eval(*cond, penv) != NIL) while (eval(*cond, penv) != NIL)
*pv = eval(*body, penv); *pv = eval(*body, penv);
v = *pv; v = *pv;
@ -664,7 +712,8 @@ value_t eval_sexpr(value_t e, value_t *penv)
case F_PROGN: case F_PROGN:
// return last arg // return last arg
Stack[saveSP] = cdr_(Stack[saveSP]); Stack[saveSP] = cdr_(Stack[saveSP]);
pv = &Stack[saveSP]; v = NIL; pv = &Stack[saveSP];
v = NIL;
while (iscons(*pv)) { while (iscons(*pv)) {
v = eval(car_(*pv), penv); v = eval(car_(*pv), penv);
*pv = cdr_(*pv); *pv = cdr_(*pv);
@ -674,66 +723,67 @@ value_t eval_sexpr(value_t e, value_t *penv)
// ordinary functions // ordinary functions
case F_SET: case F_SET:
argcount("set", nargs, 2); argcount("set", nargs, 2);
e = Stack[SP-2]; e = Stack[SP - 2];
v = *penv; v = *penv;
while (iscons(v)) { while (iscons(v)) {
bind = car_(v); bind = car_(v);
if (iscons(bind) && car_(bind) == e) { if (iscons(bind) && car_(bind) == e) {
cdr_(bind) = (v=Stack[SP-1]); cdr_(bind) = (v = Stack[SP - 1]);
SP=saveSP; return v; SP = saveSP;
return v;
} }
v = cdr_(v); v = cdr_(v);
} }
tosymbol(e, "set")->binding = (v=Stack[SP-1]); tosymbol(e, "set")->binding = (v = Stack[SP - 1]);
break; break;
case F_BOUNDP: case F_BOUNDP:
argcount("boundp", nargs, 1); argcount("boundp", nargs, 1);
if (tosymbol(Stack[SP-1], "boundp")->binding == UNBOUND) if (tosymbol(Stack[SP - 1], "boundp")->binding == UNBOUND)
v = NIL; v = NIL;
else else
v = T; v = T;
break; break;
case F_EQ: case F_EQ:
argcount("eq", nargs, 2); argcount("eq", nargs, 2);
v = ((Stack[SP-2] == Stack[SP-1]) ? T : NIL); v = ((Stack[SP - 2] == Stack[SP - 1]) ? T : NIL);
break; break;
case F_CONS: case F_CONS:
argcount("cons", nargs, 2); argcount("cons", nargs, 2);
v = mk_cons(); v = mk_cons();
car_(v) = Stack[SP-2]; car_(v) = Stack[SP - 2];
cdr_(v) = Stack[SP-1]; cdr_(v) = Stack[SP - 1];
break; break;
case F_CAR: case F_CAR:
argcount("car", nargs, 1); argcount("car", nargs, 1);
v = car(Stack[SP-1]); v = car(Stack[SP - 1]);
break; break;
case F_CDR: case F_CDR:
argcount("cdr", nargs, 1); argcount("cdr", nargs, 1);
v = cdr(Stack[SP-1]); v = cdr(Stack[SP - 1]);
break; break;
case F_RPLACA: case F_RPLACA:
argcount("rplaca", nargs, 2); argcount("rplaca", nargs, 2);
car(v=Stack[SP-2]) = Stack[SP-1]; car(v = Stack[SP - 2]) = Stack[SP - 1];
break; break;
case F_RPLACD: case F_RPLACD:
argcount("rplacd", nargs, 2); argcount("rplacd", nargs, 2);
cdr(v=Stack[SP-2]) = Stack[SP-1]; cdr(v = Stack[SP - 2]) = Stack[SP - 1];
break; break;
case F_ATOM: case F_ATOM:
argcount("atom", nargs, 1); argcount("atom", nargs, 1);
v = ((!iscons(Stack[SP-1])) ? T : NIL); v = ((!iscons(Stack[SP - 1])) ? T : NIL);
break; break;
case F_SYMBOLP: case F_SYMBOLP:
argcount("symbolp", nargs, 1); argcount("symbolp", nargs, 1);
v = ((issymbol(Stack[SP-1])) ? T : NIL); v = ((issymbol(Stack[SP - 1])) ? T : NIL);
break; break;
case F_NUMBERP: case F_NUMBERP:
argcount("numberp", nargs, 1); argcount("numberp", nargs, 1);
v = ((isnumber(Stack[SP-1])) ? T : NIL); v = ((isnumber(Stack[SP - 1])) ? T : NIL);
break; break;
case F_ADD: case F_ADD:
s = 0; s = 0;
for (i=saveSP+1; i < (int)SP; i++) { for (i = saveSP + 1; i < (int)SP; i++) {
n = tonumber(Stack[i], "+"); n = tonumber(Stack[i], "+");
s += n; s += n;
} }
@ -742,8 +792,8 @@ value_t eval_sexpr(value_t e, value_t *penv)
case F_SUB: case F_SUB:
if (nargs < 1) if (nargs < 1)
lerror("-: error: too few arguments\n"); lerror("-: error: too few arguments\n");
i = saveSP+1; i = saveSP + 1;
s = (nargs==1) ? 0 : tonumber(Stack[i++], "-"); s = (nargs == 1) ? 0 : tonumber(Stack[i++], "-");
for (; i < (int)SP; i++) { for (; i < (int)SP; i++) {
n = tonumber(Stack[i], "-"); n = tonumber(Stack[i], "-");
s -= n; s -= n;
@ -752,7 +802,7 @@ value_t eval_sexpr(value_t e, value_t *penv)
break; break;
case F_MUL: case F_MUL:
s = 1; s = 1;
for (i=saveSP+1; i < (int)SP; i++) { for (i = saveSP + 1; i < (int)SP; i++) {
n = tonumber(Stack[i], "*"); n = tonumber(Stack[i], "*");
s *= n; s *= n;
} }
@ -761,8 +811,8 @@ value_t eval_sexpr(value_t e, value_t *penv)
case F_DIV: case F_DIV:
if (nargs < 1) if (nargs < 1)
lerror("/: error: too few arguments\n"); lerror("/: error: too few arguments\n");
i = saveSP+1; i = saveSP + 1;
s = (nargs==1) ? 1 : tonumber(Stack[i++], "/"); s = (nargs == 1) ? 1 : tonumber(Stack[i++], "/");
for (; i < (int)SP; i++) { for (; i < (int)SP; i++) {
n = tonumber(Stack[i], "/"); n = tonumber(Stack[i], "/");
if (n == 0) if (n == 0)
@ -773,22 +823,22 @@ value_t eval_sexpr(value_t e, value_t *penv)
break; break;
case F_LT: case F_LT:
argcount("<", nargs, 2); argcount("<", nargs, 2);
if (tonumber(Stack[SP-2],"<") < tonumber(Stack[SP-1],"<")) if (tonumber(Stack[SP - 2], "<") < tonumber(Stack[SP - 1], "<"))
v = T; v = T;
else else
v = NIL; v = NIL;
break; break;
case F_NOT: case F_NOT:
argcount("not", nargs, 1); argcount("not", nargs, 1);
v = ((Stack[SP-1] == NIL) ? T : NIL); v = ((Stack[SP - 1] == NIL) ? T : NIL);
break; break;
case F_EVAL: case F_EVAL:
argcount("eval", nargs, 1); argcount("eval", nargs, 1);
v = eval(Stack[SP-1], &NIL); v = eval(Stack[SP - 1], &NIL);
break; break;
case F_PRINT: case F_PRINT:
for (i=saveSP+1; i < (int)SP; i++) for (i = saveSP + 1; i < (int)SP; i++)
print(stdout, v=Stack[i]); print(stdout, v = Stack[i]);
break; break;
case F_READ: case F_READ:
argcount("read", nargs, 0); argcount("read", nargs, 0);
@ -796,24 +846,25 @@ value_t eval_sexpr(value_t e, value_t *penv)
break; break;
case F_LOAD: case F_LOAD:
argcount("load", nargs, 1); argcount("load", nargs, 1);
v = load_file(tosymbol(Stack[SP-1], "load")->name); v = load_file(tosymbol(Stack[SP - 1], "load")->name);
break; break;
case F_PROG1: case F_PROG1:
// return first arg // return first arg
if (nargs < 1) if (nargs < 1)
lerror("prog1: error: too few arguments\n"); lerror("prog1: error: too few arguments\n");
v = Stack[saveSP+1]; v = Stack[saveSP + 1];
break; break;
case F_APPLY: case F_APPLY:
// unpack a list onto the stack // unpack a list onto the stack
argcount("apply", nargs, 2); argcount("apply", nargs, 2);
v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist v = Stack[saveSP] = Stack[SP - 1]; // second arg is new arglist
f = Stack[SP-2]; // first arg is new function f = Stack[SP - 2]; // first arg is new function
POPN(2); // pop apply's args POPN(2); // pop apply's args
if (isbuiltin(f)) { if (isbuiltin(f)) {
if (isspecial(f)) if (isspecial(f))
lerror("apply: error: cannot apply special operator " lerror("apply: error: cannot apply special operator "
"%s\n", builtin_names[intval(f)]); "%s\n",
builtin_names[intval(f)]);
while (iscons(v)) { while (iscons(v)) {
PUSH(car_(v)); PUSH(car_(v));
v = cdr_(v); v = cdr_(v);
@ -825,11 +876,10 @@ value_t eval_sexpr(value_t e, value_t *penv)
} }
SP = saveSP; SP = saveSP;
return v; return v;
} } else {
else {
v = Stack[saveSP] = cdr_(Stack[saveSP]); v = Stack[saveSP] = cdr_(Stack[saveSP]);
} }
apply_lambda: apply_lambda:
if (iscons(f)) { if (iscons(f)) {
headsym = car_(f); headsym = car_(f);
if (headsym == LABEL) { if (headsym == LABEL) {
@ -841,18 +891,18 @@ value_t eval_sexpr(value_t e, value_t *penv)
} }
// apply lambda or macro expression // apply lambda or macro expression
PUSH(cdr(cdr(cdr_(f)))); PUSH(cdr(cdr(cdr_(f))));
lenv = &Stack[SP-1]; lenv = &Stack[SP - 1];
PUSH(car_(cdr_(f))); PUSH(car_(cdr_(f)));
argsyms = &Stack[SP-1]; argsyms = &Stack[SP - 1];
PUSH(car_(cdr_(cdr_(f)))); PUSH(car_(cdr_(cdr_(f))));
body = &Stack[SP-1]; body = &Stack[SP - 1];
if (labl) { if (labl) {
// add label binding to environment // add label binding to environment
PUSH(labl); PUSH(labl);
PUSH(car_(cdr_(labl))); PUSH(car_(cdr_(labl)));
*lenv = cons_(cons(&Stack[SP-1], &Stack[SP-2]), lenv); *lenv = cons_(cons(&Stack[SP - 1], &Stack[SP - 2]), lenv);
POPN(3); POPN(3);
v = Stack[saveSP]; // refetch arglist v = Stack[saveSP]; // refetch arglist
} }
if (headsym == MACRO) if (headsym == MACRO)
noeval = 1; noeval = 1;
@ -872,9 +922,10 @@ value_t eval_sexpr(value_t e, value_t *penv)
if (!issymbol(asym)) if (!issymbol(asym))
lerror("apply: error: formal argument not a symbol\n"); lerror("apply: error: formal argument not a symbol\n");
v = car_(v); v = car_(v);
if (!noeval) v = eval(v, penv); if (!noeval)
v = eval(v, penv);
PUSH(v); PUSH(v);
*lenv = cons_(cons(&asym, &Stack[SP-1]), lenv); *lenv = cons_(cons(&asym, &Stack[SP - 1]), lenv);
POPN(2); POPN(2);
*argsyms = cdr_(*argsyms); *argsyms = cdr_(*argsyms);
v = Stack[saveSP] = cdr_(Stack[saveSP]); v = Stack[saveSP] = cdr_(Stack[saveSP]);
@ -883,35 +934,33 @@ value_t eval_sexpr(value_t e, value_t *penv)
if (issymbol(*argsyms)) { if (issymbol(*argsyms)) {
if (noeval) { if (noeval) {
*lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv); *lenv = cons_(cons(argsyms, &Stack[saveSP]), lenv);
} } else {
else {
PUSH(NIL); PUSH(NIL);
PUSH(NIL); PUSH(NIL);
rest = &Stack[SP-1]; rest = &Stack[SP - 1];
// build list of rest arguments // build list of rest arguments
// we have to build it forwards, which is tricky // we have to build it forwards, which is tricky
while (iscons(v)) { while (iscons(v)) {
v = eval(car_(v), penv); v = eval(car_(v), penv);
PUSH(v); PUSH(v);
v = cons_(&Stack[SP-1], &NIL); v = cons_(&Stack[SP - 1], &NIL);
POP(); POP();
if (iscons(*rest)) if (iscons(*rest))
cdr_(*rest) = v; cdr_(*rest) = v;
else else
Stack[SP-2] = v; Stack[SP - 2] = v;
*rest = v; *rest = v;
v = Stack[saveSP] = cdr_(Stack[saveSP]); v = Stack[saveSP] = cdr_(Stack[saveSP]);
} }
*lenv = cons_(cons(argsyms, &Stack[SP-2]), lenv); *lenv = cons_(cons(argsyms, &Stack[SP - 2]), lenv);
} }
} } else if (iscons(*argsyms)) {
else if (iscons(*argsyms)) {
lerror("apply: error: too few arguments\n"); lerror("apply: error: too few arguments\n");
} }
} }
SP = saveSP; // free temporary stack space SP = saveSP; // free temporary stack space
PUSH(*lenv); // preserve environment on stack PUSH(*lenv); // preserve environment on stack
lenv = &Stack[SP-1]; lenv = &Stack[SP - 1];
v = eval(*body, lenv); v = eval(*body, lenv);
POP(); POP();
// macro: evaluate expansion in the calling environment // macro: evaluate expansion in the calling environment
@ -923,20 +972,23 @@ value_t eval_sexpr(value_t e, value_t *penv)
return NIL; return NIL;
} }
// repl ----------------------------------------------------------------------- // repl
// -----------------------------------------------------------------------
static char *infile = NULL; static char *infile = NULL;
value_t load_file(char *fname) value_t load_file(char *fname)
{ {
value_t e, v=NIL; value_t e, v = NIL;
char *lastfile = infile; char *lastfile = infile;
FILE *f = fopen(fname, "r"); FILE *f = fopen(fname, "r");
infile = fname; infile = fname;
if (f == NULL) lerror("file not found\n"); if (f == NULL)
lerror("file not found\n");
while (1) { while (1) {
e = read_sexpr(f); e = read_sexpr(f);
if (feof(f)) break; if (feof(f))
break;
v = eval(e, &NIL); v = eval(e, &NIL);
} }
infile = lastfile; infile = lastfile;
@ -944,11 +996,11 @@ value_t load_file(char *fname)
return v; return v;
} }
int main(int argc, char* argv[]) int main(int argc, char *argv[])
{ {
value_t v; value_t v;
stack_bottom = ((char*)&v) - PROCESS_STACK_SIZE; stack_bottom = ((char *)&v) - PROCESS_STACK_SIZE;
lisp_init(); lisp_init();
if (setjmp(toplevel)) { if (setjmp(toplevel)) {
SP = 0; SP = 0;
@ -960,14 +1012,19 @@ int main(int argc, char* argv[])
goto repl; goto repl;
} }
load_file("system.lsp"); load_file("system.lsp");
if (argc > 1) { load_file(argv[1]); return 0; } if (argc > 1) {
printf("Welcome to femtoLisp ----------------------------------------------------------\n"); load_file(argv[1]);
repl: return 0;
}
printf("Welcome to femtoLisp "
"----------------------------------------------------------\n");
repl:
while (1) { while (1) {
printf("> "); printf("> ");
v = read_sexpr(stdin); v = read_sexpr(stdin);
if (feof(stdin)) break; if (feof(stdin))
print(stdout, v=eval(v, &NIL)); break;
print(stdout, v = eval(v, &NIL));
set(symbol("that"), v); set(symbol("that"), v);
printf("\n\n"); printf("\n\n");
} }

497
tiny/lisp.c
View File

File diff suppressed because it is too large Load Diff

739
tiny/lisp2.c
View File

File diff suppressed because it is too large Load Diff

498
tiny/lispf.c
View File

File diff suppressed because it is too large Load Diff

33
types.c
View File

@ -4,31 +4,30 @@ fltype_t *get_type(value_t t)
{ {
fltype_t *ft; fltype_t *ft;
if (issymbol(t)) { if (issymbol(t)) {
ft = ((symbol_t*)ptr(t))->type; ft = ((symbol_t *)ptr(t))->type;
if (ft != NULL) if (ft != NULL)
return ft; return ft;
} }
void **bp = equalhash_bp(&TypeTable, (void*)t); void **bp = equalhash_bp(&TypeTable, (void *)t);
if (*bp != HT_NOTFOUND) if (*bp != HT_NOTFOUND)
return *bp; return *bp;
int align, isarray=(iscons(t) && car_(t) == arraysym && iscons(cdr_(t))); int align,
isarray = (iscons(t) && car_(t) == arraysym && iscons(cdr_(t)));
size_t sz; size_t sz;
if (isarray && !iscons(cdr_(cdr_(t)))) { if (isarray && !iscons(cdr_(cdr_(t)))) {
// special case: incomplete array type // special case: incomplete array type
sz = 0; sz = 0;
} } else {
else {
sz = ctype_sizeof(t, &align); sz = ctype_sizeof(t, &align);
} }
ft = (fltype_t*)malloc(sizeof(fltype_t)); ft = (fltype_t *)malloc(sizeof(fltype_t));
ft->type = t; ft->type = t;
if (issymbol(t)) { if (issymbol(t)) {
ft->numtype = sym_to_numtype(t); ft->numtype = sym_to_numtype(t);
((symbol_t*)ptr(t))->type = ft; ((symbol_t *)ptr(t))->type = ft;
} } else {
else {
ft->numtype = N_NUMTYPES; ft->numtype = N_NUMTYPES;
} }
ft->size = sz; ft->size = sz;
@ -48,9 +47,9 @@ fltype_t *get_type(value_t t)
ft->elsz = eltype->size; ft->elsz = eltype->size;
ft->eltype = eltype; ft->eltype = eltype;
ft->init = &cvalue_array_init; ft->init = &cvalue_array_init;
//eltype->artype = ft; -- this is a bad idea since some types carry array sizes // eltype->artype = ft; -- this is a bad idea since some types
} // carry array sizes
else if (car_(t) == enumsym) { } else if (car_(t) == enumsym) {
ft->numtype = T_INT32; ft->numtype = T_INT32;
ft->init = &cvalue_enum_init; ft->init = &cvalue_enum_init;
} }
@ -70,7 +69,7 @@ fltype_t *get_array_type(value_t eltype)
fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
cvinitfunc_t init) cvinitfunc_t init)
{ {
fltype_t *ft = (fltype_t*)malloc(sizeof(fltype_t)); fltype_t *ft = (fltype_t *)malloc(sizeof(fltype_t));
ft->type = sym; ft->type = sym;
ft->size = sz; ft->size = sz;
ft->numtype = N_NUMTYPES; ft->numtype = N_NUMTYPES;
@ -88,12 +87,12 @@ void relocate_typetable(void)
htable_t *h = &TypeTable; htable_t *h = &TypeTable;
size_t i; size_t i;
void *nv; void *nv;
for(i=0; i < h->size; i+=2) { for (i = 0; i < h->size; i += 2) {
if (h->table[i] != HT_NOTFOUND) { if (h->table[i] != HT_NOTFOUND) {
nv = (void*)relocate((value_t)h->table[i]); nv = (void *)relocate((value_t)h->table[i]);
h->table[i] = nv; h->table[i] = nv;
if (h->table[i+1] != HT_NOTFOUND) if (h->table[i + 1] != HT_NOTFOUND)
((fltype_t*)h->table[i+1])->type = (value_t)nv; ((fltype_t *)h->table[i + 1])->type = (value_t)nv;
} }
} }
} }