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)
return FL_NIL;
value_t lst, first=FL_NIL;
value_t lst, first = FL_NIL;
value_t *pcdr = &first;
cons_t *c;
uint32_t i=0;
uint32_t i = 0;
while (1) {
lst = args[i++];
if (i >= nargs) break;
if (i >= nargs)
break;
if (iscons(lst)) {
*pcdr = lst;
c = (cons_t*)ptr(lst);
c = (cons_t *)ptr(lst);
while (iscons(c->cdr))
c = (cons_t*)ptr(c->cdr);
c = (cons_t *)ptr(c->cdr);
pcdr = &c->cdr;
}
else if (lst != FL_NIL) {
} else if (lst != FL_NIL) {
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);
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])
return args[1];
args[1] = c->cdr;
@ -89,23 +89,19 @@ static value_t fl_length(value_t *args, u_int32_t nargs)
cvalue_t *cv;
if (isvector(a)) {
return fixnum(vector_size(a));
}
else if (iscprim(a)) {
cv = (cvalue_t*)ptr(a);
} else if (iscprim(a)) {
cv = (cvalue_t *)ptr(a);
if (cp_class(cv) == bytetype)
return fixnum(1);
else if (cp_class(cv) == wchartype)
return fixnum(u8_charlen(*(uint32_t*)cp_data((cprim_t*)cv)));
}
else if (iscvalue(a)) {
cv = (cvalue_t*)ptr(a);
return fixnum(u8_charlen(*(uint32_t *)cp_data((cprim_t *)cv)));
} else if (iscvalue(a)) {
cv = (cvalue_t *)ptr(a);
if (cv_class(cv)->eltype != NULL)
return size_wrap(cvalue_arraylen(a));
}
else if (a == FL_NIL) {
} else if (a == FL_NIL) {
return fixnum(0);
}
else if (iscons(a)) {
} else if (iscons(a)) {
return fixnum(llength(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)
{
argcount("keyword?", nargs, 1);
return (issymbol(args[0]) &&
iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
return (issymbol(args[0]) && iskeyword((symbol_t *)ptr(args[0]))) ? FL_T
: FL_F;
}
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) {
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);
root = root->right;
@ -188,7 +184,7 @@ static value_t fl_constantp(value_t *args, u_int32_t nargs)
{
argcount("constant?", nargs, 1);
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 (car_(args[0]) == QUOTE)
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];
if (isfixnum(v)) {
return FL_T;
}
else if (iscprim(v)) {
numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
} else if (iscprim(v)) {
numerictype_t nt = cp_numtype((cprim_t *)ptr(v));
if (nt < T_FLOAT)
return FL_T;
void *data = cp_data((cprim_t*)ptr(v));
void *data = cp_data((cprim_t *)ptr(v));
if (nt == T_FLOAT) {
float f = *(float*)data;
if (f < 0) f = -f;
float f = *(float *)data;
if (f < 0)
f = -f;
if (f <= FLT_MAXINT && (float)(int32_t)f == f)
return FL_T;
}
else {
} else {
assert(nt == T_DOUBLE);
double d = *(double*)data;
if (d < 0) d = -d;
double d = *(double *)data;
if (d < 0)
d = -d;
if (d <= DBL_MAXINT && (double)(int64_t)d == d)
return FL_T;
}
@ -231,8 +227,9 @@ static value_t fl_integerp(value_t *args, u_int32_t nargs)
argcount("integer?", nargs, 1);
value_t v = args[0];
return (isfixnum(v) ||
(iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ?
FL_T : FL_F;
(iscprim(v) && cp_numtype((cprim_t *)ptr(v)) < T_FLOAT))
? FL_T
: FL_F;
}
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);
if (isfixnum(args[0])) {
return args[0];
}
else if (iscprim(args[0])) {
cprim_t *cp = (cprim_t*)ptr(args[0]);
} else if (iscprim(args[0])) {
cprim_t *cp = (cprim_t *)ptr(args[0]);
return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
}
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]))
return 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);
numerictype_t nt = cp_numtype(cp);
double d;
if (nt == T_FLOAT)
d = (double)*(float*)data;
d = (double)*(float *)data;
else if (nt == T_DOUBLE)
d = *(double*)data;
d = *(double *)data;
else
return args[0];
if (d > 0) {
@ -291,8 +287,8 @@ static value_t fl_vector_alloc(value_t *args, u_int32_t nargs)
else
f = FL_UNSPECIFIED;
int k;
for(k=0; k < i; k++)
vector_elt(v,k) = f;
for (k = 0; k < i; k++)
vector_elt(v, k) = f;
return v;
}
@ -308,7 +304,7 @@ static double todouble(value_t a, char *fname)
if (isfixnum(a))
return (double)numval(a);
if (iscprim(a)) {
cprim_t *cp = (cprim_t*)ptr(a);
cprim_t *cp = (cprim_t *)ptr(a);
numerictype_t nt = cp_numtype(cp);
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);
char *name = tostring(args[0], "os.getenv");
char *val = getenv(name);
if (val == NULL) return FL_F;
if (val == NULL)
return FL_F;
if (*val == 0)
return symbol_value(emptystringsym);
return cvalue_static_cstring(val);
@ -386,8 +383,7 @@ static value_t fl_os_setenv(value_t *args, uint32_t nargs)
(void)unsetenv(name);
result = 0;
#endif
}
else {
} else {
char *val = tostring(args[1], "os.setenv");
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)
{
(void)args; (void)nargs;
(void)args;
(void)nargs;
fixnum_t r;
#ifdef BITS64
r = ((((uint64_t)random())<<32) | random()) & 0x1fffffffffffffffLL;
r = ((((uint64_t)random()) << 32) | random()) & 0x1fffffffffffffffLL;
#else
r = random() & 0x1fffffff;
#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)
{
(void)args; (void)nargs;
(void)args;
(void)nargs;
uint32_t r = random();
#ifdef BITS64
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)
{
(void)args; (void)nargs;
uint64_t r = (((uint64_t)random())<<32) | random();
(void)args;
(void)nargs;
uint64_t r = (((uint64_t)random()) << 32) | random();
return mk_uint64(r);
}
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());
}
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());
}
#define MATH_FUNC_1ARG(name) \
static value_t fl_##name(value_t *args, u_int32_t nargs) \
{ \
argcount(#name, nargs, 1); \
if (iscprim(args[0])) { \
cprim_t *cp = (cprim_t*)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \
return mk_float(name##f(*(float*)cp_data(cp))); \
} \
return mk_double(name(todouble(args[0], #name))); \
}
#define MATH_FUNC_1ARG(name) \
static value_t fl_##name(value_t *args, u_int32_t nargs) \
{ \
argcount(#name, nargs, 1); \
if (iscprim(args[0])) { \
cprim_t *cp = (cprim_t *)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \
return mk_float(name##f(*(float *)cp_data(cp))); \
} \
return mk_double(name(todouble(args[0], #name))); \
}
MATH_FUNC_1ARG(sqrt)
MATH_FUNC_1ARG(exp)
@ -494,11 +495,11 @@ static builtinspec_t builtin_info[] = {
{ "rand.float", fl_randf },
{ "sqrt", fl_sqrt },
{ "exp", fl_exp },
{ "log", fl_log },
{ "sin", fl_sin },
{ "cos", fl_cos },
{ "tan", fl_tan },
{ "exp", fl_exp },
{ "log", fl_log },
{ "sin", fl_sin },
{ "cos", fl_cos },
{ "tan", fl_tan },
{ "asin", fl_asin },
{ "acos", fl_acos },
{ "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_HASH_BOUND 16384
#define BOUNDED_HASH_BOUND 16384
// comparable tag
#define cmptag(v) (isfixnum(v) ? TAG_NUM : tag(v))
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)
return NIL;
if (c == key)
@ -14,14 +14,14 @@ static value_t eq_class(htable_t *table, value_t key)
return eq_class(table, c);
}
static void eq_union(htable_t *table, value_t a, value_t b,
value_t c, value_t cb)
static void eq_union(htable_t *table, value_t a, value_t b, value_t c,
value_t cb)
{
value_t ca = (c==NIL ? a : c);
value_t ca = (c == NIL ? a : c);
if (cb != NIL)
ptrhash_put(table, (void*)cb, (void*)ca);
ptrhash_put(table, (void*)a, (void*)ca);
ptrhash_put(table, (void*)b, (void*)ca);
ptrhash_put(table, (void *)cb, (void *)ca);
ptrhash_put(table, (void *)a, (void *)ca);
ptrhash_put(table, (void *)b, (void *)ca);
}
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 lb = vector_size(b);
size_t m, i;
if (eq && (la!=lb)) return fixnum(1);
if (eq && (la != lb))
return fixnum(1);
m = la < lb ? la : lb;
for (i = 0; i < m; i++) {
value_t d = bounded_compare(vector_elt(a,i), vector_elt(b,i),
bound-1, eq);
if (d==NIL || numval(d)!=0) return d;
value_t d =
bounded_compare(vector_elt(a, i), vector_elt(b, i), bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
}
if (la < lb) return fixnum(-1);
if (la > lb) return fixnum(1);
if (la < lb)
return fixnum(-1);
if (la > lb)
return fixnum(1);
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;
compare_top:
if (a == b) return fixnum(0);
compare_top:
if (a == b)
return fixnum(0);
if (bound <= 0)
return NIL;
int taga = tag(a);
int tagb = cmptag(b);
int c;
switch (taga) {
case TAG_NUM :
case TAG_NUM:
case TAG_NUM1:
if (isfixnum(b)) {
return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
}
if (iscprim(b)) {
if (cp_class((cprim_t*)ptr(b)) == wchartype)
if (cp_class((cprim_t *)ptr(b)) == wchartype)
return fixnum(1);
return fixnum(numeric_compare(a, b, eq, 1, NULL));
}
return fixnum(-1);
case TAG_SYM:
if (eq) return fixnum(1);
if (tagb < TAG_SYM) return fixnum(1);
if (tagb > TAG_SYM) return fixnum(-1);
if (eq)
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)));
case TAG_VECTOR:
if (isvector(b))
return bounded_vector_compare(a, b, bound, eq);
break;
case TAG_CPRIM:
if (cp_class((cprim_t*)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype)
if (cp_class((cprim_t *)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((cprim_t *)ptr(b)) != wchartype)
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);
}
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;
case TAG_CVALUE:
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 fixnum(1);
}
@ -100,24 +107,30 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
case TAG_FUNCTION:
if (tagb == TAG_FUNCTION) {
if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) {
function_t *fa = (function_t*)ptr(a);
function_t *fb = (function_t*)ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
d = bounded_compare(fa->vals, fb->vals, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
d = bounded_compare(fa->env, fb->env, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
function_t *fa = (function_t *)ptr(a);
function_t *fb = (function_t *)ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
d = bounded_compare(fa->vals, fb->vals, bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
d = bounded_compare(fa->env, fb->env, bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
return fixnum(0);
}
return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1);
}
break;
case TAG_CONS:
if (tagb < TAG_CONS) return fixnum(1);
d = bounded_compare(car_(a), car_(b), bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
a = cdr_(a); b = cdr_(b);
if (tagb < TAG_CONS)
return fixnum(1);
d = bounded_compare(car_(a), car_(b), bound - 1, eq);
if (d == NIL || numval(d) != 0)
return d;
a = cdr_(a);
b = cdr_(b);
bound--;
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;
// 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;
for (i = 0; i < m; i++) {
xa = vector_elt(a,i);
xb = vector_elt(b,i);
xa = vector_elt(a, i);
xb = vector_elt(b, i);
if (leafp(xa) || leafp(xb)) {
d = bounded_compare(xa, xb, 1, eq);
if (d!=NIL && numval(d)!=0) return d;
}
else if (tag(xa) < tag(xb)) {
if (d != NIL && numval(d) != 0)
return d;
} else if (tag(xa) < tag(xb)) {
return fixnum(-1);
}
else if (tag(xa) > tag(xb)) {
} else if (tag(xa) > tag(xb)) {
return fixnum(1);
}
}
ca = eq_class(table, a);
cb = eq_class(table, b);
if (ca!=NIL && ca==cb)
if (ca != NIL && ca == cb)
return fixnum(0);
eq_union(table, a, b, ca, cb);
for (i = 0; i < m; i++) {
xa = vector_elt(a,i);
xb = vector_elt(b,i);
if (!leafp(xa) || tag(xa)==TAG_FUNCTION) {
xa = vector_elt(a, i);
xb = vector_elt(b, i);
if (!leafp(xa) || tag(xa) == TAG_FUNCTION) {
d = cyc_compare(xa, xb, table, eq);
if (numval(d)!=0)
if (numval(d) != 0)
return d;
}
}
if (la < lb) return fixnum(-1);
if (la > lb) return fixnum(1);
if (la < lb)
return fixnum(-1);
if (la > lb)
return fixnum(1);
return fixnum(0);
}
static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq)
{
value_t d, ca, cb;
cyc_compare_top:
if (a==b)
cyc_compare_top:
if (a == b)
return fixnum(0);
if (iscons(a)) {
if (iscons(b)) {
value_t aa = car_(a); value_t da = cdr_(a);
value_t ab = car_(b); value_t db = cdr_(b);
int tagaa = tag(aa); int tagda = tag(da);
int tagab = tag(ab); int tagdb = tag(db);
value_t aa = car_(a);
value_t da = cdr_(a);
value_t ab = car_(b);
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)) {
d = bounded_compare(aa, ab, 1, eq);
if (d!=NIL && numval(d)!=0) return d;
}
else if (tagaa < tagab)
if (d != NIL && numval(d) != 0)
return d;
} else if (tagaa < tagab)
return fixnum(-1);
else if (tagaa > tagab)
return fixnum(1);
if (leafp(da) || leafp(db)) {
d = bounded_compare(da, db, 1, eq);
if (d!=NIL && numval(d)!=0) return d;
}
else if (tagda < tagdb)
if (d != NIL && numval(d) != 0)
return d;
} else if (tagda < tagdb)
return fixnum(-1);
else if (tagda > tagdb)
return fixnum(1);
ca = eq_class(table, a);
cb = eq_class(table, b);
if (ca!=NIL && ca==cb)
if (ca != NIL && ca == cb)
return fixnum(0);
eq_union(table, a, b, ca, cb);
d = cyc_compare(aa, ab, table, eq);
if (numval(d)!=0) return d;
if (numval(d) != 0)
return d;
a = da;
b = db;
goto cyc_compare_top;
}
else {
} else {
return fixnum(1);
}
}
else if (isvector(a) && isvector(b)) {
} else if (isvector(a) && isvector(b)) {
return cyc_vector_compare(a, b, table, eq);
}
else if (isclosure(a) && isclosure(b)) {
function_t *fa = (function_t*)ptr(a);
function_t *fb = (function_t*)ptr(b);
} else if (isclosure(a) && isclosure(b)) {
function_t *fa = (function_t *)ptr(a);
function_t *fb = (function_t *)ptr(b);
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);
cb = eq_class(table, b);
if (ca!=NIL && ca==cb)
if (ca != NIL && ca == cb)
return fixnum(0);
eq_union(table, a, b, ca, cb);
d = cyc_compare(fa->vals, fb->vals, table, eq);
if (numval(d) != 0) return d;
if (numval(d) != 0)
return d;
a = fa->env;
b = fb->env;
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;
void comparehash_init(void)
{
htable_new(&equal_eq_hashtable, 512);
}
void comparehash_init(void) { htable_new(&equal_eq_hashtable, 512); }
// 'eq' means unordered comparison is sufficient
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;
}
value_t fl_compare(value_t a, value_t b)
{
return compare_(a, b, 0);
}
value_t fl_compare(value_t a, value_t b) { return compare_(a, b, 0); }
value_t fl_equal(value_t a, value_t b)
{
if (eq_comparable(a, b))
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 doublehash(a) int64hash(a)
#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)
#endif
@ -301,27 +314,27 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
void *data;
uptrint_t h = 0;
int oob2, tg = tag(a);
switch(tg) {
case TAG_NUM :
switch (tg) {
case TAG_NUM:
case TAG_NUM1:
u.d = (double)numval(a);
return doublehash(u.i64);
case TAG_FUNCTION:
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);
case TAG_SYM:
return ((symbol_t*)ptr(a))->hash;
return ((symbol_t *)ptr(a))->hash;
case TAG_CPRIM:
cp = (cprim_t*)ptr(a);
cp = (cprim_t *)ptr(a);
data = cp_data(cp);
if (cp_class(cp) == wchartype)
return inthash(*(int32_t*)data);
return inthash(*(int32_t *)data);
nt = cp_numtype(cp);
u.d = conv_to_double(data, nt);
return doublehash(u.i64);
case TAG_CVALUE:
cv = (cvalue_t*)ptr(a);
cv = (cvalue_t *)ptr(a);
data = cv_data(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;
}
len = vector_size(a);
for(i=0; i < len; i++) {
h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1);
for (i = 0; i < len; i++) {
h = MIX(h, bounded_hash(vector_elt(a, i), bound / 2, &oob2) ^ 1);
if (oob2)
bound/=2;
bound /= 2;
*oob = *oob || oob2;
}
return h;
@ -345,11 +358,11 @@ static uptrint_t bounded_hash(value_t a, int bound, int *oob)
*oob = 1;
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
// so we can hash better when a list is cdr-deep (a common case)
if (oob2)
bound/=2;
bound /= 2;
else
bound--;
// 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;
a = cdr_(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;
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)
{
if (eq_comparable(a, b))
return (a==b);
return (numval(compare_(a,b,1))==0);
return (a == b);
return (numval(compare_(a, b, 1)) == 0);
}
uptrint_t hash_lispvalue(value_t a)
{
int oob=0;
int oob = 0;
uptrint_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
return n;
}

2
equalhash.c
View File

@ -11,6 +11,6 @@
#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_)

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 {
uptrint_t flags;
value_t binding; // global value binding
value_t binding; // global value binding
struct _fltype_t *type;
uint32_t hash;
void *dlcache; // dlsym address
void *dlcache; // dlsym address
// below fields are private
struct _symbol_t *left;
struct _symbol_t *right;
union {
char name[1];
void *_pad; // ensure field aligned to pointer size
void *_pad; // ensure field aligned to pointer size
};
} symbol_t;
typedef struct {
value_t isconst;
value_t binding; // global value binding
value_t binding; // global value binding
struct _fltype_t *type;
uint32_t id;
} gensym_t;
#define TAG_NUM 0x0
#define TAG_CPRIM 0x1
#define TAG_NUM 0x0
#define TAG_CPRIM 0x1
#define TAG_FUNCTION 0x2
#define TAG_VECTOR 0x3
#define TAG_NUM1 0x4
#define TAG_CVALUE 0x5
#define TAG_SYM 0x6
#define TAG_CONS 0x7
#define UNBOUND ((value_t)0x1) // an invalid value
#define TAG_FWD UNBOUND
#define TAG_VECTOR 0x3
#define TAG_NUM1 0x4
#define TAG_CVALUE 0x5
#define TAG_SYM 0x6
#define TAG_CONS 0x7
#define UNBOUND ((value_t)0x1) // an invalid value
#define TAG_FWD UNBOUND
#define tag(x) ((x)&0x7)
#define ptr(x) ((void*)((x)&(~(value_t)0x7)))
#define tagptr(p,t) (((value_t)(p)) | (t))
#define fixnum(x) ((value_t)(((fixnum_t)(x))<<2))
#define numval(x) (((fixnum_t)(x))>>2)
#define ptr(x) ((void *)((x) & (~(value_t)0x7)))
#define tagptr(p, t) (((value_t)(p)) | (t))
#define fixnum(x) ((value_t)(((fixnum_t)(x)) << 2))
#define numval(x) (((fixnum_t)(x)) >> 2)
#ifdef BITS64
#define fits_fixnum(x) (((x)>>61) == 0 || (~((x)>>61)) == 0)
#define fits_fixnum(x) (((x) >> 61) == 0 || (~((x) >> 61)) == 0)
#else
#define fits_fixnum(x) (((x)>>29) == 0 || (~((x)>>29)) == 0)
#define fits_fixnum(x) (((x) >> 29) == 0 || (~((x) >> 29)) == 0)
#endif
#define fits_bits(x,b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0)
#define uintval(x) (((unsigned int)(x))>>3)
#define builtin(n) tagptr((((int)n)<<3), TAG_FUNCTION)
#define iscons(x) (tag(x) == TAG_CONS)
#define issymbol(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (((x)&3) == TAG_NUM)
#define bothfixnums(x,y) ((((x)|(y))&3) == TAG_NUM)
#define fits_bits(x, b) (((x) >> (b - 1)) == 0 || (~((x) >> (b - 1))) == 0)
#define uintval(x) (((unsigned int)(x)) >> 3)
#define builtin(n) tagptr((((int)n) << 3), TAG_FUNCTION)
#define iscons(x) (tag(x) == TAG_CONS)
#define issymbol(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (((x)&3) == TAG_NUM)
#define bothfixnums(x, y) ((((x) | (y)) & 3) == TAG_NUM)
#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET)
#define isvector(x) (tag(x) == TAG_VECTOR)
#define iscvalue(x) (tag(x) == TAG_CVALUE)
#define iscprim(x) (tag(x) == TAG_CPRIM)
#define selfevaluating(x) (tag(x)<6)
#define iscprim(x) (tag(x) == TAG_CPRIM)
#define selfevaluating(x) (tag(x) < 6)
// comparable with ==
#define eq_comparable(a,b) (!(((a)|(b))&1))
#define eq_comparable(a, b) (!(((a) | (b)) & 1))
#define eq_comparablep(a) (!((a)&1))
// doesn't lead to other values
#define leafp(a) (((a)&3) != 3)
#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD)
#define forwardloc(v) (((value_t*)ptr(v))[1])
#define forward(v,to) do { (((value_t*)ptr(v))[0] = TAG_FWD); \
(((value_t*)ptr(v))[1] = to); } while (0)
#define isforwarded(v) (((value_t *)ptr(v))[0] == TAG_FWD)
#define forwardloc(v) (((value_t *)ptr(v))[1])
#define forward(v, to) \
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_setsize(v,n) (((size_t*)ptr(v))[0] = ((n)<<2))
#define vector_elt(v,i) (((value_t*)ptr(v))[1+(i)])
#define vector_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3))
#define vector_size(v) (((size_t *)ptr(v))[0] >> 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_grow_amt(x) ((x) < 8 ? 5 : 6 * ((x) >> 3))
// functions ending in _ are unsafe, faster versions
#define car_(v) (((cons_t*)ptr(v))->car)
#define cdr_(v) (((cons_t*)ptr(v))->cdr)
#define car(v) (tocons((v),"car")->car)
#define cdr(v) (tocons((v),"cdr")->cdr)
#define fn_bcode(f) (((value_t*)ptr(f))[0])
#define fn_vals(f) (((value_t*)ptr(f))[1])
#define fn_env(f) (((value_t*)ptr(f))[2])
#define fn_name(f) (((value_t*)ptr(f))[3])
#define car_(v) (((cons_t *)ptr(v))->car)
#define cdr_(v) (((cons_t *)ptr(v))->cdr)
#define car(v) (tocons((v), "car")->car)
#define cdr(v) (tocons((v), "cdr")->cdr)
#define fn_bcode(f) (((value_t *)ptr(f))[0])
#define fn_vals(f) (((value_t *)ptr(f))[1])
#define fn_env(f) (((value_t *)ptr(f))[2])
#define fn_name(f) (((value_t *)ptr(f))[3])
#define set(s, v) (((symbol_t*)ptr(s))->binding = (v))
#define setc(s, v) do { ((symbol_t*)ptr(s))->flags |= 1; \
((symbol_t*)ptr(s))->binding = (v); } while (0)
#define isconstant(s) ((s)->flags&0x1)
#define iskeyword(s) ((s)->flags&0x2)
#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 set(s, v) (((symbol_t *)ptr(s))->binding = (v))
#define setc(s, v) \
do { \
((symbol_t *)ptr(s))->flags |= 1; \
((symbol_t *)ptr(s))->binding = (v); \
} while (0)
#define isconstant(s) ((s)->flags & 0x1)
#define iskeyword(s) ((s)->flags & 0x2)
#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 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_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
// i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count
#define FOR_ARGS(i, i0, arg, args) \
for(i=i0; ((size_t)i)<nargs && ((arg=args[i]) || 1); i++)
#define FOR_ARGS(i, i0, arg, args) \
for (i = i0; ((size_t)i) < nargs && ((arg = args[i]) || 1); i++)
#define N_BUILTINS ((int)N_OPCODES)
@ -178,29 +186,33 @@ extern fl_exception_context_t *fl_ctx;
extern uint32_t fl_throwing_frame;
extern value_t fl_lasterror;
#define FL_TRY_EXTERN \
fl_exception_context_t _ctx; int l__tr, l__ca; \
fl_savestate(&_ctx); fl_ctx = &_ctx; \
if (!setjmp(_ctx.buf)) \
for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx=fl_ctx->prev))
#define FL_TRY_EXTERN \
fl_exception_context_t _ctx; \
int l__tr, l__ca; \
fl_savestate(&_ctx); \
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 \
else \
for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
else for (l__ca = 1; l__ca; l__ca = 0, fl_restorestate(&_ctx))
void lerrorf(value_t e, char *format, ...) __attribute__ ((__noreturn__));
void lerror(value_t e, const char *msg) __attribute__ ((__noreturn__));
void lerrorf(value_t e, char *format, ...) __attribute__((__noreturn__));
void lerror(value_t e, const char *msg) __attribute__((__noreturn__));
void fl_savestate(fl_exception_context_t *_ctx);
void fl_restorestate(fl_exception_context_t *_ctx);
void fl_raise(value_t e) __attribute__ ((__noreturn__));
void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__));
void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__));
void fl_raise(value_t e) __attribute__((__noreturn__));
void type_error(char *fname, char *expected, value_t got)
__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 UnboundError;
static inline void argcount(char *fname, uint32_t nargs, uint32_t 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 {
@ -211,17 +223,27 @@ typedef struct {
} 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,
T_INT64, T_UINT64, T_FLOAT, T_DOUBLE } numerictype_t;
typedef enum {
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
# define T_LONG T_INT64
# define T_ULONG T_UINT64
#define T_LONG T_INT64
#define T_ULONG T_UINT64
#else
# define T_LONG T_INT32
# define T_ULONG T_UINT32
#define T_LONG T_INT32
#define T_ULONG T_UINT32
#endif
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_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 {
value_t type;
@ -247,10 +269,10 @@ typedef struct _fltype_t {
typedef struct {
fltype_t *type;
void *data;
size_t len; // length of *data in bytes
size_t len; // length of *data in bytes
union {
value_t parent; // optional
char _space[1]; // variable size
value_t parent; // optional
char _space[1]; // variable size
};
} cvalue_t;
@ -271,57 +293,58 @@ typedef struct {
#define CPRIM_NWORDS 2
#define MAX_INL_SIZE 384
#define CV_OWNED_BIT 0x1
#define CV_OWNED_BIT 0x1
#define CV_PARENT_BIT 0x2
#define owned(cv) ((uptrint_t)(cv)->type & CV_OWNED_BIT)
#define hasparent(cv) ((uptrint_t)(cv)->type & CV_PARENT_BIT)
#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
#define cv_class(cv) ((fltype_t*)(((uptrint_t)(cv)->type)&~3))
#define cv_len(cv) ((cv)->len)
#define cv_type(cv) (cv_class(cv)->type)
#define cv_data(cv) ((cv)->data)
#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
#define cv_isPOD(cv) (cv_class(cv)->init != NULL)
#define owned(cv) ((uptrint_t)(cv)->type & CV_OWNED_BIT)
#define hasparent(cv) ((uptrint_t)(cv)->type & CV_PARENT_BIT)
#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
#define cv_class(cv) ((fltype_t *)(((uptrint_t)(cv)->type) & ~3))
#define cv_len(cv) ((cv)->len)
#define cv_type(cv) (cv_class(cv)->type)
#define cv_data(cv) ((cv)->data)
#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
#define cv_isPOD(cv) (cv_class(cv)->init != NULL)
#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
#define cvalue_len(v) cv_len((cvalue_t*)ptr(v))
#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
#define cvalue_data(v) cv_data((cvalue_t *)ptr(v))
#define cvalue_len(v) cv_len((cvalue_t *)ptr(v))
#define value2c(type, v) ((type)cv_data((cvalue_t *)ptr(v)))
#define valid_numtype(v) ((v) < N_NUMTYPES)
#define cp_class(cp) ((cp)->type)
#define cp_type(cp) (cp_class(cp)->type)
#define cp_class(cp) ((cp)->type)
#define cp_type(cp) (cp_class(cp)->type)
#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!
#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 */
typedef int8_t fl_int8_t;
typedef uint8_t fl_uint8_t;
typedef int16_t fl_int16_t;
typedef int8_t fl_int8_t;
typedef uint8_t fl_uint8_t;
typedef int16_t fl_int16_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 int64_t fl_int64_t;
typedef int64_t fl_int64_t;
typedef uint64_t fl_uint64_t;
typedef char fl_char_t;
typedef char char_t;
typedef long fl_long_t;
typedef long long_t;
typedef char fl_char_t;
typedef char char_t;
typedef long fl_long_t;
typedef long long_t;
typedef unsigned long fl_ulong_t;
typedef unsigned long ulong_t;
typedef double fl_double_t;
typedef float fl_float_t;
typedef double fl_double_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 int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
extern value_t int64sym, uint64sym;
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 unionsym, floatsym, doublesym;
extern fltype_t *bytetype, *wchartype;

12
flmain.c
View File

@ -7,10 +7,10 @@
static value_t argv_list(int argc, char *argv[])
{
int i;
value_t lst=FL_NIL, temp;
value_t lst = FL_NIL, temp;
fl_gc_handle(&lst);
fl_gc_handle(&temp);
for(i=argc-1; i >= 0; i--) {
for (i = argc - 1; i >= 0; i--) {
temp = cvalue_static_cstring(argv[i]);
lst = fl_cons(temp, lst);
}
@ -24,7 +24,7 @@ int main(int argc, char *argv[])
{
char fname_buf[1024];
fl_init(512*1024);
fl_init(512 * 1024);
fname_buf[0] = '\0';
#ifdef INITFILE
@ -42,7 +42,8 @@ int main(int argc, char *argv[])
value_t args[2];
fl_gc_handle(&args[0]);
fl_gc_handle(&args[1]);
FL_TRY_EXTERN {
FL_TRY_EXTERN
{
args[0] = cvalue_static_cstring(fname_buf);
args[1] = symbol(":read");
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")),
argv_list(argc, argv));
}
FL_CATCH_EXTERN {
FL_CATCH_EXTERN
{
ios_puts("fatal error:\n", ios_stderr);
fl_print(ios_stderr, fl_lasterror);
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)
{
ios_t *s = value2c(ios_t*, self);
ios_t *s = value2c(ios_t *, self);
ios_close(s);
}
void relocate_iostream(value_t oldv, value_t newv)
{
ios_t *olds = value2c(ios_t*, oldv);
ios_t *news = value2c(ios_t*, newv);
ios_t *olds = value2c(ios_t *, oldv);
ios_t *news = value2c(ios_t *, newv);
if (news->buf == &olds->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)
{
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)
@ -64,33 +64,40 @@ static ios_t *toiostream(value_t v, char *fname)
{
if (!fl_isiostream(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)
{
return toiostream(v, fname);
}
ios_t *fl_toiostream(value_t v, char *fname) { return toiostream(v, fname); }
value_t fl_file(value_t *args, uint32_t nargs)
{
if (nargs < 1)
argcount("file", nargs, 1);
int i, r=0, w=0, c=0, t=0, a=0;
for(i=1; i < (int)nargs; i++) {
if (args[i] == wrsym) w = 1;
else if (args[i] == apsym) { a = 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;
int i, r = 0, w = 0, c = 0, t = 0, a = 0;
for (i = 1; i < (int)nargs; i++) {
if (args[i] == wrsym)
w = 1;
else if (args[i] == apsym) {
a = 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));
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)
lerrorf(IOError, "file: could not open \"%s\"", fname);
if (a) ios_seek_end(s);
if (a)
ios_seek_end(s);
return f;
}
@ -99,7 +106,7 @@ value_t fl_buffer(value_t *args, u_int32_t nargs)
argcount("buffer", nargs, 0);
(void)args;
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)
lerror(MemoryError, "buffer: could not allocate stream");
return f;
@ -110,18 +117,16 @@ value_t fl_read(value_t *args, u_int32_t nargs)
value_t arg = 0;
if (nargs > 1) {
argcount("read", nargs, 1);
}
else if (nargs == 0) {
} else if (nargs == 0) {
arg = symbol_value(instrsym);
}
else {
} else {
arg = args[0];
}
(void)toiostream(arg, "read");
fl_gc_handle(&arg);
value_t v = fl_read_sexpr(arg);
fl_free_gc_handles(1);
if (ios_eof(value2c(ios_t*,arg)))
if (ios_eof(value2c(ios_t *, arg)))
return FL_EOF;
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");
uint32_t wc;
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 mk_wchar(wc);
}
@ -151,9 +156,9 @@ value_t fl_ioputc(value_t *args, u_int32_t nargs)
{
argcount("io.putc", nargs, 2);
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]);
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));
}
@ -161,13 +166,13 @@ value_t fl_ioungetc(value_t *args, u_int32_t nargs)
{
argcount("io.ungetc", nargs, 2);
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]);
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) {
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)
@ -247,8 +252,7 @@ value_t fl_ioread(value_t *args, u_int32_t nargs)
// form (io.read s type count)
ft = get_array_type(args[1]);
n = toulong(args[2], "io.read") * ft->elsz;
}
else {
} else {
ft = get_type(args[1]);
if (ft->eltype != NULL && !iscons(cdr_(cdr_(args[1]))))
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);
char *data;
if (iscvalue(cv)) data = cv_data((cvalue_t*)ptr(cv));
else data = cp_data((cprim_t*)ptr(cv));
size_t got = ios_read(value2c(ios_t*,args[0]), data, n);
if (iscvalue(cv))
data = cv_data((cvalue_t *)ptr(cv));
else
data = cp_data((cprim_t *)ptr(cv));
size_t got = ios_read(value2c(ios_t *, args[0]), data, n);
if (got < n)
//lerror(IOError, "io.read: end of input reached");
// lerror(IOError, "io.read: end of input reached");
return FL_EOF;
return cv;
}
@ -285,19 +291,19 @@ value_t fl_iowrite(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 4)
argcount("io.write", nargs, 2);
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)
lerror(ArgError,
"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));
}
char *data;
size_t sz, offs=0;
size_t sz, offs = 0;
to_sized_ptr(args[1], "io.write", &data, &sz);
size_t nb = sz;
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;
}
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);
ios_t *s = toiostream(symbol_value(outstrsym), "dump");
char *data;
size_t sz, offs=0;
size_t sz, offs = 0;
to_sized_ptr(args[0], "dump", &data, &sz);
size_t nb = sz;
if (nargs > 1) {
@ -325,7 +331,7 @@ static char get_delim_arg(value_t arg, char *fname)
size_t uldelim = toulong(arg, fname);
if (uldelim > 0x7f) {
// 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)
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);
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);
ios_t dest;
ios_mem(&dest, 0);
@ -352,7 +358,7 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
cv_autorelease(cv);
#endif
}
((char*)cv->data)[n] = '\0';
((char *)cv->data)[n] = '\0';
if (n == 0 && ios_eof(src))
return FL_EOF;
return str;
@ -384,19 +390,19 @@ value_t stream_to_string(value_t *ps)
{
value_t str;
size_t n;
ios_t *st = value2c(ios_t*,*ps);
ios_t *st = value2c(ios_t *, *ps);
if (st->buf == &st->local[0]) {
n = st->size;
str = cvalue_string(n);
memcpy(cvalue_data(str), value2c(ios_t*,*ps)->buf, n);
ios_trunc(value2c(ios_t*,*ps), 0);
}
else {
char *b = ios_takebuf(st, &n); n--;
memcpy(cvalue_data(str), value2c(ios_t *, *ps)->buf, n);
ios_trunc(value2c(ios_t *, *ps), 0);
} else {
char *b = ios_takebuf(st, &n);
n--;
b[n] = '\0';
str = cvalue_from_ref(stringtype, b, n, FL_NIL);
#ifndef BOEHM_GC
cv_autorelease((cvalue_t*)ptr(str));
cv_autorelease((cvalue_t *)ptr(str));
#endif
}
return str;
@ -422,13 +428,13 @@ static builtinspec_t iostreamfunc_info[] = {
{ "write", fl_write },
{ "io.flush", fl_ioflush },
{ "io.close", fl_ioclose },
{ "io.eof?" , fl_ioeof },
{ "io.seek" , fl_ioseek },
{ "io.pos", fl_iopos },
{ "io.getc" , fl_iogetc },
{ "io.eof?", fl_ioeof },
{ "io.seek", fl_ioseek },
{ "io.pos", fl_iopos },
{ "io.getc", fl_iogetc },
{ "io.ungetc", fl_ioungetc },
{ "io.putc" , fl_ioputc },
{ "io.peekc" , fl_iopeekc },
{ "io.putc", fl_ioputc },
{ "io.peekc", fl_iopeekc },
{ "io.discardbuffer", fl_iopurge },
{ "io.read", fl_ioread },
{ "io.write", fl_iowrite },
@ -450,14 +456,14 @@ void iostream_init(void)
truncsym = symbol(":truncate");
instrsym = symbol("*input-stream*");
outstrsym = symbol("*output-stream*");
iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t),
&iostream_vtable, NULL);
iostreamtype =
define_opaque_type(iostreamsym, sizeof(ios_t), &iostream_vtable, NULL);
assign_global_builtins(iostreamfunc_info);
setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout,
sizeof(ios_t), FL_NIL));
setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr,
sizeof(ios_t), FL_NIL));
setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin,
sizeof(ios_t), FL_NIL));
setc(symbol("*stdout*"),
cvalue_from_ref(iostreamtype, ios_stdout, sizeof(ios_t), FL_NIL));
setc(symbol("*stderr*"),
cvalue_from_ref(iostreamtype, ios_stderr, sizeof(ios_t), FL_NIL));
setc(symbol("*stdin*"),
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
x = _bswap(x);
#else
x = (x >> 16) | (x << 16); m = 0xff00ff00;
x = (x >> 16) | (x << 16);
m = 0xff00ff00;
x = ((x & m) >> 8) | ((x & ~m) << 8);
#endif
m = 0xf0f0f0f0;
x = ((x & m) >> 4) | ((x & ~m) << 4); m = 0xcccccccc;
x = ((x & m) >> 2) | ((x & ~m) << 2); m = 0xaaaaaaaa;
x = ((x & m) >> 4) | ((x & ~m) << 4);
m = 0xcccccccc;
x = ((x & m) >> 2) | ((x & ~m) << 2);
m = 0xaaaaaaaa;
x = ((x & m) >> 1) | ((x & ~m) << 1);
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)
{
u_int32_t i;
if (s == 0 || n == 0) return;
i = (s>>5);
if (s == 0 || n == 0)
return;
i = (s >> 5);
if (i) {
n -= i;
memmove(b, &b[i], n*4);
memset(&b[n], 0, i*4);
memmove(b, &b[i], n * 4);
memset(&b[n], 0, i * 4);
s &= 31;
}
for(i=0; i < n-1; i++) {
b[i] = (b[i]>>s) | (b[i+1]<<(32-s));
for (i = 0; i < n - 1; i++) {
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
@ -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)
{
u_int32_t i, j;
if (n == 0) return;
if (n == 0)
return;
if (s == 0) {
memcpy(dest, b, n*4);
memcpy(dest, b, n * 4);
return;
}
j = (s>>5);
j = (s >> 5);
if (j) {
n -= j;
memset(&dest[n], 0, j*4);
memset(&dest[n], 0, j * 4);
s &= 31;
b = &b[j];
}
for(i=0; i < n-1; i++) {
dest[i] = (b[i]>>s) | (b[i+1]<<(32-s));
for (i = 0; i < n - 1; i++) {
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)
{
u_int32_t i, scrap=0, temp;
if (s == 0 || n == 0) return;
i = (s>>5);
u_int32_t i, scrap = 0, temp;
if (s == 0 || n == 0)
return;
i = (s >> 5);
if (i) {
n -= i;
memmove(&b[i], b, n*4);
memset(b, 0, i*4);
memmove(&b[i], b, n * 4);
memset(b, 0, i * 4);
s &= 31;
b = &b[i];
}
for(i=0; i < n; i++) {
temp = (b[i]<<s) | scrap;
scrap = b[i]>>(32-s);
for (i = 0; i < n; i++) {
temp = (b[i] << s) | scrap;
scrap = b[i] >> (32 - s);
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,
bool_t scrap)
{
u_int32_t i, j, sc=0;
if (n == 0) return;
u_int32_t i, j, sc = 0;
if (n == 0)
return;
if (s == 0) {
memcpy(dest, b, n*4);
memcpy(dest, b, n * 4);
return;
}
j = (s>>5);
j = (s >> 5);
if (j) {
n -= j;
memset(dest, 0, j*4);
memset(dest, 0, j * 4);
s &= 31;
dest = &dest[j];
}
for(i=0; i < n; i++) {
dest[i] = (b[i]<<s) | sc;
sc = b[i]>>(32-s);
for (i = 0; i < n; i++) {
dest[i] = (b[i] << s) | sc;
sc = b[i] >> (32 - s);
}
if (scrap)
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
// 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;
u_int32_t nw, tail;
u_int32_t mask;
if (nbits == 0) return;
nw = (offs+nbits+31)>>5;
if (nbits == 0)
return;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) {
mask = (lomask(nbits)<<offs);
if (c) b[0]|=mask; else b[0]&=(~mask);
mask = (lomask(nbits) << offs);
if (c)
b[0] |= mask;
else
b[0] &= (~mask);
return;
}
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;
for(i=1; i < nw-1; i++)
if (c)
mask = ONES32;
else
mask = 0;
for (i = 1; i < nw - 1; i++)
b[i] = mask;
tail = (offs+nbits)&31;
if (tail==0) {
tail = (offs + nbits) & 31;
if (tail == 0) {
b[i] = mask;
}
else {
} else {
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 mask;
if (nbits == 0) return;
nw = (offs+nbits+31)>>5;
if (nbits == 0)
return;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) {
mask = (lomask(nbits)<<offs);
mask = (lomask(nbits) << offs);
b[0] ^= mask;
return;
}
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];
tail = (offs+nbits)&31;
if (tail==0) {
tail = (offs + nbits) & 31;
if (tail == 0) {
b[i] = ~b[i];
}
else {
} else {
mask = lomask(tail);
b[i]^=mask;
b[i] ^= mask;
}
}
// constant-space bit vector copy in a single pass, with arbitrary
// offsets and lengths. to get this right, there are 16 cases to handle!
#define BITVECTOR_COPY_OP(name, OP) \
void bitvector_##name(u_int32_t *dest, u_int32_t doffs, \
u_int32_t *src, u_int32_t soffs, u_int32_t nbits) \
{ \
index_t i; \
u_int32_t s, nw, tail, snw; \
u_int32_t mask, scrap; \
void bitvector_##name(u_int32_t *dest, u_int32_t doffs, u_int32_t *src, \
u_int32_t soffs, u_int32_t nbits) \
{ \
index_t i; \
u_int32_t s, nw, tail, snw; \
u_int32_t mask, scrap; \
\
if (nbits == 0) return; \
nw = (doffs+nbits+31)>>5; \
if (nbits == 0) \
return; \
nw = (doffs + nbits + 31) >> 5; \
\
if (soffs == doffs) { \
if (nw == 1) { \
mask = (lomask(nbits)<<doffs); \
if (soffs == doffs) { \
if (nw == 1) { \
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); \
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; \
} \
mask = ~lomask(doffs); \
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; \
} \
snw = (soffs+nbits+31)>>5; \
if (soffs < doffs) { \
s = doffs-soffs; \
if (nw == 1) { \
mask = (lomask(nbits)<<doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
return; \
} \
mask = ~lomask(doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
scrap = OP(src[0])>>(32-s); \
for(i=1; i < snw-1; i++) { \
dest[i] = (OP(src[i])<<s) | scrap; \
scrap = OP(src[i])>>(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)|scrap) & mask); \
} \
else /* snw < nw */ { \
snw = (soffs + nbits + 31) >> 5; \
if (soffs < doffs) { \
s = doffs - soffs; \
if (nw == 1) { \
mask = (lomask(nbits) << doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0]) << s) & mask); \
return; \
} \
mask = ~lomask(doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0]) << s) & mask); \
scrap = OP(src[0]) >> (32 - s); \
for (i = 1; i < snw - 1; i++) { \
dest[i] = (OP(src[i]) << s) | scrap; \
scrap = OP(src[i]) >> (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) | scrap) & mask); \
} else /* snw < nw */ { \
if (snw == 1) { \
dest[i] = (dest[i] & ~mask) | \
(((OP(src[i]) << s) | scrap) & mask); \
} else { \
dest[i] = (OP(src[i]) << s) | scrap; \
scrap = OP(src[i]) >> (32 - s); \
i++; \
dest[i] = (dest[i] & ~mask) | (scrap & mask); \
} \
} \
} else { \
s = soffs - doffs; \
if (snw == 1) { \
dest[i] = (dest[i] & ~mask) | \
(((OP(src[i])<<s) | scrap) & mask); \
mask = (lomask(nbits) << doffs); \
dest[0] = (dest[0] & ~mask) | ((OP(src[0]) >> s) & mask); \
return; \
} \
else { \
dest[i] = (OP(src[i])<<s) | scrap; \
scrap = OP(src[i])>>(32-s); \
i++; \
dest[i] = (dest[i] & ~mask) | (scrap & mask); \
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); \
} \
} \
} \
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_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
/*
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;
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
for(i=0; i < nw/2; i++) {
dest[i] = bitreverse(src[nw-i-1]);
dest[nw-i-1] = bitreverse(src[i]);
for (i = 0; i < nw / 2; i++) {
dest[i] = bitreverse(src[nw - i - 1]);
dest[nw - i - 1] = bitreverse(src[i]);
}
if (nw&0x1)
if (nw & 0x1)
dest[i] = bitreverse(src[i]);
tail = (soffs+nbits)&31;
tail = (soffs + nbits) & 31;
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)
@ -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 *temp;
if (nbits == 0) return;
if (nbits == 0)
return;
nw = (offs+nbits+31)>>5;
temp = (nw > MALLOC_CUTOFF) ? malloc(nw*4) : alloca(nw*4);
for(i=0; i < nw/2; i++) {
temp[i] = bitreverse(b[nw-i-1]);
temp[nw-i-1] = bitreverse(b[i]);
nw = (offs + nbits + 31) >> 5;
temp = (nw > MALLOC_CUTOFF) ? malloc(nw * 4) : alloca(nw * 4);
for (i = 0; i < nw / 2; i++) {
temp[i] = bitreverse(b[nw - i - 1]);
temp[nw - i - 1] = bitreverse(b[i]);
}
if (nw&0x1)
if (nw & 0x1)
temp[i] = bitreverse(b[i]);
tail = (offs+nbits)&31;
bitvector_copy(b, offs, temp, (32-tail)&31, nbits);
if (nw > MALLOC_CUTOFF) free(temp);
tail = (offs + nbits) & 31;
bitvector_copy(b, offs, temp, (32 - tail) & 31, nbits);
if (nw > MALLOC_CUTOFF)
free(temp);
}
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_int64_t ans;
if (nbits == 0) return 0;
nw = ((u_int64_t)offs+nbits+31)>>5;
if (nbits == 0)
return 0;
nw = ((u_int64_t)offs + nbits + 31) >> 5;
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
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]);
}
ntail = (offs+(u_int32_t)nbits)&31;
ans += count_bits(b[i]&(ntail>0?lomask(ntail):ONES32)); // last end cap
ntail = (offs + (u_int32_t)nbits) & 31;
ans +=
count_bits(b[i] & (ntail > 0 ? lomask(ntail) : ONES32)); // last end cap
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 mask;
if (nbits == 0) return 0;
nw = (offs+nbits+31)>>5;
if (nbits == 0)
return 0;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) {
mask = (lomask(nbits)<<offs);
if ((b[0] & mask) != mask) return 1;
mask = (lomask(nbits) << offs);
if ((b[0] & mask) != mask)
return 1;
return 0;
}
mask = ~lomask(offs);
if ((b[0] & mask) != mask) return 1;
if ((b[0] & mask) != mask)
return 1;
for(i=1; i < nw-1; i++) {
if (b[i] != ONES32) return 1;
for (i = 1; i < nw - 1; i++) {
if (b[i] != ONES32)
return 1;
}
tail = (offs+nbits)&31;
if (tail==0) {
if (b[i] != ONES32) return 1;
}
else {
tail = (offs + nbits) & 31;
if (tail == 0) {
if (b[i] != ONES32)
return 1;
} else {
mask = lomask(tail);
if ((b[i] & mask) != mask) return 1;
if ((b[i] & mask) != mask)
return 1;
}
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 mask;
if (nbits == 0) return 0;
nw = (offs+nbits+31)>>5;
if (nbits == 0)
return 0;
nw = (offs + nbits + 31) >> 5;
if (nw == 1) {
mask = (lomask(nbits)<<offs);
if ((b[0] & mask) != 0) return 1;
mask = (lomask(nbits) << offs);
if ((b[0] & mask) != 0)
return 1;
return 0;
}
mask = ~lomask(offs);
if ((b[0] & mask) != 0) return 1;
if ((b[0] & mask) != 0)
return 1;
for(i=1; i < nw-1; i++) {
if (b[i] != 0) return 1;
for (i = 1; i < nw - 1; i++) {
if (b[i] != 0)
return 1;
}
tail = (offs+nbits)&31;
if (tail==0) {
if (b[i] != 0) return 1;
}
else {
tail = (offs + nbits) & 31;
if (tail == 0) {
if (b[i] != 0)
return 1;
} else {
mask = lomask(tail);
if ((b[i] & mask) != 0) return 1;
if ((b[i] & mask) != 0)
return 1;
}
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)
{
if (newoffs > soffs)
bitvector_shl_to(dest, src, nw, newoffs-soffs, 1);
bitvector_shl_to(dest, src, nw, newoffs - soffs, 1);
else
bitvector_shr_to(dest, src, nw, soffs-newoffs);
bitvector_shr_to(dest, src, nw, soffs - newoffs);
}
#define BITVECTOR_BINARY_OP_TO(opname, OP) \
void bitvector_##opname##_to(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 nw = (doffs+nbits+31)>>5; \
u_int32_t *temp = nw>MALLOC_CUTOFF ? malloc((nw+1)*4) : alloca((nw+1)*4);\
u_int32_t i, anw, bnw; \
if (aoffs == boffs) { \
anw = (aoffs+nbits+31)>>5; \
} \
else if (aoffs == doffs) { \
bnw = (boffs+nbits+31)>>5; \
adjust_offset_to(temp, b, bnw, boffs, aoffs); \
b = temp; anw = nw; \
} \
else { \
anw = (aoffs+nbits+31)>>5; \
bnw = (boffs+nbits+31)>>5; \
adjust_offset_to(temp, a, anw, aoffs, boffs); \
a = temp; aoffs = boffs; anw = bnw; \
} \
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 BITVECTOR_BINARY_OP_TO(opname, OP) \
void bitvector_##opname##_to( \
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 nw = (doffs + nbits + 31) >> 5; \
u_int32_t *temp = \
nw > MALLOC_CUTOFF ? malloc((nw + 1) * 4) : alloca((nw + 1) * 4); \
u_int32_t i, anw, bnw; \
if (aoffs == boffs) { \
anw = (aoffs + nbits + 31) >> 5; \
} else if (aoffs == doffs) { \
bnw = (boffs + nbits + 31) >> 5; \
adjust_offset_to(temp, b, bnw, boffs, aoffs); \
b = temp; \
anw = nw; \
} else { \
anw = (aoffs + nbits + 31) >> 5; \
bnw = (boffs + nbits + 31) >> 5; \
adjust_offset_to(temp, a, anw, aoffs, boffs); \
a = temp; \
aoffs = boffs; \
anw = bnw; \
} \
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_OR(a,b) ((a)|(b))
#define BV_XOR(a,b) ((a)^(b))
#define BV_AND(a, b) ((a) & (b))
#define BV_OR(a, b) ((a) | (b))
#define BV_XOR(a, b) ((a) ^ (b))
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)

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

43
llt/bitvector.h
View File

@ -2,8 +2,8 @@
#define __BITVECTOR_H_
// a mask with n set lo or hi bits
#define lomask(n) (u_int32_t)((((u_int32_t)1)<<(n))-1)
#define himask(n) (~lomask(32-n))
#define lomask(n) (u_int32_t)((((u_int32_t)1) << (n)) - 1)
#define himask(n) (~lomask(32 - n))
#define ONES32 ((u_int32_t)0xffffffff)
#ifdef __INTEL_COMPILER
@ -11,11 +11,11 @@
#else
static inline u_int32_t count_bits(u_int32_t b)
{
b = b - ((b>>1)&0x55555555);
b = ((b>>2)&0x33333333) + (b&0x33333333);
b = ((b>>4)+b)&0x0f0f0f0f;
b += (b>>8);
b += (b>>16);
b = b - ((b >> 1) & 0x55555555);
b = ((b >> 2) & 0x33333333) + (b & 0x33333333);
b = ((b >> 4) + b) & 0x0f0f0f0f;
b += (b >> 8);
b += (b >> 16);
return b & 0x3f;
// 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_to(u_int32_t *dest, u_int32_t *b, size_t n, u_int32_t s,
bool_t scrap);
void bitvector_fill(u_int32_t *b,u_int32_t offs, u_int32_t c, 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_fill(u_int32_t *b, u_int32_t offs, u_int32_t c,
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_to(u_int32_t *dest, u_int32_t doffs,
u_int32_t *a, u_int32_t aoffs, u_int32_t nbits);
void bitvector_not_to(u_int32_t *dest, u_int32_t doffs, u_int32_t *a,
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_to(u_int32_t *dest, u_int32_t *src, u_int32_t soffs,
u_int32_t nbits);
void bitvector_and_to(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);
void bitvector_or_to(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);
void bitvector_xor_to(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);
void bitvector_and_to(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);
void bitvector_or_to(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);
void bitvector_xor_to(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_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_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);
if (sep != NULL) {
*sep = '\0';
}
else {
} else {
path[0] = '\0';
}
}
@ -98,7 +97,7 @@ char *get_exename(char *buf, size_t size)
int mib[4];
pid_t pid;
size_t len, plen;
char **argv, **argv2;
char **argv, **argv2;
char *p, *path, *pathcpy, filename[PATH_MAX];
struct stat sbuf;
@ -123,8 +122,8 @@ char *get_exename(char *buf, size_t size)
argv = argv2;
if (sysctl(mib, 4, argv, &len, NULL, 0) == -1) {
if (errno == ENOMEM)
continue; // Go back and realloc more memory.
break; // Bail for some other error in sysctl(3).
continue; // Go back and realloc more memory.
break; // Bail for some other error in sysctl(3).
}
// If you made it here, congrats! You guessed right!
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.
if (buf != NULL) {
if (strchr(buf, '/') == NULL) {
// buf contains a `basename`-style pathname (i.e. "foo",
// as opposed to "../foo" or "/usr/bin/foo"); search the
// PATH for its location. (BTW the setgid(2), setuid(2)
// calls are a pre-condition for the access(2) call
// later.)
if (strchr(buf, '/') == NULL) {
// buf contains a `basename`-style pathname (i.e. "foo",
// as opposed to "../foo" or "/usr/bin/foo"); search the
// PATH for its location. (BTW the setgid(2), setuid(2)
// calls are a pre-condition for the access(2) call
// later.)
if ( (path = getenv("PATH")) != NULL &&
!setgid(getegid()) && !setuid(geteuid()) ) {
if ((path = getenv("PATH")) != NULL && !setgid(getegid()) &&
!setuid(geteuid())) {
// The strdup(3) call below, if successful, will
// allocate memory for the PATH string returned by
// getenv(3) above. This is necessary because the man
// page of getenv(3) says that its return value
// "should be considered read-only"; however, the
// strsep(3) call below is going to be destructively
// modifying that value. ("Hulk smash!")
// The strdup(3) call below, if successful, will
// allocate memory for the PATH string returned by
// getenv(3) above. This is necessary because the man
// page of getenv(3) says that its return value
// "should be considered read-only"; however, the
// strsep(3) call below is going to be destructively
// modifying that value. ("Hulk smash!")
if ((path = strdup(path)) != NULL) {
pathcpy = path;
len = strlen(buf);
while ((p = strsep(&pathcpy, ":")) != NULL) {
if (*p == '\0') p = ".";
plen = strlen(p);
if ((path = strdup(path)) != NULL) {
pathcpy = path;
len = strlen(buf);
while ((p = strsep(&pathcpy, ":")) != NULL) {
if (*p == '\0')
p = ".";
plen = strlen(p);
// strip trailing '/'
while (p[plen-1] == '/') p[--plen] = '\0';
// strip trailing '/'
while (p[plen - 1] == '/')
p[--plen] = '\0';
if (plen + 1 + len < sizeof(filename)) {
snprintf(filename, sizeof(filename), "%s/%s", p, buf);
if ( (stat(filename, &sbuf) == 0) &&
S_ISREG(sbuf.st_mode) &&
access(filename, X_OK) == 0 ) {
buf = strdup(filename);
break;
}
}
}
free(path); // free the strdup(3) memory allocation.
}
}
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");
// resolve this to an absolute pathname.
if ( strlcpy(filename, buf, sizeof(filename)) >= sizeof(filename) ||
realpath(filename, buf) == NULL )
buf = NULL;
}
if (plen + 1 + len < sizeof(filename)) {
snprintf(filename, sizeof(filename), "%s/%s", p,
buf);
if ((stat(filename, &sbuf) == 0) &&
S_ISREG(sbuf.st_mode) &&
access(filename, X_OK) == 0) {
buf = strdup(filename);
break;
}
}
}
free(path); // free the strdup(3) memory allocation.
}
} 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");
// resolve this to an absolute pathname.
if (strlcpy(filename, buf, sizeof(filename)) >=
sizeof(filename) ||
realpath(filename, buf) == NULL)
buf = NULL;
}
}
return buf;
@ -197,14 +200,14 @@ char *get_exename(char *buf, size_t size)
char *get_exename(char *buf, size_t size)
{
int mib[4];
mib[0] = CTL_KERN;
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1;
sysctl(mib, 4, buf, &size, NULL, 0);
return buf;
int mib[4];
mib[0] = CTL_KERN;
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1;
sysctl(mib, 4, buf, &size, NULL, 0);
return buf;
}
#elif defined(WIN32)
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;
if (_NSGetExecutablePath(buf, &bufsize))
return NULL;
return NULL;
return buf;
}
#endif

4
llt/dirpath.h
View File

@ -6,14 +6,14 @@
#define PATHSEPSTRING "\\"
#define PATHLISTSEP ';'
#define PATHLISTSEPSTRING ";"
#define ISPATHSEP(c) ((c)=='/' || (c)=='\\')
#define ISPATHSEP(c) ((c) == '/' || (c) == '\\')
#define MAXPATHLEN 1024
#else
#define PATHSEP '/'
#define PATHSEPSTRING "/"
#define PATHLISTSEP ':'
#define PATHLISTSEPSTRING ":"
#define ISPATHSEP(c) ((c)=='/')
#define ISPATHSEP(c) ((c) == '/')
#endif
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.
*/
#if defined(__gnu_linux__)
# define LINUX
#define LINUX
#elif defined(__APPLE__) && defined(__MACH__)
# define MACOSX
#define MACOSX
#elif defined(__OpenBSD__)
# define OPENBSD
#define OPENBSD
#elif defined(__FreeBSD__)
# define FREEBSD
#define FREEBSD
#elif defined(_WIN32)
# define WIN32
#define WIN32
#else
# error "unknown platform"
#error "unknown platform"
#endif
#if defined(OPENBSD) || defined(FREEBSD)
#if defined(__x86_64__)
# define __SIZEOF_POINTER__ 8
#define __SIZEOF_POINTER__ 8
#else
# define __SIZEOF_POINTER__ 4
#define __SIZEOF_POINTER__ 4
#endif
#endif
#if !defined (BITS32) && !defined (BITS64)
#if !defined(BITS32) && !defined(BITS64)
#ifndef __SIZEOF_POINTER__
# error "__SIZEOF_POINTER__ undefined"
#error "__SIZEOF_POINTER__ undefined"
#endif
#if( 8 == __SIZEOF_POINTER__ )
# define BITS64
#elif( 4 == __SIZEOF_POINTER__ )
# define BITS32
#if (8 == __SIZEOF_POINTER__)
#define BITS64
#elif (4 == __SIZEOF_POINTER__)
#define BITS32
#else
# error "this is one weird machine"
#error "this is one weird machine"
#endif
#endif
#if defined(WIN32)
# define STDCALL __stdcall
# if defined(IMPORT_EXPORTS)
# define DLLEXPORT __declspec(dllimport)
# else
# define DLLEXPORT __declspec(dllexport)
# endif
#define STDCALL __stdcall
#if defined(IMPORT_EXPORTS)
#define DLLEXPORT __declspec(dllimport)
#else
# define STDCALL
# define DLLEXPORT __attribute__ ((visibility("default")))
#define DLLEXPORT __declspec(dllexport)
#endif
#else
#define STDCALL
#define DLLEXPORT __attribute__((visibility("default")))
#endif
#if defined(LINUX)
# include <features.h>
# include <endian.h>
# define LITTLE_ENDIAN __LITTLE_ENDIAN
# define BIG_ENDIAN __BIG_ENDIAN
# define PDP_ENDIAN __PDP_ENDIAN
# define BYTE_ORDER __BYTE_ORDER
#include <features.h>
#include <endian.h>
#define LITTLE_ENDIAN __LITTLE_ENDIAN
#define BIG_ENDIAN __BIG_ENDIAN
#define PDP_ENDIAN __PDP_ENDIAN
#define BYTE_ORDER __BYTE_ORDER
#elif defined(MACOSX) || defined(OPENBSD) || defined(FREEBSD)
# include <machine/endian.h>
# define __LITTLE_ENDIAN LITTLE_ENDIAN
# define __BIG_ENDIAN BIG_ENDIAN
# define __PDP_ENDIAN PDP_ENDIAN
# define __BYTE_ORDER BYTE_ORDER
#include <machine/endian.h>
#define __LITTLE_ENDIAN LITTLE_ENDIAN
#define __BIG_ENDIAN BIG_ENDIAN
#define __PDP_ENDIAN PDP_ENDIAN
#define __BYTE_ORDER BYTE_ORDER
#elif defined(WIN32)
# define __LITTLE_ENDIAN 1234
# define __BIG_ENDIAN 4321
# define __PDP_ENDIAN 3412
# define __BYTE_ORDER __LITTLE_ENDIAN
# define __FLOAT_WORD_ORDER __LITTLE_ENDIAN
# define LITTLE_ENDIAN __LITTLE_ENDIAN
# define BIG_ENDIAN __BIG_ENDIAN
# define PDP_ENDIAN __PDP_ENDIAN
# define BYTE_ORDER __BYTE_ORDER
#define __LITTLE_ENDIAN 1234
#define __BIG_ENDIAN 4321
#define __PDP_ENDIAN 3412
#define __BYTE_ORDER __LITTLE_ENDIAN
#define __FLOAT_WORD_ORDER __LITTLE_ENDIAN
#define LITTLE_ENDIAN __LITTLE_ENDIAN
#define BIG_ENDIAN __BIG_ENDIAN
#define PDP_ENDIAN __PDP_ENDIAN
#define BYTE_ORDER __BYTE_ORDER
#else
# error "unknown platform"
#error "unknown platform"
#endif
#ifdef BOEHM_GC
// boehm GC allocator
#include <gc.h>
#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))
#else
// standard allocator
#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)
#endif
typedef int bool_t;
#if defined(__INTEL_COMPILER) && defined(WIN32)
# define STATIC_INLINE static
# define INLINE
# ifdef BITS64
#define STATIC_INLINE static
#define INLINE
#ifdef BITS64
typedef unsigned long size_t;
# else
typedef unsigned int size_t;
# endif
#else
# define STATIC_INLINE static inline
# define INLINE inline
typedef unsigned int size_t;
#endif
#else
#define STATIC_INLINE static inline
#define INLINE inline
#endif
typedef unsigned char byte_t; /* 1 byte */
typedef unsigned char byte_t; /* 1 byte */
#if defined(WIN32)
typedef short int16_t;
typedef int int32_t;
@ -150,7 +147,7 @@ typedef unsigned long uint_t; // preferred int type on platform
typedef long int_t;
typedef int64_t offset_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;
#else
#define TOP_BIT 0x80000000
@ -163,55 +160,56 @@ typedef int32_t ptrint_t;
typedef u_int32_t u_ptrint_t;
#endif
typedef u_int8_t uint8_t;
typedef u_int8_t uint8_t;
typedef u_int16_t uint16_t;
typedef u_int32_t uint32_t;
typedef u_int64_t uint64_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
#ifdef __GNUC__
#define __unlikely(x) __builtin_expect(!!(x), 0)
#define __likely(x) __builtin_expect(!!(x), 1)
#define __likely(x) __builtin_expect(!!(x), 1)
#else
#define __unlikely(x) (x)
#define __likely(x) (x)
#define __likely(x) (x)
#endif
#define DBL_MAXINT 9007199254740992LL
#define FLT_MAXINT 16777216
#define U64_MAX 18446744073709551615ULL
#define S64_MAX 9223372036854775807LL
#define S64_MIN (-S64_MAX - 1LL)
#define BIT63 0x8000000000000000LL
#define U32_MAX 4294967295L
#define S32_MAX 2147483647L
#define S32_MIN (-S32_MAX - 1L)
#define BIT31 0x80000000
#define U64_MAX 18446744073709551615ULL
#define S64_MAX 9223372036854775807LL
#define S64_MIN (-S64_MAX - 1LL)
#define BIT63 0x8000000000000000LL
#define U32_MAX 4294967295L
#define S32_MAX 2147483647L
#define S32_MIN (-S32_MAX - 1L)
#define BIT31 0x80000000
#define DBL_EPSILON 2.2204460492503131e-16
#define FLT_EPSILON 1.192092896e-7
#define DBL_MAX 1.7976931348623157e+308
#define DBL_MIN 2.2250738585072014e-308
#define FLT_MAX 3.402823466e+38
#define FLT_MIN 1.175494351e-38
#define LOG2_10 3.3219280948873626
#define rel_zero(a, b) (fabs((a)/(b)) < DBL_EPSILON)
#define sign_bit(r) ((*(int64_t*)&(r)) & BIT63)
#define LABS(n) (((n)^((n)>>(NBITS-1))) - ((n)>>(NBITS-1)))
#define NBABS(n,nb) (((n)^((n)>>((nb)-1))) - ((n)>>((nb)-1)))
#define DFINITE(d) (((*(int64_t*)&(d))&0x7ff0000000000000LL)!=0x7ff0000000000000LL)
#define DNAN(d) ((d)!=(d))
#define DBL_EPSILON 2.2204460492503131e-16
#define FLT_EPSILON 1.192092896e-7
#define DBL_MAX 1.7976931348623157e+308
#define DBL_MIN 2.2250738585072014e-308
#define FLT_MAX 3.402823466e+38
#define FLT_MIN 1.175494351e-38
#define LOG2_10 3.3219280948873626
#define rel_zero(a, b) (fabs((a) / (b)) < DBL_EPSILON)
#define sign_bit(r) ((*(int64_t *)&(r)) & BIT63)
#define LABS(n) (((n) ^ ((n) >> (NBITS - 1))) - ((n) >> (NBITS - 1)))
#define NBABS(n, nb) (((n) ^ ((n) >> ((nb)-1))) - ((n) >> ((nb)-1)))
#define DFINITE(d) \
(((*(int64_t *)&(d)) & 0x7ff0000000000000LL) != 0x7ff0000000000000LL)
#define DNAN(d) ((d) != (d))
extern double D_PNAN;
extern double D_NNAN;
extern double D_PINF;
extern double D_NINF;
extern float F_PNAN;
extern float F_NNAN;
extern float F_PINF;
extern float F_NINF;
extern float F_PNAN;
extern float F_NNAN;
extern float F_PINF;
extern float F_NINF;
#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)
{
size_t offs=0;
size_t offs = 0;
size_t i, pos;
char ch, linebuffer[16];
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] = ' ';
do {
ios_printf(dest, "%.8x ", offs+startoffs);
ios_printf(dest, "%.8x ", offs + startoffs);
pos = 10;
for(i=0; i < 16 && offs < len; i++, offs++) {
for (i = 0; i < 16 && offs < len; i++, offs++) {
ch = buffer[offs];
linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch;
hexc[0] = hexdig[((unsigned char)ch)>>4];
hexc[1] = hexdig[ch&0x0f];
pos += ios_write(dest, hexc, (i==7 || i==15) ? 4 : 3);
linebuffer[i] = (ch < 32 || ch >= 0x7f) ? '.' : ch;
hexc[0] = hexdig[((unsigned char)ch) >> 4];
hexc[1] = hexdig[ch & 0x0f];
pos += ios_write(dest, hexc, (i == 7 || i == 15) ? 4 : 3);
}
for(; i < 16; i++)
for (; i < 16; i++)
linebuffer[i] = ' ';
ios_write(dest, spc50, 60-pos);
ios_write(dest, spc50, 60 - pos);
ios_putc('|', dest);
ios_write(dest, linebuffer, 16);
ios_write(dest, "|\n", 2);

57
llt/hashing.c
View File

@ -13,45 +13,48 @@
uint_t nextipow2(uint_t i)
{
if (i==0) return 1;
if ((i&(i-1))==0) return i;
if (i&TOP_BIT) return TOP_BIT;
if (i == 0)
return 1;
if ((i & (i - 1)) == 0)
return i;
if (i & TOP_BIT)
return TOP_BIT;
// repeatedly clear bottom bit
while (i&(i-1))
i = i&(i-1);
while (i & (i - 1))
i = i & (i - 1);
return i<<1;
return i << 1;
}
u_int32_t int32hash(u_int32_t a)
{
a = (a+0x7ed55d16) + (a<<12);
a = (a^0xc761c23c) ^ (a>>19);
a = (a+0x165667b1) + (a<<5);
a = (a+0xd3a2646c) ^ (a<<9);
a = (a+0xfd7046c5) + (a<<3);
a = (a^0xb55a4f09) ^ (a>>16);
a = (a + 0x7ed55d16) + (a << 12);
a = (a ^ 0xc761c23c) ^ (a >> 19);
a = (a + 0x165667b1) + (a << 5);
a = (a + 0xd3a2646c) ^ (a << 9);
a = (a + 0xfd7046c5) + (a << 3);
a = (a ^ 0xb55a4f09) ^ (a >> 16);
return a;
}
u_int64_t int64hash(u_int64_t key)
{
key = (~key) + (key << 21); // key = (key << 21) - key - 1;
key = key ^ (key >> 24);
key = (key + (key << 3)) + (key << 8); // key * 265
key = key ^ (key >> 14);
key = (key + (key << 2)) + (key << 4); // key * 21
key = key ^ (key >> 28);
key = key + (key << 31);
key = (~key) + (key << 21); // key = (key << 21) - key - 1;
key = key ^ (key >> 24);
key = (key + (key << 3)) + (key << 8); // key * 265
key = key ^ (key >> 14);
key = (key + (key << 2)) + (key << 4); // key * 21
key = key ^ (key >> 28);
key = key + (key << 31);
return key;
}
u_int32_t int64to32hash(u_int64_t key)
{
key = (~key) + (key << 18); // key = (key << 18) - key - 1;
key = key ^ (key >> 31);
key = key * 21; // key = (key + (key << 2)) + (key << 4);
key = (~key) + (key << 18); // key = (key << 18) - key - 1;
key = key ^ (key >> 31);
key = key * 21; // key = (key + (key << 2)) + (key << 4);
key = key ^ (key >> 11);
key = key + (key << 6);
key = key ^ (key >> 22);
@ -60,17 +63,17 @@ u_int32_t int64to32hash(u_int64_t key)
#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);
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);
return c;

4
llt/hashing.h
View File

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

23
llt/htable.c
View File

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

2
llt/htable.h
View File

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

48
llt/ieee754.h
View File

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

13
llt/int2str.c
View File

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

196
llt/ios.c
View File

@ -5,7 +5,7 @@
#include <limits.h>
#include <errno.h>
#include <wchar.h>
#include <stdio.h> // for printf
#include <stdio.h> // for printf
#include "dtypes.h"
@ -27,7 +27,7 @@
#include "ios.h"
#include "timefuncs.h"
#define MOST_OF(x) ((x) - ((x)>>4))
#define MOST_OF(x) ((x) - ((x) >> 4))
/* OS-level primitive wrappers */
@ -36,9 +36,9 @@ void *memrchr(const void *s, int c, size_t n)
{
const unsigned char *src = s + n;
unsigned char uc = c;
while (--src >= (unsigned char *) s)
while (--src >= (unsigned char *)s)
if (*src == uc)
return (void *) src;
return (void *)src;
return NULL;
}
#else
@ -69,7 +69,7 @@ static int _enonfatal(int err)
err == EWOULDBLOCK);
}
#define SLEEP_TIME 5//ms
#define SLEEP_TIME 5 // ms
// return error code, #bytes read in *nread
// 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;
while (n>0) {
while (n > 0) {
int err = _os_read(fd, buf, n, &got);
n -= got;
*nread += got;
buf += got;
if (err || got==0)
if (err || got == 0)
return err;
}
return 0;
@ -134,7 +134,7 @@ static int _os_write_all(long fd, void *buf, size_t n, size_t *nwritten)
*nwritten = 0;
while (n>0) {
while (n > 0) {
int err = _os_write(fd, buf, n, &wrote);
n -= wrote;
*nwritten += wrote;
@ -145,14 +145,13 @@ static int _os_write_all(long fd, void *buf, size_t n, size_t *nwritten)
return 0;
}
/* internal utility functions */
static char *_buf_realloc(ios_t *s, size_t sz)
{
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
down to this size, in which case we need to copy. */
s->buf = &s->local[0];
@ -161,18 +160,18 @@ static char *_buf_realloc(ios_t *s, size_t sz)
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 we own the buffer we're free to resize it
// always allocate 1 bigger in case user wants to add a NUL
// terminator after taking over the buffer
temp = LLT_REALLOC(s->buf, sz+1);
temp = LLT_REALLOC(s->buf, sz + 1);
if (temp == NULL)
return NULL;
}
else {
temp = LLT_ALLOC(sz+1);
} else {
temp = LLT_ALLOC(sz + 1);
if (temp == NULL)
return NULL;
s->ownbuf = 1;
@ -221,7 +220,6 @@ static size_t _write_grow(ios_t *s, char *data, size_t n)
return n;
}
/* interface functions, low level */
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) {
avail = s->size - s->bpos;
if (avail > 0) {
size_t ncopy = (avail >= n) ? n : avail;
memcpy(dest, s->buf + s->bpos, ncopy);
s->bpos += ncopy;
if (ncopy >= n) {
s->state = bst_rd;
return tot+ncopy;
return tot + ncopy;
}
}
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;
return avail;
}
dest += avail;
n -= avail;
tot += avail;
ios_flush(s);
s->bpos = s->size = 0;
s->state = bst_rd;
s->fpos = -1;
if (n > MOST_OF(s->maxsize)) {
// 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)
s->_eof = 1;
return tot;
}
else {
} else {
// refill buffer
if (_os_read(s->fd, s->buf, s->maxsize, &got)) {
s->_eof = 1;
@ -306,21 +303,21 @@ size_t ios_readprep(ios_t *s, size_t n)
s->state = bst_rd;
if (space >= n || s->bm == bm_mem || s->fd == -1)
return space;
if (s->maxsize < s->bpos+n) {
if (s->maxsize < s->bpos + n) {
// 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)
memmove(s->buf, s->buf+s->bpos, space);
memmove(s->buf, s->buf + s->bpos, space);
s->size -= s->bpos;
s->bpos = 0;
}
else {
if (_buf_realloc(s, s->bpos + n)==NULL)
} else {
if (_buf_realloc(s, s->bpos + n) == NULL)
return space;
}
}
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)
return space;
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)
{
if (s->bpos > s->ndirty) s->ndirty = s->bpos;
if (s->bpos > s->size) s->size = s->bpos;
if (s->bpos > s->ndirty)
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)
{
if (s->readonly) return 0;
if (n == 0) return 0;
if (s->readonly)
return 0;
if (n == 0)
return 0;
size_t space;
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->rereadable) {
s->size = 0;
s->bpos = 0;
}
space = s->size - s->bpos;
}
else {
} else {
space = s->maxsize - s->bpos;
}
if (s->bm == bm_mem) {
wrote = _write_grow(s, data, n);
}
else if (s->bm == bm_none) {
} else if (s->bm == bm_none) {
s->fpos = -1;
_os_write_all(s->fd, data, n, &wrote);
return wrote;
}
else if (n <= space) {
} else if (n <= space) {
if (s->bm == bm_line) {
char *nl;
if ((nl=(char*)memrchr(data, '\n', n)) != NULL) {
size_t linesz = nl-data+1;
if ((nl = (char *)memrchr(data, '\n', n)) != NULL) {
size_t linesz = nl - data + 1;
s->bm = bm_block;
wrote += ios_write(s, data, linesz);
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);
s->bpos += n;
wrote += n;
}
else {
} else {
s->state = bst_wr;
ios_flush(s);
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)
return -1;
s->bpos = pos;
}
else {
} else {
ios_flush(s);
off_t fdpos = lseek(s->fd, pos, SEEK_SET);
if (fdpos == (off_t)-1)
@ -413,8 +410,7 @@ off_t ios_seek_end(ios_t *s)
s->_eof = 1;
if (s->bm == bm_mem) {
s->bpos = s->size;
}
else {
} else {
ios_flush(s);
off_t fdpos = lseek(s->fd, 0, SEEK_END);
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 <= (off_t)(s->size-s->bpos)) {
if (offs <= (off_t)(s->size - s->bpos)) {
s->bpos += offs;
return 0;
}
else if (s->bm == bm_mem) {
} else if (s->bm == bm_mem) {
// TODO: maybe grow buffer
return -1;
}
}
else if (offs < 0) {
} else if (offs < 0) {
if (-offs <= (off_t)s->bpos) {
s->bpos += offs;
s->_eof = 0;
return 0;
}
else if (s->bm == bm_mem) {
} else if (s->bm == bm_mem) {
return -1;
}
}
@ -489,15 +482,14 @@ size_t ios_trunc(ios_t *s, size_t size)
if (size < s->size) {
if (s->bpos > size)
s->bpos = size;
}
else {
if (_buf_realloc(s, size)==NULL)
} else {
if (_buf_realloc(s, size) == NULL)
return s->size;
}
s->size = size;
return size;
}
//todo
// todo
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;
int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
// 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 (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 &&
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)
close(s->fd);
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);
s->buf = NULL;
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) {
s->buf = &s->local[0];
s->maxsize = IOS_INLSIZE;
}
else {
} else {
s->buf = NULL;
_buf_realloc(s, IOS_BUFSIZE);
}
@ -590,18 +580,17 @@ char *ios_takebuf(ios_t *s, size_t *psize)
ios_flush(s);
if (s->buf == &s->local[0]) {
buf = LLT_ALLOC(s->size+1);
buf = LLT_ALLOC(s->size + 1);
if (buf == NULL)
return NULL;
if (s->size)
memcpy(buf, s->buf, s->size);
}
else {
} else {
buf = s->buf;
}
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 */
_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)
{
ios_flush(s);
size_t nvalid=0;
size_t nvalid = 0;
nvalid = (size < s->size) ? size : s->size;
if (nvalid > 0)
@ -623,7 +612,7 @@ int ios_setbuf(ios_t *s, char *buf, size_t size, int own)
}
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);
s->buf = buf;
s->maxsize = size;
@ -642,7 +631,8 @@ int ios_bufmode(ios_t *s, bufmode_t mode)
void ios_set_readonly(ios_t *s)
{
if (s->readonly) return;
if (s->readonly)
return;
ios_flush(s);
s->state = bst_none;
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;
if (!ios_eof(from)) {
do {
avail = ios_readprep(from, IOS_BUFSIZE/2);
avail = ios_readprep(from, IOS_BUFSIZE / 2);
if (avail == 0) {
from->_eof = 1;
break;
}
size_t written, ntowrite;
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?
from->bpos += ntowrite;
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 total = 0, avail=from->size - from->bpos;
size_t total = 0, avail = from->size - from->bpos;
int first = 1;
if (!ios_eof(from)) {
do {
@ -699,16 +689,15 @@ size_t ios_copyuntil(ios_t *to, ios_t *from, char delim)
avail = ios_readprep(from, LINE_CHUNK_SIZE);
}
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) {
written = ios_write(to, from->buf+from->bpos, avail);
written = ios_write(to, from->buf + from->bpos, avail);
from->bpos += avail;
total += written;
avail = 0;
}
else {
size_t ntowrite = pd - (from->buf+from->bpos) + 1;
written = ios_write(to, from->buf+from->bpos, ntowrite);
} else {
size_t ntowrite = pd - (from->buf + from->bpos) + 1;
written = ios_write(to, from->buf + from->bpos, ntowrite);
from->bpos += ntowrite;
total += written;
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
goto open_file_err;
int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY;
if (create) flags |= O_CREAT;
if (trunc) flags |= O_TRUNC;
fd = open(fname, flags, S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH/*644*/);
if (create)
flags |= O_CREAT;
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);
if (fd == -1)
goto open_file_err;
if (!wr)
s->readonly = 1;
return s;
open_file_err:
open_file_err:
s->fd = -1;
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)
{
size_t n = strlen(str);
if (ios_mem(s, n+1)==NULL) return NULL;
ios_write(s, str, n+1);
if (ios_mem(s, n + 1) == NULL)
return NULL;
ios_write(s, str, n + 1);
ios_seek(s, 0);
return s;
}
@ -793,7 +785,8 @@ ios_t *ios_fd(ios_t *s, long fd, int isfile, int own)
{
_ios_init(s);
s->fd = fd;
if (isfile) s->rereadable = 1;
if (isfile)
s->rereadable = 1;
_buf_init(s, bm_block);
s->ownfd = own;
if (fd == STDERR_FILENO)
@ -840,13 +833,14 @@ int ios_getc(ios_t *s)
char ch;
if (s->state == bst_rd && s->bpos < s->size) {
ch = s->buf[s->bpos++];
}
else {
if (s->_eof) return IOS_EOF;
} else {
if (s->_eof)
return IOS_EOF;
if (ios_read(s, &ch, 1) < 1)
return IOS_EOF;
}
if (ch == '\n') s->lineno++;
if (ch == '\n')
s->lineno++;
return (unsigned char)ch;
}
@ -854,9 +848,11 @@ int ios_peekc(ios_t *s)
{
if (s->bpos < s->size)
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);
if (n == 0) return IOS_EOF;
if (n == 0)
return IOS_EOF;
return (unsigned char)s->buf[s->bpos];
}
@ -871,7 +867,7 @@ int ios_ungetc(int c, ios_t *s)
return c;
}
if (s->size == s->maxsize) {
if (_buf_realloc(s, s->maxsize*2) == NULL)
if (_buf_realloc(s, s->maxsize * 2) == NULL)
return IOS_EOF;
}
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;
return 1;
}
sz = u8_seqlen(&c0)-1;
sz = u8_seqlen(&c0) - 1;
if (ios_ungetc(c, s) == IOS_EOF)
return IOS_EOF;
if (ios_readprep(s, sz) < sz)
@ -904,7 +900,7 @@ int ios_getutf8(ios_t *s, uint32_t *pwc)
return IOS_EOF;
size_t i = s->bpos;
*pwc = u8_nextchar(s->buf, &i);
ios_read(s, buf, sz+1);
ios_read(s, buf, sz + 1);
return 1;
}
@ -922,7 +918,7 @@ int ios_peekutf8(ios_t *s, uint32_t *pwc)
*pwc = (uint32_t)(unsigned char)c0;
return 1;
}
sz = u8_seqlen(&c0)-1;
sz = u8_seqlen(&c0) - 1;
if (ios_readprep(s, sz) < sz)
return IOS_EOF;
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)
{
char *str=NULL;
char *str = NULL;
int c;
va_list al;
va_copy(al, args);

42
llt/ios.h
View File

@ -23,33 +23,33 @@ typedef struct {
int errcode;
char *buf; // start of buffer
size_t maxsize; // space allocated to buffer
size_t size; // length of valid data in buf, >=ndirty
size_t bpos; // current position in buffer
size_t ndirty; // # bytes at &buf[0] that need to be written
char *buf; // start of buffer
size_t maxsize; // space allocated to buffer
size_t size; // length of valid data in buf, >=ndirty
size_t bpos; // current position in buffer
size_t ndirty; // # bytes at &buf[0] that need to be written
off_t fpos; // cached file pos
size_t lineno; // current line number
off_t fpos; // cached file pos
size_t lineno; // current line number
// pointer-size integer to support platforms where it might have
// to be a pointer
long fd;
unsigned char readonly:1;
unsigned char ownbuf:1;
unsigned char ownfd:1;
unsigned char _eof:1;
unsigned char readonly : 1;
unsigned char ownbuf : 1;
unsigned char ownfd : 1;
unsigned char _eof : 1;
// this means you can read, seek back, then read the same data
// 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
// seek without flushing in between. this performs read-before-write
// to populate the buffer, so "rereadable" capability is required.
// this is off by default.
//unsigned char stenciled:1;
// unsigned char stenciled:1;
// request durable writes (fsync)
// 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_readall(ios_t *s, char *dest, 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_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);
int ios_eof(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);
// ensure at least n bytes are buffered if possible. returns # available.
size_t ios_readprep(ios_t *from, size_t n);
//void ios_lock(ios_t *s);
//int ios_trylock(ios_t *s);
//int ios_unlock(ios_t *s);
// void ios_lock(ios_t *s);
// int ios_trylock(ios_t *s);
// int ios_unlock(ios_t *s);
/* stream creation */
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 */
#define IOS_EOF (-1)
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_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);
//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))
/*

24
llt/lltinit.c
View File

@ -13,10 +13,10 @@ double D_PNAN;
double D_NNAN;
double D_PINF;
double D_NINF;
float F_PNAN;
float F_NNAN;
float F_PINF;
float F_NINF;
float F_PNAN;
float F_NNAN;
float F_PINF;
float F_NINF;
int locale_is_utf8;
@ -28,12 +28,12 @@ void llt_init()
ios_init_stdstreams();
D_PNAN = strtod("+NaN",NULL);
D_NNAN = -strtod("+NaN",NULL);
D_PINF = strtod("+Inf",NULL);
D_NINF = strtod("-Inf",NULL);
F_PNAN = strtof("+NaN",NULL);
F_NNAN = -strtof("+NaN",NULL);
F_PINF = strtof("+Inf",NULL);
F_NINF = strtof("-Inf",NULL);
D_PNAN = strtod("+NaN", NULL);
D_NNAN = -strtod("+NaN", NULL);
D_PINF = strtod("+Inf", NULL);
D_NINF = strtod("-Inf", NULL);
F_PNAN = strtof("+NaN", NULL);
F_NNAN = -strtof("+NaN", NULL);
F_PINF = 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.
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).
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
modification, are permitted provided that the following conditions
@ -19,15 +19,15 @@
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. The names of its contributors may not be used to endorse or promote
products derived from this software without specific prior written
3. The names of its contributors may not be used to endorse or promote
products derived from this software without specific prior written
permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
@ -43,23 +43,22 @@
#include <stdio.h>
/* Period parameters */
/* Period parameters */
#define mtN 624
#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 LOWER_MASK 0x7fffffffU /* least significant r bits */
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 uint32_t mt[mtN]; /* the array for the state vector */
static int mti = mtN + 1; /* mti==mtN+1 means mt[mtN] is not initialized */
/* initializes mt[mtN] with a seed */
void init_genrand(uint32_t s)
{
mt[0]= s & 0xffffffffU;
for (mti=1; mti<mtN; mti++) {
mt[mti] =
(1812433253U * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
mt[0] = s & 0xffffffffU;
for (mti = 1; mti < mtN; mti++) {
mt[mti] = (1812433253U * (mt[mti - 1] ^ (mt[mti - 1] >> 30)) + mti);
/* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
/* In the previous versions, MSBs of the seed affect */
/* 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;
init_genrand(19650218U);
i=1; j=0;
k = (mtN>key_length ? mtN : key_length);
i = 1;
j = 0;
k = (mtN > key_length ? mtN : key_length);
for (; k; k--) {
mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525U))
+ init_key[j] + j; /* non linear */
mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
i++; j++;
if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; }
if (j>=key_length) j=0;
mt[i] = (mt[i] ^ ((mt[i - 1] ^ (mt[i - 1] >> 30)) * 1664525U)) +
init_key[j] + j; /* non linear */
mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
i++;
j++;
if (i >= mtN) {
mt[0] = mt[mtN - 1];
i = 1;
}
if (j >= key_length)
j = 0;
}
for (k=mtN-1; k; k--) {
mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941U))
- i; /* non linear */
for (k = mtN - 1; k; k--) {
mt[i] = (mt[i] ^ ((mt[i - 1] ^ (mt[i - 1] >> 30)) * 1566083941U)) -
i; /* non linear */
mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
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 */
uint32_t genrand_int32(void)
{
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 */
if (mti >= mtN) { /* generate mtN words at one time */
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 */
for (kk=0;kk<mtN-mtM;kk++) {
y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
mt[kk] = mt[kk+mtM] ^ (y >> 1) ^ mag01[y & 0x1U];
for (kk = 0; kk < mtN - mtM; kk++) {
y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK);
mt[kk] = mt[kk + mtM] ^ (y >> 1) ^ mag01[y & 0x1U];
}
for (;kk<mtN-1;kk++) {
y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
mt[kk] = mt[kk+(mtM-mtN)] ^ (y >> 1) ^ mag01[y & 0x1U];
for (; kk < mtN - 1; kk++) {
y = (mt[kk] & UPPER_MASK) | (mt[kk + 1] & LOWER_MASK);
mt[kk] = mt[kk + (mtM - mtN)] ^ (y >> 1) ^ mag01[y & 0x1U];
}
y = (mt[mtN-1]&UPPER_MASK)|(mt[0]&LOWER_MASK);
mt[mtN-1] = mt[mtM-1] ^ (y >> 1) ^ mag01[y & 0x1U];
y = (mt[mtN - 1] & UPPER_MASK) | (mt[0] & LOWER_MASK);
mt[mtN - 1] = mt[mtM - 1] ^ (y >> 1) ^ mag01[y & 0x1U];
mti = 0;
}
y = mt[mti++];
/* Tempering */
@ -169,7 +177,7 @@ double genrand_res53(void)
{
uint32_t a=genrand_int32()>>5, b=genrand_int32()>>6;
return(a*67108864.0+b)*(1.0/9007199254740992.0);
}
}
#endif
/* These real versions are due to Isaku Wada, 2002/01/09 added */
#if 0

28
llt/ptrhash.c
View File

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

14
llt/random.c
View File

@ -19,7 +19,7 @@ double rand_double()
d.ieee.mantissa0 = genrand_int32();
d.ieee.mantissa1 = genrand_int32();
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;
}
@ -29,7 +29,7 @@ float rand_float()
f.ieee.mantissa = genrand_int32();
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;
}
@ -46,11 +46,11 @@ double randn()
do {
ure = rand_double();
uim = rand_double();
vre = 2*ure - 1;
vim = 2*uim - 1;
s = vre*vre + vim*vim;
vre = 2 * ure - 1;
vim = 2 * uim - 1;
s = vre * vre + vim * vim;
} while (s >= 1);
s = sqrt(-2*log(s)/s);
s = sqrt(-2 * log(s) / s);
next = s * vre;
return s * vim;
}
@ -58,5 +58,5 @@ double randn()
void randomize()
{
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"
int mysocket(int domain, int type, int protocol)
{
int val;
@ -23,16 +22,16 @@ int mysocket(int domain, int type, int protocol)
if (s < 0)
return s;
val = 4096;
setsockopt(s, SOL_SOCKET, SO_RCVBUF, (char*)&val, sizeof(int));
setsockopt(s, SOL_SOCKET, SO_RCVBUF, (char *)&val, sizeof(int));
val = 4096;
setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char*)&val, sizeof(int));
setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char *)&val, sizeof(int));
return s;
}
void set_nonblock(int socket, int yes)
{
int flags;
flags = fcntl(socket,F_GETFL,0);
flags = fcntl(socket, F_GETFL, 0);
assert(flags != -1);
if (yes)
fcntl(socket, F_SETFL, flags | O_NONBLOCK);
@ -41,10 +40,7 @@ void set_nonblock(int socket, int yes)
}
#ifdef WIN32
void bzero(void *s, size_t n)
{
memset(s, 0, n);
}
void bzero(void *s, size_t n) { memset(s, 0, n); }
#endif
/* 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_addr.s_addr = htonl(INADDR_ANY);
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;
}
@ -83,7 +79,8 @@ int open_any_tcp_port(short *portno)
serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
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)++;
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_addr.s_addr = htonl(INADDR_ANY);
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)++;
serv_addr.sin_port = htons(*portno);
}
@ -115,17 +113,14 @@ int open_any_udp_port(short *portno)
}
#ifndef WIN32
void closesocket(int fd)
{
close(fd);
}
void closesocket(int fd) { close(fd); }
#endif
/* returns a socket to use to send data to the given address */
int connect_to_host(char *hostname, short portno)
{
struct hostent *host_info;
int sockfd, yes=1;
int sockfd, yes = 1;
struct sockaddr_in host_addr;
host_info = gethostbyname(hostname);
@ -138,14 +133,14 @@ int connect_to_host(char *hostname, short portno)
return -1;
}
(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;
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_addr.sin_port = htons(portno);
if (connect(sockfd, (struct sockaddr*)&host_addr,
if (connect(sockfd, (struct sockaddr *)&host_addr,
sizeof(struct sockaddr_in)) != 0) {
closesocket(sockfd);
return -1;
@ -156,7 +151,7 @@ int connect_to_host(char *hostname, short portno)
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);
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));
if (connect(sockfd, (struct sockaddr*)host_addr,
if (connect(sockfd, (struct sockaddr *)host_addr,
sizeof(struct sockaddr_in)) != 0) {
closesocket(sockfd);
return -1;
@ -176,33 +171,33 @@ int connect_to_addr(struct sockaddr_in *host_addr)
/* repeated send until all of buffer is sent */
int sendall(int sockfd, char *buffer, int bufLen, int flags)
{
int numBytesToSend=bufLen, length;
int numBytesToSend = bufLen, length;
while (numBytesToSend>0) {
length = send(sockfd, (void *) buffer, numBytesToSend, flags);
while (numBytesToSend > 0) {
length = send(sockfd, (void *)buffer, numBytesToSend, flags);
if (length < 0) {
return(-1);
return (-1);
}
numBytesToSend -= length ;
buffer += length ;
numBytesToSend -= length;
buffer += length;
}
return(bufLen);
return (bufLen);
}
/* repeated read until all of buffer is read */
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);
if (length <= 0) {
return(length);
return (length);
}
numBytesToRead -= length;
buffer += length;
}
return(bufLen);
return (bufLen);
}
int addr_eq(struct sockaddr_in *a, struct sockaddr_in *b)
@ -223,6 +218,6 @@ int socket_ready(int sock)
FD_ZERO(&fds);
FD_SET(sock, &fds);
select(sock+1, &fds, NULL, NULL, &timeout);
select(sock + 1, &fds, NULL, NULL, &timeout);
return FD_ISSET(sock, &fds);
}

37
llt/timefuncs.c
View File

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

307
llt/utf8.c
View File

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

6
llt/utf8.h
View File

@ -21,7 +21,7 @@ extern int wcwidth(uint32_t);
#endif
/* 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)
@ -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.
*/
size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end,
int escape_quotes, int ascii);
size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi,
size_t end, int escape_quotes, int ascii);
/* utility predicates used by the above */
int octal_digit(char c);

111
llt/utils.h
View File

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

30
opaque_type_template.c
View File

@ -12,28 +12,20 @@
static value_t TYPEsym;
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,
print_traverse_TYPE };
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)
@ -46,18 +38,16 @@ static TYPE_t *toTYPE(value_t v, char *fname)
{
if (!isTYPE(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[] = {
{ "TYPE?", fl_TYPEp },
{ NULL, NULL }
};
static builtinspec_t TYPEfunc_info[] = { { "TYPE?", fl_TYPEp },
{ NULL, NULL } };
void TYPE_init()
{
TYPEsym = symbol("TYPE");
TYPEtype = define_opaque_type(TYPEsym, sizeof(TYPE_t),
&TYPE_vtable, NULL);
TYPEtype =
define_opaque_type(TYPEsym, sizeof(TYPE_t), &TYPE_vtable, NULL);
assign_global_builtins(TYPEfunc_info);
}

220
opcodes.h
View File

@ -2,96 +2,166 @@
#define OPCODES_H
enum {
OP_NOP=0, OP_DUP, OP_POP, OP_CALL, OP_TCALL, OP_JMP, OP_BRF, OP_BRT,
OP_JMPL, OP_BRFL, OP_BRTL, OP_RET,
OP_NOP = 0,
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_SYMBOLP, OP_NUMBERP, OP_BOUNDP, OP_PAIRP, OP_BUILTINP, OP_VECTORP,
OP_FIXNUMP, OP_FUNCTIONP,
OP_EQ,
OP_EQV,
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_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_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_LOADT,
OP_LOADF,
OP_LOADNIL,
OP_LOAD0,
OP_LOAD1,
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_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_CLOSURE,
OP_ARGC,
OP_VARGC,
OP_TRYCATCH,
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
};
#ifdef USE_COMPUTED_GOTO
#define VM_LABELS \
static void *vm_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, &&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_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, &&L_OP_NOT, \
&&L_OP_NULLP, &&L_OP_BOOLEANP, \
&&L_OP_SYMBOLP, &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, \
&&L_OP_BUILTINP, &&L_OP_VECTORP, \
&&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
\
&&L_OP_CONS, &&L_OP_LIST, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_SETCAR, \
&&L_OP_SETCDR, &&L_OP_APPLY, \
\
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_IDIV, &&L_OP_NUMEQ, \
&&L_OP_LT, &&L_OP_COMPARE, \
\
&&L_OP_VECTOR, &&L_OP_AREF, &&L_OP_ASET, \
\
&&L_OP_LOADT, &&L_OP_LOADF, &&L_OP_LOADNIL, &&L_OP_LOAD0, &&L_OP_LOAD1, \
&&L_OP_LOADI8, \
&&L_OP_LOADV, &&L_OP_LOADVL, \
&&L_OP_LOADG, &&L_OP_LOADGL, \
&&L_OP_LOADA, &&L_OP_LOADAL, &&L_OP_LOADC, &&L_OP_LOADCL, \
&&L_OP_SETG, &&L_OP_SETGL, \
&&L_OP_SETA, &&L_OP_SETAL, &&L_OP_SETC, &&L_OP_SETCL, \
\
&&L_OP_CLOSURE, &&L_OP_ARGC, &&L_OP_VARGC, &&L_OP_TRYCATCH, \
&&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_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_LABELS \
static void *vm_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, \
&&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_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, \
&&L_OP_NOT, &&L_OP_NULLP, &&L_OP_BOOLEANP, &&L_OP_SYMBOLP, \
&&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, &&L_OP_BUILTINP, \
&&L_OP_VECTORP, &&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
\
&&L_OP_CONS, &&L_OP_LIST, &&L_OP_CAR, &&L_OP_CDR, \
&&L_OP_SETCAR, &&L_OP_SETCDR, &&L_OP_APPLY, \
\
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, \
&&L_OP_IDIV, &&L_OP_NUMEQ, &&L_OP_LT, &&L_OP_COMPARE, \
\
&&L_OP_VECTOR, &&L_OP_AREF, &&L_OP_ASET, \
\
&&L_OP_LOADT, &&L_OP_LOADF, &&L_OP_LOADNIL, &&L_OP_LOAD0, \
&&L_OP_LOAD1, &&L_OP_LOADI8, &&L_OP_LOADV, &&L_OP_LOADVL, \
&&L_OP_LOADG, &&L_OP_LOADGL, &&L_OP_LOADA, &&L_OP_LOADAL, \
&&L_OP_LOADC, &&L_OP_LOADCL, &&L_OP_SETG, &&L_OP_SETGL, \
&&L_OP_SETA, &&L_OP_SETAL, &&L_OP_SETC, &&L_OP_SETCL, \
\
&&L_OP_CLOSURE, &&L_OP_ARGC, &&L_OP_VARGC, &&L_OP_TRYCATCH, \
&&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_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 \
static void *vm_apply_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, &&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_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, &&L_OP_NOT, \
&&L_OP_NULLP, &&L_OP_BOOLEANP, \
&&L_OP_SYMBOLP, &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, \
&&L_OP_BUILTINP, &&L_OP_VECTORP, \
&&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
\
&&L_OP_CONS, &&apply_list, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_SETCAR, \
&&L_OP_SETCDR, &&apply_apply, \
\
&&apply_add, &&apply_sub, &&apply_mul, &&apply_div, &&L_OP_IDIV, &&L_OP_NUMEQ, \
&&L_OP_LT, &&L_OP_COMPARE, \
\
&&apply_vector, &&L_OP_AREF, &&L_OP_ASET \
#define VM_APPLY_LABELS \
static void *vm_apply_labels[] = { \
NULL, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, \
&&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_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, \
&&L_OP_NOT, &&L_OP_NULLP, &&L_OP_BOOLEANP, &&L_OP_SYMBOLP, \
&&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, &&L_OP_BUILTINP, \
&&L_OP_VECTORP, &&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
\
&&L_OP_CONS, &&apply_list, &&L_OP_CAR, &&L_OP_CDR, \
&&L_OP_SETCAR, &&L_OP_SETCDR, &&apply_apply, \
\
&&apply_add, &&apply_sub, &&apply_mul, &&apply_div, \
&&L_OP_IDIV, &&L_OP_NUMEQ, &&L_OP_LT, &&L_OP_COMPARE, \
\
&&apply_vector, &&L_OP_AREF, &&L_OP_ASET \
}
#else
#define VM_LABELS

351
operators.c
View File

@ -6,10 +6,7 @@
extern double trunc(double x);
STATIC_INLINE double fpart(double arg)
{
return arg - trunc(arg);
}
STATIC_INLINE double fpart(double arg) { return arg - trunc(arg); }
// given a number, determine an appropriate type for storing it
#if 0
@ -49,11 +46,9 @@ numerictype_t effective_numerictype(double r)
fp = fpart(r);
if (fp != 0 || r > U64_MAX || r < S64_MIN) {
return T_DOUBLE;
}
else if (r >= INT_MIN && r <= INT_MAX) {
} else if (r >= INT_MIN && r <= INT_MAX) {
return T_INT32;
}
else if (r <= S64_MAX) {
} else if (r <= S64_MAX) {
return T_INT64;
}
return T_UINT64;
@ -62,22 +57,39 @@ numerictype_t effective_numerictype(double r)
double conv_to_double(void *data, numerictype_t tag)
{
double d=0;
double d = 0;
switch (tag) {
case T_INT8: d = (double)*(int8_t*)data; break;
case T_UINT8: d = (double)*(uint8_t*)data; 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_INT8:
d = (double)*(int8_t *)data;
break;
case T_UINT8:
d = (double)*(uint8_t *)data;
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:
d = (double)*(int64_t*)data;
if (d > 0 && *(int64_t*)data < 0) // can happen!
d = (double)*(int64_t *)data;
if (d > 0 && *(int64_t *)data < 0) // can happen!
d = -d;
break;
case T_UINT64: d = (double)*(uint64_t*)data; break;
case T_FLOAT: d = (double)*(float*)data; break;
case T_DOUBLE: return *(double*)data;
case T_UINT64:
d = (double)*(uint64_t *)data;
break;
case T_FLOAT:
d = (double)*(float *)data;
break;
case T_DOUBLE:
return *(double *)data;
}
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)
{
switch (tag) {
case T_INT8: *(int8_t*)dest = d; break;
case T_UINT8: *(uint8_t*)dest = d; break;
case T_INT16: *(int16_t*)dest = d; break;
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;
case T_INT8:
*(int8_t *)dest = d;
break;
case T_UINT8:
*(uint8_t *)dest = d;
break;
case T_INT16:
*(int16_t *)dest = d;
break;
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;
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) \
type##_t conv_to_##type(void *data, numerictype_t tag) \
{ \
type##_t i=0; \
switch (tag) { \
case T_INT8: i = (type##_t)*(int8_t*)data; break; \
case T_UINT8: i = (type##_t)*(uint8_t*)data; break; \
case T_INT16: i = (type##_t)*(int16_t*)data; break; \
case T_UINT16: i = (type##_t)*(uint16_t*)data; 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; \
}
#define CONV_TO_INTTYPE(type) \
type##_t conv_to_##type(void *data, numerictype_t tag) \
{ \
type##_t i = 0; \
switch (tag) { \
case T_INT8: \
i = (type##_t) * (int8_t *)data; \
break; \
case T_UINT8: \
i = (type##_t) * (uint8_t *)data; \
break; \
case T_INT16: \
i = (type##_t) * (int16_t *)data; \
break; \
case T_UINT16: \
i = (type##_t) * (uint16_t *)data; \
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(int32)
@ -130,27 +180,43 @@ CONV_TO_INTTYPE(uint32)
// to cast to int64 first.
uint64_t conv_to_uint64(void *data, numerictype_t tag)
{
uint64_t i=0;
uint64_t i = 0;
switch (tag) {
case T_INT8: i = (uint64_t)*(int8_t*)data; break;
case T_UINT8: i = (uint64_t)*(uint8_t*)data; break;
case T_INT16: 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_INT8:
i = (uint64_t) * (int8_t *)data;
break;
case T_UINT8:
i = (uint64_t) * (uint8_t *)data;
break;
case T_INT16:
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:
if (*(float*)data >= 0)
i = (uint64_t)*(float*)data;
if (*(float *)data >= 0)
i = (uint64_t) * (float *)data;
else
i = (uint64_t)(int64_t)*(float*)data;
i = (uint64_t)(int64_t) * (float *)data;
break;
case T_DOUBLE:
if (*(double*)data >= 0)
i = (uint64_t)*(double*)data;
if (*(double *)data >= 0)
i = (uint64_t) * (double *)data;
else
i = (uint64_t)(int64_t)*(double*)data;
i = (uint64_t)(int64_t) * (double *)data;
break;
}
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)
{
switch (tag) {
case T_INT8: return *(int8_t*)a < *(int8_t*)b;
case T_UINT8: return *(uint8_t*)a < *(uint8_t*)b;
case T_INT16: return *(int16_t*)a < *(int16_t*)b;
case T_UINT16: return *(uint16_t*)a < *(uint16_t*)b;
case T_INT32: 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;
case T_INT8:
return *(int8_t *)a < *(int8_t *)b;
case T_UINT8:
return *(uint8_t *)a < *(uint8_t *)b;
case T_INT16:
return *(int16_t *)a < *(int16_t *)b;
case T_UINT16:
return *(uint16_t *)a < *(uint16_t *)b;
case T_INT32:
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;
}
@ -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)
{
switch (tag) {
case T_INT8: return *(int8_t*)a == *(int8_t*)b;
case T_UINT8: return *(uint8_t*)a == *(uint8_t*)b;
case T_INT16: return *(int16_t*)a == *(int16_t*)b;
case T_UINT16: return *(uint16_t*)a == *(uint16_t*)b;
case T_INT32: 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;
case T_INT8:
return *(int8_t *)a == *(int8_t *)b;
case T_UINT8:
return *(uint8_t *)a == *(uint8_t *)b;
case T_INT16:
return *(int16_t *)a == *(int16_t *)b;
case T_UINT16:
return *(uint16_t *)a == *(uint16_t *)b;
case T_INT32:
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;
}
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);
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 (btag == T_INT64) {
if (*(int64_t*)b >= 0) {
return (*(uint64_t*)a < (uint64_t)*(int64_t*)b);
if (*(int64_t *)b >= 0) {
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) {
if (db != db) return 0;
return (*(uint64_t*)a < (uint64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
} else if (atag == T_INT64) {
if (btag == T_UINT64) {
if (*(int64_t*)a >= 0) {
return ((uint64_t)*(int64_t*)a < *(uint64_t*)b);
if (*(int64_t *)a >= 0) {
return ((uint64_t) * (int64_t *)a < *(uint64_t *)b);
}
return (*(int64_t*)a < (int64_t)*(uint64_t*)b);
}
else if (btag == T_DOUBLE) {
if (db != db) return 0;
return (*(int64_t*)a < (int64_t)*(double*)b);
return (*(int64_t *)a < (int64_t) * (uint64_t *)b);
} else if (btag == T_DOUBLE) {
if (db != db)
return 0;
return (*(int64_t *)a < (int64_t) * (double *)b);
}
}
if (btag == T_UINT64) {
if (atag == T_DOUBLE) {
if (da != da) return 0;
return (*(uint64_t*)b > (uint64_t)*(double*)a);
if (da != da)
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 (da != da) return 0;
return (*(int64_t*)b > (int64_t)*(double*)a);
if (da != da)
return 0;
return (*(int64_t *)b > (int64_t) * (double *)a);
}
}
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 equalnans)
{
union { double d; int64_t i64; } u, v;
if (atag==btag && (!equalnans || atag < T_FLOAT))
union {
double d;
int64_t i64;
} u, v;
if (atag == btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, 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 (equalnans) {
u.d = da; v.d = db;
u.d = da;
v.d = db;
return u.i64 == v.i64;
}
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,
// we would already have concluded that it's bigger than b.
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) {
return (*(uint64_t*)a == (uint64_t)(int64_t)*(double*)b);
}
}
else if (atag == T_INT64) {
} else if (atag == T_INT64) {
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) {
return (*(int64_t*)a == (int64_t)*(double*)b);
}
}
else if (btag == T_UINT64) {
} else if (btag == T_UINT64) {
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) {
return (*(uint64_t*)b == (uint64_t)(int64_t)*(double*)a);
}
}
else if (btag == T_INT64) {
} else if (btag == T_INT64) {
if (atag == T_UINT64) {
return (*(int64_t*)b == (int64_t)*(uint64_t*)a);
}
else if (atag == T_DOUBLE) {
return (*(int64_t*)b == (int64_t)*(double*)a);
return (*(int64_t *)b == (int64_t) * (uint64_t *)a);
} else if (atag == T_DOUBLE) {
return (*(int64_t *)b == (int64_t) * (double *)a);
}
}
return 1;

431
print.c
View File

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

345
read.c
View File

@ -1,11 +1,28 @@
enum {
TOK_NONE, TOK_OPEN, TOK_CLOSE, 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
TOK_NONE,
TOK_OPEN,
TOK_CLOSE,
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.
// exceptions are '.', which is an ordinary symbol character
@ -25,53 +42,59 @@ int isnumtok_base(char *tok, value_t *pval, int base)
double d;
if (*tok == '\0')
return 0;
if (!((tok[0]=='0' && tok[1]=='x') || (base >= 15)) &&
if (!((tok[0] == '0' && tok[1] == 'x') || (base >= 15)) &&
strpbrk(tok, ".eEpP")) {
d = strtod(tok, &end);
if (*end == '\0') {
if (pval) *pval = mk_double(d);
if (pval)
*pval = mk_double(d);
return 1;
}
// floats can end in f or f0
if (end > tok && end[0] == 'f' &&
(end[1] == '\0' ||
(end[1] == '0' && end[2] == '\0'))) {
if (pval) *pval = mk_float((float)d);
(end[1] == '\0' || (end[1] == '0' && end[2] == '\0'))) {
if (pval)
*pval = mk_float((float)d);
return 1;
}
}
if (tok[0] == '+') {
if (!strcmp(tok,"+NaN") || !strcasecmp(tok,"+nan.0")) {
if (pval) *pval = mk_double(D_PNAN);
if (!strcmp(tok, "+NaN") || !strcasecmp(tok, "+nan.0")) {
if (pval)
*pval = mk_double(D_PNAN);
return 1;
}
if (!strcmp(tok,"+Inf") || !strcasecmp(tok,"+inf.0")) {
if (pval) *pval = mk_double(D_PINF);
if (!strcmp(tok, "+Inf") || !strcasecmp(tok, "+inf.0")) {
if (pval)
*pval = mk_double(D_PINF);
return 1;
}
}
else if (tok[0] == '-') {
if (!strcmp(tok,"-NaN") || !strcasecmp(tok,"-nan.0")) {
if (pval) *pval = mk_double(D_NNAN);
} else if (tok[0] == '-') {
if (!strcmp(tok, "-NaN") || !strcasecmp(tok, "-nan.0")) {
if (pval)
*pval = mk_double(D_NNAN);
return 1;
}
if (!strcmp(tok,"-Inf") || !strcasecmp(tok,"-inf.0")) {
if (pval) *pval = mk_double(D_NINF);
if (!strcmp(tok, "-Inf") || !strcasecmp(tok, "-inf.0")) {
if (pval)
*pval = mk_double(D_NINF);
return 1;
}
errno = 0;
i64 = strtoll(tok, &end, base);
if (errno)
return 0;
if (pval) *pval = return_from_int64(i64);
if (pval)
*pval = return_from_int64(i64);
return (*end == '\0');
}
errno = 0;
ui64 = strtoull(tok, &end, base);
if (errno)
return 0;
if (pval) *pval = return_from_uint64(ui64);
if (pval)
*pval = return_from_uint64(ui64);
return (*end == '\0');
}
@ -103,8 +126,7 @@ static char nextchar(void)
do {
if (f->bpos < f->size) {
ch = f->buf[f->bpos++];
}
else {
} else {
ch = ios_getc(f);
if (ch == IOS_EOF)
return 0;
@ -119,26 +141,23 @@ static char nextchar(void)
} while ((char)ch != '\n');
c = (char)ch;
}
} while (c==' ' || isspace(c));
} while (c == ' ' || isspace(c));
return c;
}
static void take(void)
{
toktype = TOK_NONE;
}
static void take(void) { toktype = TOK_NONE; }
static void accumchar(char c, int *pi)
{
buf[(*pi)++] = c;
if (*pi >= (int)(sizeof(buf)-1))
if (*pi >= (int)(sizeof(buf) - 1))
lerror(ParseError, "read: token too long");
}
// return: 1 if escaped (forced to be symbol)
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) {
if (!first) {
@ -151,23 +170,20 @@ static int read_token(char c, int digits)
if (c == '|') {
issym = 1;
escaped = !escaped;
}
else if (c == '\\') {
} else if (c == '\\') {
issym = 1;
ch = ios_getc(F);
if (ch == IOS_EOF)
goto terminate;
accumchar((char)ch, &i);
}
else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) {
} else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) {
break;
}
else {
} else {
accumchar(c, &i);
}
}
ios_ungetc(c, F);
terminate:
terminate:
buf[i++] = '\0';
return issym;
}
@ -183,42 +199,36 @@ static u_int32_t peek(void)
if (toktype != TOK_NONE)
return toktype;
c = nextchar();
if (ios_eof(F)) return TOK_NONE;
if (ios_eof(F))
return TOK_NONE;
if (c == '(') {
toktype = TOK_OPEN;
}
else if (c == ')') {
} else if (c == ')') {
toktype = TOK_CLOSE;
}
else if (c == '[') {
} else if (c == '[') {
toktype = TOK_OPENB;
}
else if (c == ']') {
} else if (c == ']') {
toktype = TOK_CLOSEB;
}
else if (c == '\'') {
} else if (c == '\'') {
toktype = TOK_QUOTE;
}
else if (c == '`') {
} else if (c == '`') {
toktype = TOK_BQ;
}
else if (c == '"') {
} else if (c == '"') {
toktype = TOK_DOUBLEQUOTE;
}
else if (c == '#') {
ch = ios_getc(F); c = (char)ch;
} else if (c == '#') {
ch = ios_getc(F);
c = (char)ch;
if (ch == IOS_EOF)
lerror(ParseError, "read: invalid read macro");
if (c == '.') {
toktype = TOK_SHARPDOT;
}
else if (c == '\'') {
} else if (c == '\'') {
toktype = TOK_SHARPQUOTE;
}
else if (c == '\\') {
} else if (c == '\\') {
uint32_t cval;
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' ||
cval == (uint32_t)'x') {
read_token('u', 0);
@ -228,36 +238,45 @@ static u_int32_t peek(void)
"read: invalid hex character constant");
cval = numval(tokval);
}
}
else if (cval >= 'a' && cval <= 'z') {
} else if (cval >= 'a' && cval <= 'z') {
read_token((char)cval, 0);
tokval = symbol(buf);
if (buf[1] == '\0') /* one character */;
else if (tokval == nulsym) cval = 0x00;
else if (tokval == alarmsym) cval = 0x07;
else if (tokval == backspacesym) cval = 0x08;
else if (tokval == tabsym) cval = 0x09;
else if (tokval == linefeedsym) cval = 0x0A;
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;
if (buf[1] == '\0') /* one character */
;
else if (tokval == nulsym)
cval = 0x00;
else if (tokval == alarmsym)
cval = 0x07;
else if (tokval == backspacesym)
cval = 0x08;
else if (tokval == tabsym)
cval = 0x09;
else if (tokval == linefeedsym)
cval = 0x0A;
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
lerrorf(ParseError, "read: unknown character #\\%s", buf);
}
toktype = TOK_NUM;
tokval = mk_wchar(cval);
}
else if (c == '(') {
} else if (c == '(') {
toktype = TOK_SHARPOPEN;
}
else if (c == '<') {
} else if (c == '<') {
lerror(ParseError, "read: unreadable object");
}
else if (isdigit(c)) {
} else if (isdigit(c)) {
read_token(c, 1);
c = (char)ios_getc(F);
if (c == '#')
@ -271,17 +290,15 @@ static u_int32_t peek(void)
if (*end != '\0' || errno)
lerror(ParseError, "read: invalid label");
tokval = fixnum(x);
}
else if (c == '!') {
} else if (c == '!') {
// #! single line comment for shbang script support
do {
ch = ios_getc(F);
} while (ch != IOS_EOF && (char)ch != '\n');
return peek();
}
else if (c == '|') {
} else if (c == '|') {
// multiline comment
int commentlevel=1;
int commentlevel = 1;
while (1) {
ch = ios_getc(F);
hashpipe_gotc:
@ -297,8 +314,7 @@ static u_int32_t peek(void)
continue;
}
goto hashpipe_gotc;
}
else if ((char)ch == '#') {
} else if ((char)ch == '#') {
ch = ios_getc(F);
if ((char)ch == '|')
commentlevel++;
@ -308,13 +324,11 @@ static u_int32_t peek(void)
}
// this was whitespace, so keep peeking
return peek();
}
else if (c == ';') {
} else if (c == ';') {
// datum comment
(void)do_read_sexpr(UNBOUND); // skip
(void)do_read_sexpr(UNBOUND); // skip
return peek();
}
else if (c == ':') {
} else if (c == ':') {
// gensym
ch = ios_getc(F);
if ((char)ch == 'g')
@ -326,29 +340,24 @@ static u_int32_t peek(void)
lerror(ParseError, "read: invalid gensym label");
toktype = TOK_GENSYM;
tokval = fixnum(x);
}
else if (symchar(c)) {
} else if (symchar(c)) {
read_token(ch, 0);
if (((c == 'b' && (base= 2)) ||
(c == 'o' && (base= 8)) ||
(c == 'd' && (base=10)) ||
(c == 'x' && (base=16))) &&
(isdigit_base(buf[1],base) ||
buf[1]=='-')) {
if (((c == 'b' && (base = 2)) || (c == 'o' && (base = 8)) ||
(c == 'd' && (base = 10)) || (c == 'x' && (base = 16))) &&
(isdigit_base(buf[1], base) || buf[1] == '-')) {
if (!read_numtok(&buf[1], &tokval, base))
lerrorf(ParseError, "read: invalid base %d constant", base);
return (toktype=TOK_NUM);
lerrorf(ParseError, "read: invalid base %d constant",
base);
return (toktype = TOK_NUM);
}
toktype = TOK_SHARPSYM;
tokval = symbol(buf);
}
else {
} else {
lerror(ParseError, "read: unknown read macro");
}
}
else if (c == ',') {
} else if (c == ',') {
toktype = TOK_COMMA;
ch = ios_getc(F);
if (ch == IOS_EOF)
@ -359,15 +368,13 @@ static u_int32_t peek(void)
toktype = TOK_COMMADOT;
else
ios_ungetc((char)ch, F);
}
else {
} else {
if (!read_token(c, 0)) {
if (buf[0]=='.' && buf[1]=='\0') {
return (toktype=TOK_DOT);
}
else {
if (buf[0] == '.' && buf[1] == '\0') {
return (toktype = TOK_DOT);
} else {
if (read_numtok(buf, &tokval, 0))
return (toktype=TOK_NUM);
return (toktype = TOK_NUM);
}
}
toktype = TOK_SYM;
@ -383,15 +390,15 @@ static value_t vector_grow(value_t v)
size_t i, s = vector_size(v);
size_t d = vector_grow_amt(s);
PUSH(v);
assert(s+d > s);
value_t newv = alloc_vector(s+d, 1);
v = Stack[SP-1];
for(i=0; i < s; i++)
assert(s + d > s);
value_t newv = alloc_vector(s + d, 1);
v = Stack[SP - 1];
for (i = 0; i < s; i++)
vector_elt(newv, i) = vector_elt(v, i);
// use gc to rewrite references from the old vector to the new
Stack[SP-1] = newv;
Stack[SP - 1] = newv;
if (s > 0) {
((size_t*)ptr(v))[0] |= 0x1;
((size_t *)ptr(v))[0] |= 0x1;
vector_elt(v, 0) = newv;
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)
{
value_t v=the_empty_vector, elt;
u_int32_t i=0;
value_t v = the_empty_vector, elt;
u_int32_t i = 0;
PUSH(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
while (peek() != closer) {
if (ios_eof(F))
lerror(ParseError, "read: unexpected end of input");
if (i >= vector_size(v)) {
v = Stack[SP-1] = vector_grow(v);
v = Stack[SP - 1] = vector_grow(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
}
elt = do_read_sexpr(UNBOUND);
v = Stack[SP-1];
v = Stack[SP - 1];
assert(i < vector_size(v));
vector_elt(v,i) = elt;
vector_elt(v, i) = elt;
i++;
}
take();
@ -429,14 +436,14 @@ static value_t read_string(void)
{
char *buf, *temp;
char eseq[10];
size_t i=0, j, sz = 64, ndig;
size_t i = 0, j, sz = 64, ndig;
int c;
value_t s;
u_int32_t wc=0;
u_int32_t wc = 0;
buf = malloc(sz);
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;
temp = realloc(buf, sz);
if (temp == NULL) {
@ -458,29 +465,30 @@ static value_t read_string(void)
free(buf);
lerror(ParseError, "read: end of input in escape sequence");
}
j=0;
j = 0;
if (octal_digit(c)) {
do {
eseq[j++] = c;
c = ios_getc(F);
} while (octal_digit(c) && j<3 && (c!=IOS_EOF));
if (c!=IOS_EOF) ios_ungetc(c, F);
} while (octal_digit(c) && j < 3 && (c != IOS_EOF));
if (c != IOS_EOF)
ios_ungetc(c, F);
eseq[j] = '\0';
wc = strtol(eseq, NULL, 8);
// \DDD and \xXX read bytes, not characters
buf[i++] = ((char)wc);
}
else if ((c=='x' && (ndig=2)) ||
(c=='u' && (ndig=4)) ||
(c=='U' && (ndig=8))) {
} else if ((c == 'x' && (ndig = 2)) || (c == 'u' && (ndig = 4)) ||
(c == 'U' && (ndig = 8))) {
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;
c = ios_getc(F);
}
if (c!=IOS_EOF) ios_ungetc(c, F);
if (c != IOS_EOF)
ios_ungetc(c, F);
eseq[j] = '\0';
if (j) wc = strtol(eseq, NULL, 16);
if (j)
wc = strtol(eseq, NULL, 16);
if (!j || wc > 0x10ffff) {
free(buf);
lerror(ParseError, "read: invalid escape sequence");
@ -489,12 +497,10 @@ static value_t read_string(void)
buf[i++] = ((char)wc);
else
i += u8_wc_toutf8(&buf[i], wc);
}
else {
} else {
buf[i++] = read_escape_control_char((char)c);
}
}
else {
} else {
buf[i++] = c;
}
}
@ -513,23 +519,23 @@ static void read_list(value_t *pval, value_t label)
u_int32_t t;
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();
while (t != TOK_CLOSE) {
if (ios_eof(F))
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)) {
cdr_(*pc) = c;
}
else {
} else {
*pval = c;
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)c);
ptrhash_put(&readstate->backrefs, (void *)label, (void *)c);
}
*pc = c;
c = do_read_sexpr(UNBOUND); // must be on separate lines due to
car_(*pc) = c; // undefined evaluation order
c = do_read_sexpr(UNBOUND); // must be on separate lines due to
car_(*pc) = c; // undefined evaluation order
t = peek();
if (t == TOK_DOT) {
@ -570,32 +576,36 @@ static value_t do_read_sexpr(value_t label)
case TOK_NUM:
return tokval;
case TOK_COMMA:
head = &COMMA; goto listwith;
head = &COMMA;
goto listwith;
case TOK_COMMAAT:
head = &COMMAAT; goto listwith;
head = &COMMAAT;
goto listwith;
case TOK_COMMADOT:
head = &COMMADOT; goto listwith;
head = &COMMADOT;
goto listwith;
case TOK_BQ:
head = &BACKQUOTE; goto listwith;
head = &BACKQUOTE;
goto listwith;
case TOK_QUOTE:
head = &QUOTE;
listwith:
v = cons_reserve(2);
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;
PUSH(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
ptrhash_put(&readstate->backrefs, (void *)label, (void *)v);
v = do_read_sexpr(UNBOUND);
car_(cdr_(Stack[SP-1])) = v;
car_(cdr_(Stack[SP - 1])) = v;
return POP();
case TOK_SHARPQUOTE:
// femtoLisp doesn't need symbol-function, so #' does nothing
return do_read_sexpr(label);
case TOK_OPEN:
PUSH(NIL);
read_list(&Stack[SP-1], label);
read_list(&Stack[SP - 1], label);
return POP();
case TOK_SHARPSYM:
sym = tokval;
@ -611,12 +621,11 @@ static value_t do_read_sexpr(value_t label)
symbol_name(tokval));
}
PUSH(NIL);
read_list(&Stack[SP-1], UNBOUND);
read_list(&Stack[SP - 1], UNBOUND);
if (sym == vu8sym) {
sym = arraysym;
Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
}
else if (sym == fnsym) {
Stack[SP - 1] = fl_cons(uint8sym, Stack[SP - 1]);
} else if (sym == fnsym) {
sym = FUNCTION;
}
v = symbol_value(sym);
@ -629,8 +638,8 @@ static value_t do_read_sexpr(value_t label)
return read_vector(label, TOK_CLOSE);
case TOK_SHARPDOT:
// eval-when-read
// evaluated expressions can refer to existing backreferences, but they
// cannot see pending labels. in other words:
// evaluated expressions can refer to existing backreferences, but
// they cannot see pending labels. in other words:
// (... #2=#.#0# ... ) OK
// (... #2=#.(#2#) ... ) DO NOT WANT
sym = do_read_sexpr(UNBOUND);
@ -643,20 +652,20 @@ static value_t do_read_sexpr(value_t label)
return fl_toplevel_eval(sym);
case TOK_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));
oldtokval = tokval;
v = do_read_sexpr(tokval);
ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v);
ptrhash_put(&readstate->backrefs, (void *)oldtokval, (void *)v);
return v;
case TOK_BACKREF:
// 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)
lerrorf(ParseError, "read: undefined label %ld", numval(tokval));
return v;
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)
*pv = fl_gensym(NULL, 0);
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);
if (!fl_isstring(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;
if (nargs > 1) {
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]);
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)
{
argcount("string.width", nargs, 1);
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) {
int w = wcwidth(*(uint32_t*)cp_data(cp));
int w = wcwidth(*(uint32_t *)cp_data(cp));
if (w < 0)
return FL_F;
return fixnum(w);
@ -68,7 +68,7 @@ value_t fl_string_reverse(value_t *args, u_int32_t nargs)
argcount("string.reverse", nargs, 1);
if (!fl_isstring(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);
u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
return ns;
@ -78,14 +78,14 @@ value_t fl_string_encode(value_t *args, u_int32_t nargs)
{
argcount("string.encode", nargs, 1);
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);
if (t->eltype == wchartype) {
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);
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);
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)
{
int term=0;
int term = 0;
if (nargs == 2) {
term = (args[1] != FL_F);
}
else {
} else {
argcount("string.decode", nargs, 1);
}
if (!fl_isstring(args[0]))
type_error("string.decode", "string", args[0]);
cvalue_t *cv = (cvalue_t*)ptr(args[0]);
char *ptr = (char*)cv_data(cv);
cvalue_t *cv = (cvalue_t *)ptr(args[0]);
char *ptr = (char *)cv_data(cv);
size_t nb = cv_len(cv);
size_t nc = u8_charnum(ptr, nb);
size_t newsz = nc*sizeof(uint32_t);
if (term) newsz += sizeof(uint32_t);
size_t newsz = nc * sizeof(uint32_t);
if (term)
newsz += sizeof(uint32_t);
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);
u8_toucs(pwc, nc, ptr, nb);
if (term) pwc[nc] = 0;
if (term)
pwc[nc] = 0;
return wcstr;
}
@ -127,15 +128,13 @@ value_t fl_string(value_t *args, u_int32_t nargs)
return args[0];
value_t arg, buf = fl_buffer(NULL, 0);
fl_gc_handle(&buf);
ios_t *s = value2c(ios_t*,buf);
ios_t *s = value2c(ios_t *, buf);
uint32_t i;
value_t oldpr = symbol_value(printreadablysym);
value_t oldpp = symbol_value(printprettysym);
set(printreadablysym, FL_F);
set(printprettysym, FL_F);
FOR_ARGS(i,0,arg,args) {
fl_print(s, args[i]);
}
FOR_ARGS(i, 0, arg, args) { fl_print(s, args[i]); }
set(printreadablysym, oldpr);
set(printprettysym, oldpp);
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);
char *s = tostring(args[0], "string.split");
char *delim = tostring(args[1], "string.split");
size_t len = cv_len((cvalue_t*)ptr(args[0]));
size_t dlen = cv_len((cvalue_t*)ptr(args[1]));
size_t ssz, tokend=0, tokstart=0, i=0;
value_t first=FL_NIL, c=FL_NIL, last;
size_t len = cv_len((cvalue_t *)ptr(args[0]));
size_t dlen = cv_len((cvalue_t *)ptr(args[1]));
size_t ssz, tokend = 0, tokstart = 0, i = 0;
value_t first = FL_NIL, c = FL_NIL, last;
size_t junk;
fl_gc_handle(&first);
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);
// we've done allocation; reload movable pointers
s = cv_data((cvalue_t*)ptr(args[0]));
delim = cv_data((cvalue_t*)ptr(args[1]));
s = cv_data((cvalue_t *)ptr(args[0]));
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
if (last == FL_NIL)
first = c; // first time, save first cons
first = c; // first time, save first cons
else
((cons_t*)ptr(last))->cdr = c;
((cons_t *)ptr(last))->cdr = c;
// note this tricky condition: if the string ends with a
// delimiter, we need to go around one more time to add an
// 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);
return first;
}
@ -191,7 +191,7 @@ value_t fl_string_sub(value_t *args, u_int32_t nargs)
if (nargs != 2)
argcount("string.sub", nargs, 3);
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;
i1 = toulong(args[1], "string.sub");
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");
if (i2 > len)
bounds_error("string.sub", args[0], args[2]);
}
else {
} else {
i2 = len;
}
if (i2 <= i1)
return cvalue_string(0);
value_t ns = cvalue_string(i2-i1);
memcpy(cv_data((cvalue_t*)ptr(ns)), &s[i1], i2-i1);
value_t ns = cvalue_string(i2 - i1);
memcpy(cv_data((cvalue_t *)ptr(ns)), &s[i1], i2 - i1);
return ns;
}
@ -215,12 +214,12 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
{
argcount("string.char", nargs, 2);
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");
if (i >= len)
bounds_error("string.char", args[0], args[1]);
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]);
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)
{
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)
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)
{
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)
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)
{
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)
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)
{
char *p = memchr(s+start, c, len-start);
char *p = memchr(s + start, c, len - start);
if (p == NULL)
return FL_F;
return size_wrap((size_t)(p - s));
@ -268,41 +267,39 @@ value_t fl_string_find(value_t *args, u_int32_t nargs)
else
argcount("string.find", nargs, 2);
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)
bounds_error("string.find", args[0], args[2]);
char *needle; size_t needlesz;
char *needle;
size_t needlesz;
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) {
uint32_t c = *(uint32_t*)cp_data(cp);
uint32_t c = *(uint32_t *)cp_data(cp);
if (c <= 0x7f)
return mem_find_byte(s, (char)c, start, len);
needlesz = u8_toutf8(cbuf, sizeof(cbuf), &c, 1);
needle = cbuf;
}
else if (iscprim(v) && cp_class(cp) == bytetype) {
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 (iscprim(v) && cp_class(cp) == bytetype) {
return mem_find_byte(s, *(char *)cp_data(cp), start, len);
} else if (fl_isstring(v)) {
cvalue_t *cv = (cvalue_t *)ptr(v);
needlesz = cv_len(cv);
needle = (char*)cv_data(cv);
}
else {
needle = (char *)cv_data(cv);
} else {
type_error("string.find", "string", args[1]);
}
if (needlesz > len-start)
if (needlesz > len - start)
return FL_F;
else if (needlesz == 1)
return mem_find_byte(s, needle[0], start, len);
else if (needlesz == 0)
return size_wrap(start);
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 (!memcmp(&s[i+1], needle+1, needlesz-1))
if (!memcmp(&s[i + 1], needle + 1, needlesz - 1))
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)
argcount("string.inc", nargs, 2);
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 cnt = 1;
if (nargs == 3)
@ -332,7 +329,7 @@ value_t fl_string_dec(value_t *args, u_int32_t nargs)
if (nargs < 2 || nargs > 3)
argcount("string.dec", nargs, 2);
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 cnt = 1;
if (nargs == 3)
@ -363,11 +360,14 @@ value_t fl_numbertostring(value_t *args, u_int32_t nargs)
value_t n = args[0];
int neg = 0;
uint64_t num;
if (isfixnum(n)) num = numval(n);
else if (!iscprim(n)) type_error("number->string", "integer", n);
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) {
if (isfixnum(n))
num = numval(n);
else if (!iscprim(n))
type_error("number->string", "integer", n);
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;
neg = 1;
}
@ -399,7 +399,7 @@ value_t fl_string_isutf8(value_t *args, u_int32_t nargs)
{
argcount("string.isutf8", nargs, 1);
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;
}
@ -429,7 +429,4 @@ static builtinspec_t stringfunc_info[] = {
{ NULL, NULL }
};
void stringfuncs_init(void)
{
assign_global_builtins(stringfunc_info);
}
void stringfuncs_init(void) { 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)
{
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;
int first=1;
int first = 1;
fl_print_str("#table(", f);
for(i=0; i < h->size; i+=2) {
if (h->table[i+1] != HT_NOTFOUND) {
if (!first) fl_print_str(" ", f);
for (i = 0; i < h->size; i += 2) {
if (h->table[i + 1] != HT_NOTFOUND) {
if (!first)
fl_print_str(" ", f);
fl_print_child(f, (value_t)h->table[i]);
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;
}
}
@ -32,32 +33,32 @@ void print_htable(value_t v, ios_t *f)
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;
for(i=0; i < h->size; i+=2) {
if (h->table[i+1] != HT_NOTFOUND) {
for (i = 0; i < h->size; i += 2) {
if (h->table[i + 1] != HT_NOTFOUND) {
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)
{
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);
}
void relocate_htable(value_t oldv, value_t newv)
{
htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv));
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv));
htable_t *oldh = (htable_t *)cv_data((cvalue_t *)ptr(oldv));
htable_t *h = (htable_t *)cv_data((cvalue_t *)ptr(newv));
if (oldh->table == &oldh->_space[0])
h->table = &h->_space[0];
size_t i;
for(i=0; i < h->size; i++) {
for (i = 0; i < h->size; i++) {
if (h->table[i] != HT_NOTFOUND)
h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]);
h->table[i] = (void *)relocate_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)
{
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)
@ -79,7 +80,7 @@ static htable_t *totable(value_t v, char *fname)
{
if (!ishashtable(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)
@ -93,17 +94,17 @@ value_t fl_table(value_t *args, uint32_t nargs)
tabletype->vtable->finalize = NULL;
nt = cvalue(tabletype, sizeof(htable_t));
tabletype->vtable->finalize = free_htable;
} else {
nt = cvalue(tabletype, 2 * sizeof(void *));
}
else {
nt = cvalue(tabletype, 2*sizeof(void*));
}
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
htable_new(h, cnt/2);
htable_t *h = (htable_t *)cv_data((cvalue_t *)ptr(nt));
htable_new(h, cnt / 2);
uint32_t i;
value_t k=FL_NIL, arg=FL_NIL;
FOR_ARGS(i,0,arg,args) {
if (i&1)
equalhash_put(h, (void*)k, (void*)arg);
value_t k = FL_NIL, arg = FL_NIL;
FOR_ARGS(i, 0, arg, args)
{
if (i & 1)
equalhash_put(h, (void *)k, (void *)arg);
else
k = arg;
}
@ -116,12 +117,12 @@ value_t fl_table_put(value_t *args, uint32_t nargs)
argcount("put!", nargs, 3);
htable_t *h = totable(args[0], "put!");
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
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);
cv->len = 2*sizeof(void*);
cv->len = 2 * sizeof(void *);
}
return args[0];
}
@ -137,7 +138,7 @@ value_t fl_table_get(value_t *args, uint32_t nargs)
if (nargs != 3)
argcount("get", nargs, 2);
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 (nargs == 3)
return args[2];
@ -151,7 +152,7 @@ value_t fl_table_has(value_t *args, uint32_t nargs)
{
argcount("has", nargs, 2);
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)
@ -159,7 +160,7 @@ value_t fl_table_del(value_t *args, uint32_t nargs)
{
argcount("del!", nargs, 2);
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]);
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)
{
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");
size_t i, n = h->size;
void **table = h->table;
fl_gc_handle(&f);
fl_gc_handle(&zero);
fl_gc_handle(&t);
for(i=0; i < n; i+=2) {
if (table[i+1] != HT_NOTFOUND) {
zero = fl_applyn(3, f,
(value_t)table[i],
(value_t)table[i+1],
zero);
for (i = 0; i < n; i += 2) {
if (table[i + 1] != HT_NOTFOUND) {
zero =
fl_applyn(3, f, (value_t)table[i], (value_t)table[i + 1], zero);
// reload pointer
h = (htable_t*)cv_data((cvalue_t*)ptr(t));
h = (htable_t *)cv_data((cvalue_t *)ptr(t));
if (h->size != n)
lerror(EnumerationError, "table.foldl: table modified");
table = h->table;
@ -191,21 +190,19 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs)
return zero;
}
static builtinspec_t tablefunc_info[] = {
{ "table", fl_table },
{ "table?", fl_tablep },
{ "put!", fl_table_put },
{ "get", fl_table_get },
{ "has?", fl_table_has },
{ "del!", fl_table_del },
{ "table.foldl", fl_table_foldl },
{ NULL, NULL }
};
static builtinspec_t tablefunc_info[] = { { "table", fl_table },
{ "table?", fl_tablep },
{ "put!", fl_table_put },
{ "get", fl_table_get },
{ "has?", fl_table_has },
{ "del!", fl_table_del },
{ "table.foldl", fl_table_foldl },
{ NULL, NULL } };
void table_init(void)
{
tablesym = symbol("table");
tabletype = define_opaque_type(tablesym, sizeof(htable_t),
&table_vtable, NULL);
tabletype =
define_opaque_type(tablesym, sizeof(htable_t), &table_vtable, NULL);
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 *p;
size_t sz = ((n+31)>>5) * 4;
size_t sz = ((n + 31) >> 5) * 4;
p = realloc(b, sz);
if (p == NULL) return NULL;
if (p == NULL)
return NULL;
memset(p, 0, sz);
return p;
}
u_int32_t *mk_bitvector(size_t n)
{
return bitvector_resize(NULL, n);
}
u_int32_t *mk_bitvector(size_t n) { return bitvector_resize(NULL, n); }
void bitvector_set(u_int32_t *b, u_int32_t n, u_int32_t c)
{
if (c)
b[n>>5] |= (1<<(n&31));
b[n >> 5] |= (1 << (n & 31));
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)
{
return b[n>>5] & (1<<(n&31));
return b[n >> 5] & (1 << (n & 31));
}
typedef struct {
@ -35,21 +33,19 @@ void ltable_init(ltable_t *t, size_t n)
{
t->n = 0;
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)
{
t->n = 0;
}
void ltable_clear(ltable_t *t) { t->n = 0; }
void ltable_insert(ltable_t *t, unsigned long item)
{
unsigned long *p;
if (t->n == t->maxsize) {
p = realloc(t->items, (t->maxsize*2)*sizeof(unsigned long));
if (p == NULL) return;
p = realloc(t->items, (t->maxsize * 2) * sizeof(unsigned long));
if (p == NULL)
return;
t->items = p;
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 i;
for(i=0; i < (int)t->n; i++)
for (i = 0; i < (int)t->n; i++)
if (t->items[i] == item)
return i;
return NOTFOUND;
@ -73,20 +69,22 @@ void ltable_adjoin(ltable_t *t, unsigned long item)
ltable_insert(t, item);
}
static const u_int32_t offsetsFromUTF8[6] = {
0x00000000UL, 0x00003080UL, 0x000E2080UL,
0x03C82080UL, 0xFA082080UL, 0x82082080UL
};
static const u_int32_t offsetsFromUTF8[6] = { 0x00000000UL, 0x00003080UL,
0x000E2080UL, 0x03C82080UL,
0xFA082080UL, 0x82082080UL };
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,
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
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
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)
@ -98,8 +96,8 @@ int u8_seqlen(const char c)
u_int32_t u8_fgetc(FILE *f)
{
int amt=0, sz, c;
u_int32_t ch=0;
int amt = 0, sz, c;
u_int32_t ch = 0;
c = fgetc(f);
if (c == EOF)
@ -113,7 +111,7 @@ u_int32_t u8_fgetc(FILE *f)
return UEOF;
ch += (u_int32_t)c;
}
ch -= offsetsFromUTF8[sz-1];
ch -= offsetsFromUTF8[sz - 1];
return ch;
}

445
tiny/lisp-nontail.c
View File

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